package bbdisp;


use Socket;
use strict;
use FileHandle;

sub new
{
    my ($this, $cfg) = @_;
    my  $class = ref($this) || $this;
    my  $self = {};

    bless($self, $class);
    $self->init;
    $self->{"dir"} = $BigSister::common::fs{"web"};
    return $self;
}


sub init {
    my( $self ) = @_;
}




#
# If we have a text block from a client that understands HTML then we keep that
# formatting as it is.  Stuff before the &html tag stays the same, unless it
# has some of those wonky |> characters in it and we have been asked to fix
# that.
#

sub fixHTMLinText
{
    my $self = shift;
    my $text = shift;
    my $fixBarsInHTML = scalar( @_ ) ? shift : 0;

    my ( $html, $newText );

    # Check if the client has told us it generates html
    if ( $text =~ /^(.*?)\&html/ms ) 
    {
	($newText,$html) = ($1,$');
	$html =~ s/\&html//g;

	if ( $fixBarsInHTML )
	{
	    $html =~ s/\|\>/\n/mg;
	};
    }
    else
    {
    	$newText = $text;
	$html    = "";
    };
    $newText =~ s/\|\>/\n/mg;
    $newText =~ s/\</\&lt;/mg;
    $newText =~ s/\>/\&gt;/mg;
    $newText =~ s/^[\s\n]+//m;
    $newText =~ s/\n/\<BR\>/mg;
    $newText =~ s/\@/\@\@/mg;
    $newText =~ s/\&(green|yellow|red|purple|white|blue|clear)/\@\(lamp.sub:$1\)\@/mg;

    $newText .= $html;

    return $newText;
};


sub replace_vars_file {
    my( $self, $skin, $vars, $template, $file ) = @_;
    my( $tmp );

    print STDERR "replace_vars_file -> $file\n" if( $BigSister::common::dl>3 );
    $tmp = $file.".$$";
    unless( open( OUT, ">$tmp" ) ) {
	BigSister::common::log( "err", "cannot create state file $file: $!" );
	return;
    }
    my $txt = $self->replace_vars( $skin, $vars, $template );
    $txt =~ s/\@\@/\@/g;
    unless( (print OUT $txt) && (close OUT) ) {
	BigSister::common::log( "err", "write error writing $file: $!" );
	close OUT;
	unlink( $tmp );
	return;
    }
    print STDERR "written: ".length($txt)."bytes to $tmp\n" if( $BigSister::common::dl>4 );
    unless( Platform::replace( $tmp, $file ) ) {
	BigSister::common::log( "err", "could not replace $file" );
	# just in case ...
	unlink( $tmp );
	return 0;
    }
    return 1;
}



sub replace_vars {
    my( $self, $skin, $vars, $template ) = @_;

    print STDERR "replace_vars()\n" if( $BigSister::common::dl>4 );
    my @repl = &_replace_vars( $self, $skin, $vars, $template, 0 );
    my $replaced = $repl[0].$repl[1];
    while( $replaced =~ /\[:([a-z_]+):(.*?)\]/ms ) {
        $replaced = $`.(($1 eq $BigSister::common::language)?$2:"").$';
    }
    return ($replaced);
}


sub _replace_vars {
    my( $self, $skin, $vars, $template, $depth, $localvars ) = @_;
    my( $replaced );

    print STDERR "_replace_vars()\n" if( $BigSister::common::dl>6 );
    $replaced = "";
    my $index;

    while( ($index = index( $template, "\@" )) >= 0  ) {
	my $what = "\@";
	my $pre = substr( $template, 0, $index );
	substr( $template, 0, $index+1, "" );
	my $next = substr( $template, 0, 1 );
	if( substr( $pre, length($pre)-1 ) eq ")" ) {
	    substr( $pre, length($pre)-1, 1, "" );
	    $what = ")\@";
	}
	elsif( ($next eq "(") || ($next eq "\@") ) {
	    $what .= $next;
	    substr( $template, 0, 1, "" );
	}
	$replaced .= $pre;
	if( $what eq "\@\@" ) {
	    # @@ means '@'
	    $replaced .= "\@\@";
	    print STDERR "  found \@\n" if( $BigSister::common::dl>7 );
	}
	elsif( $what eq "\@" ) {
	    # @variable@ -> replace variable by value
	    if( $template =~ /^([a-z0-9_\-\.]+)\@/i ) {
		$template = $';
		print STDERR "  found var $1\n" if( $BigSister::common::dl>7 );
		$replaced .= $self->_one_var( $skin, $vars, $1, $depth, $localvars );
	    }
	    else {
		$replaced .= "\@";
		print STDERR "  found quote \@\n" if( $BigSister::common::dl>7 );
	    }
	}
	elsif( $what eq ")\@" ) {
	    if( $depth ) {
		print STDERR "  found end_var )\@\n" if( $BigSister::common::dl>7 );
		return( $replaced, $template );
	    }
	    print STDERR "  found quoted )\@\n" if( $BigSister::common::dl>7 );
	    $replaced .= $what;
	}
	else {
	    my( $var );
	    print STDERR "  found nested \@(".(substr( $template,0,8 ))."...\n" if( $BigSister::common::dl>7 );
	    my $range = substr( $template, 0, 256, "" );
	    ( $var, $range ) = $self->_replace_vars( $skin, $vars, $range, $depth+1, $localvars );
	    substr( $template, 0, 0, $range );
	    print STDERR "  var is $var\n" if( $BigSister::common::dl>7 );
	    $replaced .= $self->_one_var( $skin, $vars, $var, $depth, $localvars );
	}
    }

    return( $replaced, $template );
}



sub _one_var {
    my( $self, $skin, $vars, $var, $depth, $localvars ) = @_;
    my( @args, $i );

    print STDERR "    _one_var( $var )\n" if( $BigSister::common::dl>7 );
    @args = split( ":", $var );
    $var = shift @args;
    if( defined $localvars->{$var} ) {
	$var = $localvars->{$var};
    }
    elsif( defined $vars->{$var} ) {
	$var = $vars->{$var};
    }
    else {
	$var = $self->get_skin( $skin, $var );
    }
    $localvars = {};
    for( $i=0; $i<=$#args; $i++ ) {
	$localvars->{"ARG$i"} = $args[$i];
    }
    my( $a, $b ) = $self->_replace_vars( $skin, $vars, $var, $depth, $localvars );
    return ($a.$b);
}





sub get_skin {
    my( $self, $skin, $what ) = @_;

    return undef unless( defined $skin->{$what} );
    if( $skin->{"T.".$what} ne "url" ) {
	return( $skin->{$what} );
    }
    my $text = $skin->{$what};
    if( (substr( $text, 0, 1 ) ne "/") && (defined $skin->{"_BASE"}) ) {
	return( $skin->{"_BASE"}."/".$text );
    }
    return $text;
}


sub find_skin {
    my( $self, $name ) = @_;
    my( $dir, $fname );

    print STDERR "find_skin( $name )\n" if( $BigSister::common::dl>5 );
    foreach $dir ( $BigSister::common::fs{"etc"}."/skins/", $BigSister::common::fs{"web"}."/skins/" ) {
	$fname = $dir.$name."/" if( -d $dir.$name );
    }
    return( $fname );
}


sub bypass_skincache {
    my( $self, $bypass ) = @_;
    $self->{"bypass_skincache"} = ! $bypass;
}


sub read_skin {
    my( $self, $name, $skin ) = @_;
    my( $fname, $file );

    print STDERR "read_skin( $name )\n" if( $BigSister::common::dl>2 );
    if( ($name eq "default") && (! $skin) && (defined $self->{"defaultskin"}) ) {
	$skin = $self->{"defaultskin"};
	my %skin = %$skin;
	return( \%skin );
    }
    $skin = {} unless( $skin );
    $fname = $self->find_skin( $name );
    unless( $fname ) {
	print STDERR "$BigSister::common::prog: WARNING: skin $name unknown (line $.)"; 
	return $skin;
    }

    if( (-s "$fname/cache") && (! $self->{"bypass_skincache"}) ) {
	print "reading skin from cache\n" if( $BigSister::common::dl>4 );
	open( _CACHE, "<$fname/cache" );
	while( <_CACHE> ) {
	    chomp;
	    my( $var, $val ) = split( "\x00", $_, 2 );
	    $val =~ tr/\x00/\n/;
	    $skin->{$var} = $val;
	}
	close _CACHE;
	return $skin;
    }


    opendir( _DIR, $fname ) ||
	print STDERR "$BigSister::common::prog: WARNING: cannot read directory $fname in line $. of config\n"; 
    foreach $file (readdir( _DIR )) {
	if( $file =~ /\.(proto|inc|sub)$/ ) {
	    $skin->{$file} = "";
	    open( _F, "<${fname}$file" );
	    while( <_F> ) {
		$skin->{$file} .= $_;
	    }
	    $skin->{$file} =~ s/\\\n$//;
	    close( _F );
	    $skin->{"T.".$file} = "file";
	}
	else {
	    $skin->{$file} = $fname.$file;
	    $skin->{$file} =~ s#^\Q$BigSister::common::fs{'web'}/##;
	    $skin->{"T.".$file} = "url";
	}
    }
    closedir( _DIR );
    return $skin;
}


sub cache_skin {
    my( $self, $name, $skin ) = @_;
    my( $dir, $fname, $file );
    my( $var, $val );

    print STDERR "cache_skin( $name )\n" if( $BigSister::common::dl>2 );
    $skin = {} unless( $skin );
    $fname = $self->find_skin( $name );
    unless( $fname ) {
	print STDERR "$BigSister::common::prog: WARNING: skin $name unknown"; 
	return undef;
    }
    open( OUT, ">$fname/cache" );
    while( ($var,$val) = each %$skin ) {
	$val =~ tr/\n/\x00/;
	print OUT $var."\x00".$val."\n";
    }
    close OUT;
}



sub encode {
    my( $self, $text ) = @_;
    my $trans;

    $trans = "";
    while( $text =~ /([^a-z0-9_\-])/ ) {
	$trans .= $`."%".sprintf("%x",ord($1));
	$text = $';
    }
    return $trans.$text;
}


sub encode_args {
    my( $self, $args ) = @_;

    my $url = "";
    while( my( $arg, $val ) = each %$args ) {
	my @val;
        if( ref $val ) {
	    @val = @$val;
	}
	else {
	    @val = split( "\0", $val );
	}
	foreach my $val (@val) {
	    $url .= "&" if( $url );
	    $url .= "$arg=".($self->encode($val));
	}
    }
    return $url;
}


1;
