#!/usr/bin/perl -w

#---libsetup---

# having . in @INC can cause tainting issues for use

no lib '.';

use FindBin;
BEGIN {
  ($dir)=($FindBin::Bin=~/^([\w\d\-\/\.]+)$/)
    or die "invalid current directory $FindBin::Bin";
}
use lib $dir;

#---endlibsetup---

use PhotoPub::Global qw(&init &finit);
use PhotoPub::CLBase qw();

use Cwd;
use Carp qw(&cluck);
use Image::Magick;
use Time::HiRes qw(time);

my $cancatch=0;
my @pendingerrors=();
my @expectederrors=();

BEGIN {
  chdir($dir);
  $PhotoPub::Config::configfile='scratch/photopubrc';
  $PhotoPub::Config::initbasedir=getcwd();
  $PhotoPub::Global::error=sub { 
    my %error=@_;
    push @pendingerrors,\%error;
    &cluck('Internal error') if $error{'type'} eq 'internal';
    return if $error{'type'} eq 'warning';
    goto ONERROR if $cancatch>0;
    &flusherrors();
    die;
  };
}

use PhotoPub::Config;

use PhotoPub::Utils qw(&makeabsolutepath);
use PhotoPub::Handlers qw(&listhandlephoto &handlephoto &parameterhandlephoto);
use PhotoPub::Album qw(&albumhtml);
use PhotoPub::Range qw(&rangehtml);
use PhotoPub::Embed qw(&embedhtml);
use PhotoPub::Options qw(&initoptions &setoptions);
use PhotoPub::Images qw(&picrange);
use PhotoPub::Cache qw(&imagefile &imagesize);

my %env=('basedir' => $dir);

my $collecttiming=0;
if($ARGV[0] eq '-t') {
  shift @ARGV;
  $collecttiming=1;
}

foreach my $file (@ARGV) {
  &runscript(&parsescript($file));
}

