[rewrote test/handlers.pl ; now can check for expected/unexpected errors
ganesh@earth.li**20040405054515] {
hunk ./test/handlers.pl 23
+my $cancatch=0;
+my @pendingerrors=();
+my @expectederrors=();
+
hunk ./test/handlers.pl 31
-#  $PhotoPub::Global::error=sub { };
+  $PhotoPub::Global::error=sub { 
+    my %error=@_;
+    push @pendingerrors,\%error;
+    return if $error{'type'} eq 'warning';
+    goto ONERROR if $cancatch>0;
+    &flusherrors();
+    die;
+  };
hunk ./test/handlers.pl 44
-foreach my $script (@ARGV) {
-  open SCRIPT,"<$script" or die "Couldn't read $script";
-  my $untilend=sub {
-    my $finished=0;
-    my $tocall=shift;
-    my $readline=sub {
-      return undef if $finished;
-      return undef if eof(SCRIPT);
-      my $in;
-      do {
-	$in=<SCRIPT>;
-      } while($in=~/^#/);
-      if($in=~/^:\}/) {
-	$finished=1;
-	return undef;
-      } else {
-	return $in;
-      }
-    };
-    &$tocall(@_,$readline);
-    if(!$finished) {
-      my $in;
-      do {
-	$in=&$readline();
-      } until(!defined $in);
-    }
-  };
-    
+my %env=('basedir' => $dir);
+
+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;
hunk ./test/handlers.pl 57
-    if(/^::init/) {
-      &init()
-    } elsif(/^:{write (.*)$/) {
-      &$untilend(\&write,$1);
-    } elsif(/^:{append (.*)$/) { 
-      &$untilend(\&append,$1);
-    } elsif(/^::run (.*)$/) {
-      system($1)==0 or die "Command '$1' failed";
-    } elsif(/^:{album (.*)$/) {
-      &$untilend(\&album,$1);
-    } elsif(/^:{describe (.*)$/) {
-      &$untilend(\&describe,$1);
-    } elsif(/^::sleep (.*)$/) {
-      sleep($1);
+    $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' => $_};
hunk ./test/handlers.pl 93
+  return $script;
hunk ./test/handlers.pl 96
-sub describe {
-  my ($photo,$readline)=@_;
-  &makeabsolutepath(\$photo);
+my $posinfo='';
hunk ./test/handlers.pl 98
-  my $got=&handlephoto('description',$photo);
+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'};
+
+    push @expectederrors,$data->{'error'} if exists $data->{'error'};
+    next unless exists $data->{'command'};
+    my $command=$data->{'command'};
+    if($command eq 'init') {
+      $cancatch++;
+      &init();
+      if(exists $data->{'script'}) {
+	&runscript($data->{'script'});
+      }
+      $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 'album') {
+      &album($data->{'args'},$data->{'script'})
+    } elsif($command eq 'describe') {
+      &oneline('description',$data->{'args'},$data->{'script'})
+    } elsif($command eq 'albumtemplate') {
+      &oneline('albumtemplate',$data->{'args'},$data->{'script'})
+    } elsif($command eq 'sleep') {
+      sleep($data->{'args'});
+    } elsif($command eq 'test') {
+      &handlephoto('test',$data->{'args'});
+    } else {
+      print STDERR "Unknown command $command at line "
+	.$data->{'line'}." of ".$data->{'file'}."\n";
+    }
+    &flusherrors();
+  }
+}
+
+sub substvars {
+  my ($textref)=@_;
+  while(my ($var,$value)=each %env) {
+    $$textref=~s/\$$var/$value/g;
+  }
+}
+
+sub gettext {
+  my ($inarr)=@_;
+  my $outarr=[];
+  foreach my $in (@$inarr) {
+    if(exists $in->{'error'}) {
+      $error=$in->{'error'};
+      &substvars(\$error);
+      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 ($handler,$photo,$script)=@_;
+  my $expected=&gettext($script)->[0];
+
+  &makeabsolutepath(\$photo);
+  my $got=&handlephoto($handler,$photo);
hunk ./test/handlers.pl 205
-  my $expected=&$readline();
hunk ./test/handlers.pl 208
-  print STDERR "Mismatch reading description for $photo\n";
-  print STDERR "Expected:\n";
-  print STDERR "   $expected" if defined $expected;
-  print STDERR "Got:\n";
-  print STDERR "   $got" if defined $got;
+  print "Mismatch reading $handler for $photo$posinfo\n";
+  print "Expected:\n";
+  print "   $expected" if defined $expected;
+  print "Got:\n";
+  print "   $got" if defined $got;
hunk ./test/handlers.pl 216
-  my ($album,$readline)=@_;
+  my ($album,$script)=@_;
+  my @expected=@{&gettext($script)};
+
hunk ./test/handlers.pl 235
-    $expected=&$readline();
+    $expected=shift @expected;
hunk ./test/handlers.pl 240
-  print STDERR "Mismatch reading album $album\n";
-  print STDERR " Expected:\n";
+  print "Mismatch reading album $album$posinfo\n";
+  print " Expected:\n";
hunk ./test/handlers.pl 243
-    print STDERR "  $expected";
-    $expected=&$readline;
+    print "  $expected";
+    $expected=shift @expected;
hunk ./test/handlers.pl 246
-  print STDERR " Got:\n";
+  print " Got:\n";
hunk ./test/handlers.pl 248
-    print STDERR "  $got";
+    print "  $got";
hunk ./test/handlers.pl 254
-  my ($file,$readline)=@_;
+  my ($file,$script)=@_;
hunk ./test/handlers.pl 256
-  while(my $data=&$readline()) {
-    print FILE $data;
+  foreach my $line (@{&gettext($script)}) {
+    print FILE $line;
hunk ./test/handlers.pl 263
-  my ($file,$readline)=@_;
+  my ($file,$script)=@_;
hunk ./test/handlers.pl 265
-  while(my $data=&$readline()) {
-    print FILE $data;
+  foreach my $line (@{&gettext($script)}) {
+    print FILE $line;
}