sub parsescript {
  my ($file)=@_;
  my $script=[];
  my @scriptstack=($script);
  open SCRIPT,"<$file" or die "Couldn't read $file";
  my $line=0;
  while(<SCRIPT>) {
    $line++;
    my $command;
    my $text;
    my $args;
    if(($command)=/^::(\w+)\s*$/) {
      push @{$scriptstack[0]},{'command' => $command, 
			       'line' => $line, 'file' => $file};
    } elsif(($command,$args)=/^::(\w+)\s+(.*)$/) {
      push @{$scriptstack[0]},
	{'command' => $command, 'args' => $args, 
	 'line' => $line, 'file' => $file};
    } elsif(($command)=/^:\{(\w+)\s*$/) {
      my $newscript=[];
      push @{$scriptstack[0]},
	{'command' => $command, 'script' => $newscript, 
	 'firstline' => $line, 'file' => $file};
      unshift @scriptstack,$newscript;
    } elsif(($command,$args)=/^:\{(\w+)\s+(.*)$/) {
      my $newscript=[];
      push @{$scriptstack[0]},
	{'command' => $command, 'script' => $newscript, 'args' => $args,
	 'firstline' => $line, 'file' => $file};
      unshift @scriptstack,$newscript;
    } elsif(/^:\}/) {
      shift @scriptstack;
      $scriptstack[0]->[scalar @{$scriptstack[0]}-1]->{'lastline'}=$line;
    } elsif(my ($type,$message)=/^:\!(\w+)\s+(.*)$/) {
      push @{$scriptstack[0]},
	{'error' => { 'type' => $type, 'message' => $message },
	 'line' => $line, 'file' => $file};
    } elsif(/^\#/ || /^\s*$/) {
    } else {
      push @{$scriptstack[0]},{'text' => $_};
    }
  }
  close SCRIPT;
  return $script;
}

my $posinfo='';

sub substvars {
  my ($textref)=@_;
  while(my ($var,$value)=each %env) {
    $$textref=~s/\$$var/$value/g;
  }
}

sub runscript {
  my ($script)=@_;
  foreach my $data (@$script) {
    $posinfo=defined $data->{'line'}
      ? " near line ".$data->{'line'}." of file ".$data->{'file'}
	: " near lines ".$data->{'firstline'}."-".$data->{'lastline'}
	  ." of file ".$data->{'file'};

    if(exists $data->{'error'}) {
      &substvars(\($data->{'error'}->{'message'}));
      push @expectederrors,$data->{'error'};
    }
    next unless exists $data->{'command'};
    my $command=$data->{'command'};
    if($command eq 'init') {
      $cancatch++;
      &init();
      if(exists $data->{'script'}) {
	&runscript($data->{'script'});
      }
      &finit();
      $cancatch--;
    ONERROR:
    } elsif($command eq 'write') {
      &write($data->{'args'},$data->{'script'});
    } elsif($command eq 'append') {
      &append($data->{'args'},$data->{'script'});
    } elsif($command eq 'run') {
      system($data->{'args'})==0 or die ("Command ".$data->{'args'}." failed");
    } elsif($command eq 'makeimage') {
      &makeimage(args=>$data->{'args'},data=>$data->{'script'});
    } elsif($command eq 'album') {
      &album($data->{'args'},$data->{'script'});
    } elsif($command eq 'range') {
      &range($data->{'args'},$data->{'script'});
    } elsif($command eq 'describe') {
      &oneline(handler=>'description',
	       data=>$data->{'script'},
	       args=>$data->{'args'});
    } elsif($command eq 'canonicalname') {
      &oneline(handler=>'canonicalname',
	       data=>$data->{'script'},
	       args=>$data->{'args'});
    } elsif($command eq 'albumtemplate') {
      &oneline(handler=>'albumtemplate',
	       data=>$data->{'script'},
	       args=>$data->{'args'});
    } elsif($command eq 'cachefile') {
      &oneline(handler=>'cachefileprefix',
	       data=>$data->{'script'},
	       args=>$data->{'args'});
    } elsif($command eq 'rangetitle') {
      &oneline(handler=>'rangeinfo',
	       data=>$data->{'script'},
	       args=>[split(/\s+/,$data->{'args'})],
	       postprocess=>sub {
		my ($rangeinfo)=@_;
		return defined $rangeinfo 
		  ? $rangeinfo->{'description'} 
		    : undef;
	      });
    } elsif($command eq 'whentaken') {
      &oneline(handler=>'whentaken',
	       data=>$data->{'script'},
	       args=>$data->{'args'});
    } elsif($command eq 'albumhtml') {
      &testhtml(name => 'album', sub => \&albumhtml,
		args => $data->{'args'}, data => $data->{'script'});
    } elsif($command eq 'rangehtml') {
      &testhtml(name => 'range', sub => \&rangehtml,
		args => $data->{'args'}, data => $data->{'script'});
    } elsif($command eq 'embedhtml') {
      &testhtml(name => 'embed', sub => \&embedhtml,
		args => $data->{'args'}, data => $data->{'script'});
    } elsif($command eq 'checksize') {
      &checksize($data->{'args'});
    } elsif($command eq 'sleep') {
      sleep($data->{'args'});
    } elsif($command eq 'test') {
      &handlephoto('test',$data->{'args'});
    } elsif($command eq 'call') {
      foreach my $file (split /\s+/,$data->{'args'}) {
	&runscript(&parsescript($file));
      }    
    } else {
      print STDERR "Unknown command $command at line "
	.$data->{'line'}." of ".$data->{'file'}."\n";
    }
    &flusherrors();
  }
}

sub gettext {
  my ($inarr)=@_;
  my $outarr=[];
  foreach my $in (@$inarr) {
    if(exists $in->{'command'}) {
      if($in->{'command'} eq 'for') { 
	if(my ($var,$from,$to)
	   =($in->{'args'}=~/^\s*(\w+)\s+(\d+)\s+(\d+)\s*$/)) {
	  my %oldenv=%env;
	  for my $val ($from..$to) {
	    $env{$var}=$val;
	    push @$outarr,@{&gettext($in->{'script'})};
	  }
	  %env=%oldenv;
	}
      }
    }
    if(exists $in->{'error'}) {
      $error=$in->{'error'};
      &substvars(\($error->{'message'}));
      push @expectederrors,$error;
    }
    if(exists $in->{'text'}) {
      $text=$in->{'text'};
      &substvars(\$text);
      push @$outarr,$text;
    }
  }
  return $outarr;
}

sub printerror {
  my ($error)=@_;
  print "   ".$error->{'type'}.": ".$error->{'message'}."\n";
}

sub flusherrors {
  while(@pendingerrors || @expectederrors) {
    my $pending=shift @pendingerrors;
    my $expected=shift @expectederrors;

    next if defined $pending && defined $expected 
      && $pending->{'type'} eq $expected->{'type'}
	&& $pending->{'message'} eq $expected->{'message'};

    if(defined $pending && defined $expected) {
      print "Mismatch in errors$posinfo\n";
      print "Expected:\n";
      &printerror($expected);
      print "Got:\n";
      &printerror($pending);
    } elsif(defined $pending) {
      print "Got an unexpected error$posinfo:\n";
      &printerror($pending);
    } elsif(defined $expected) {
      print "Didn't get an expected error$posinfo:\n";
      &printerror($expected);
    } else {
      die "This shouldn't happen$posinfo";
    }
  }
}

sub oneline {
  my %options=@_;
  my $handler=$options{'handler'};
  my $data=$options{'data'};
  my $args=ref ($options{'args'}) eq 'ARRAY' 
    ? $options{'args'} : [$options{'args'}];

  my $postprocess=$options{'postprocess'};

  my $expected=&gettext($data)->[0];

  foreach my $i (0..$#$args) {
    &makeabsolutepath(\$args->[$i]);
  }

  my $got=scalar @$args==1 
    ? &handlephoto($handler,@$args) 
    : &parameterhandlephoto($handler,@$args);
  $got=&$postprocess($got) if defined $postprocess;
  $got.="\n" if defined $got;
  return if !defined $got && !defined $expected;
  return if defined $got && defined $expected && $got eq $expected;

  print "Mismatch reading $handler for ".join(' ',@$args)."$posinfo\n";
  print "Expected:\n";
  print "   $expected" if defined $expected;
  print "Got:\n";
  print "   $got" if defined $got;
}

sub compareblock {
  my ($errortext,$gotarr,$expectedarr)=@_;
  my $got;
  my $expected;
  do {
    $got=shift @$gotarr;
    $expected=shift @$expectedarr;
  } while(defined $got && defined $expected && $expected eq $got);

  return unless defined $got || defined $expected;
  
  print $errortext."\n";
  print " Expected:\n";
  while(defined $expected) {
    print "  $expected";
    $expected=shift @$expectedarr;
  }
  print " Got:\n";
  while(defined $got) {
    print "  $got";
    $got=shift @$gotarr;
  }
}  

sub album {
  my ($album,$script)=@_;
  my @expected=@{&gettext($script)};

  chop($album) if substr($album,-1) eq '/';
  &makeabsolutepath(\$album);
  my $t0=time() if $collecttiming;
  my $items=&listhandlephoto('album',$album);
  print ("album time: ".(time()-$t0)."\n") if $collecttiming;

  my @got;
  foreach my $item (@$items) {
    if($item->{'type'} eq 'group') {
      push @got,'range '.$item->{'range'}.' '.$item->{'description'}."\n";
    } else {
      push @got,'album '.$item->{'album'}.' '.$item->{'title'}."\n";
    }
  }

  &compareblock("Mismatch reading album $album$posinfo",\@got,\@expected);
}

sub range {
  my ($range,$script)=@_;
  my @expected=@{&gettext($script)};
  
  &makeabsolutepath(\$range);

  my @items=&picrange($range);
  foreach my $item (@items) {
    push @got,"$item\n";
  }
  &compareblock("Mismatch reading range $range$posinfo",\@got,\@expected);
}


sub write {
  my ($file,$script)=@_;
  open FILE,">$file";
  foreach my $line (@{&gettext($script)}) {
    print FILE $line;
  }
  close FILE;
}

sub append {
  my ($file,$script)=@_;
  open FILE,">>$file";
  foreach my $line (@{&gettext($script)}) {
    print FILE $line;
  }
  close FILE;
}

sub testhtml {
  my (%options)=@_;
  my $name=$options{'name'};
  my $sub=$options{'sub'};
  my $args=$options{'args'};
  my @expected=@{&gettext($options{'data'})};
  my %args=split(/(?:\=|\s+)/,$options{'args'});

  my $got="";
  &$sub(\%args,sub {},sub { $got.=shift; });
  my @got=();
  foreach my $line (split(/\n/,$got)) {
    next if $line eq '';
    push @got,"$line\n";
  }
  &compareblock("Mismatch in $name HTML for $args$posinfo",\@got,\@expected);
}

sub makeimage {
  my (%options)=@_;
  my ($size,$filename)=split(/\s+/,$options{'args'});
  my $image=Image::Magick->new();
  $image->Set(size=>$size);
  $image->ReadImage('xc:black');
  $image->Write("jpeg:$filename");
}

sub checksize {
  my ($args)=@_;
  my @args=split(/\s+/,$args);
  my $photo=shift @args;
  my %args=();
  foreach my $arg (@args) {
    my ($left,$right)=split(/=/,$arg);
    $args{$left}=$right;
  }

  my $image_options=&initoptions();
  &setoptions($image_options,\%args);

  my ($guessedwidth,$guessedheight)=&imagesize($photo,$image_options);

  $guessedwidth=-1 unless defined $guessedwidth;
  $guessedheight=-1 unless defined $guessedheight;
  
  my $imagefile=&imagefile($photo,$image_options);

  my $image = new Image::Magick;
  if(my $res = $image->Read('JPG:'.$imagefile)) { 
    &$error(type => 'internal',
	    message => $res);
  }

  my ($width,$height)=$image->Get('width','height');

  return if $width==$guessedwidth && $height==$guessedheight;

  print "Mismatch with sizes for $args$posinfo\n";
  print "Guessed:\n";
  print '   '.$guessedwidth.'x'.$guessedheight."\n";
  print "Actual:\n";
  print '   '.$width.'x'.$height."\n";
}
