#!/usr/bin/perl -w

use strict;
use Data::Dumper;
use File::Basename;
use File::Path;
use File::Copy;

# TODO add nodiff for no diff files
my %formats = (
    'info'      => [ { 'options' => '' } ],
    'html'      => [ { 'files' => '%%' }, 
                   { 'options' => '--html --no-split' } ],
    'xml'       => undef,
    'plaintext' => [ { 'options' => '--no-headers > %%.txt', 'files' => '%%.txt' } ], 
    'macros'    => [ { 'options' => '-E %%.macros', 'files' => '%%.macros' } ],
    'tex'       => [ { 'command' => 'texi2dvi', 'options' => '-b', 
      'files' => '%%.dvi %%.fn %%.cp %%.pg %%.ky %%.tp %%.vr %%.aux %%.log' },
#      { 'command' => 'dvips', 'options' => '-o %%.ps', 'files' => '%%.ps', 'file' => '%%.dvi' } 
                   ],
     'pdf'      => [ { 'command' => 'texi2dvi', 'options' => '-b --pdf',
        'files' => '%%.pdf %%.fn %%.cp %%.pg %%.ky %%.tp %%.vr %%.aux %%.log'                 
                     } ]
);

my @command_items = ('command', 'options', 'files', 'file', 'no', 'status');

my $dvicheck = './dvicheck';

sub usage()
{
    die "usage: $0 [-c|-r|-k][-v] [format [no|status <exit_status>|command <command>|options <options>|files <files>|file <file>]*]* file\n";
}

if (! @ARGV)
{
    usage();
}

my $file;
my $verbose = 0;
my $keep = 0;
my $regenerate = 0;
my $create = 0;
my $options = 1;
while ($options)
{
    $file = shift @ARGV;
    if ($file eq '-v')
    {
         $verbose = 1;
    }
    elsif ($file eq '-k')
    {
         $keep = 1;
    }
    elsif ($file eq '-r')
    {
         $regenerate = 1;
    }
    elsif ($file eq '-c')
    {
         $create = 1;
    }
    elsif ($file eq '-h')
    {
         print STDERR <<EOT;
$0 [options] [format specifications] file
file:
    texinfo manual to test

options:
    -c     create new reference (.ok) files
    -r     regenerate reference files with the result of the commands
    -k     keep result files even if there was no error
    -v     verbose
    -h     this help

format specifications:
    format [no|command <command>|options <options>|files <files>|file <file>]
    %% is transformed into the file basename
        no        don't test this format
        status    exit status
        command   command to run
        options   options for the command
        files     files generated to be compared with referecnes
        file      input file if not the same than main file
EOT
        exit 0;
    }
    else
    {
         $options = 0;
    }
}
my $number;
my $add = 0;
my $format = '';
my $command_item = '';
my $no_number;

foreach my $arg (@ARGV)
{
    if ($command_item ne '')
    {
         if (!$add)
         {
              $formats{$format}->[($number - 1)]->{$command_item} = $arg;
         }
         else
         {
              $formats{$format}->[($number - 1)]->{$command_item} .= " $arg";
         }
         $command_item = '';
    }
    else
    {
         $add = 0;
         if ($arg =~ /^\+([A-Za-z]+)$/)
         {
              $arg = $1;
              if (grep {$_ eq $arg} @command_items)
              {
                  $add = 1;
              }
              else
              {
                  die "waiting for command_item after +, got $arg\n";
              }
         }
         elsif ($arg =~ /^([A-Za-z]+)(\d+)$/)
         {
              $arg = $1;
              die "only formats may be numbered, not $arg\n" if
                  (!exists($formats{$arg})); 
              $number = $2;
         }
         elsif ($arg =~ /^([A-Za-z]+)$/)
         {
              $number = undef if (exists($formats{$arg}));
         }
         else
         {
              die "Bad command_item or format $arg\n";
         }
         if (exists ($formats{$arg}))
         {
              $format = $arg;
              $command_item = '';
              $no_number = 0;
              if (!$number)
              {
                  $number = 1;
                  $no_number = 1;
              }
         }
         elsif (grep {$_ eq $arg} @command_items)
         {
              if ($format eq '')
              {
                   die "need a format before $arg\n";
              }
              if ($arg eq 'no')
              {
                   
                   if ($no_number)
                   {
                       $formats{$format} = [];
                   }
                   else 
                   {
                       $formats{$format}->[($number - 1)] = undef;
                   }
              }
              else
              {
                   $command_item = $arg;
              }
         }
         else
         {
              die "waiting for command_item or format, got $arg\n";
         }
    }
}

foreach my $key (keys(%formats))
{
    #$formats{$key}->{'commands'} = [ { 'command' => 'makeinfo', 'options' => '', 'fail' => 0, 'files' => '%%.$key' } ] unless exists($formats{$key}->{'commands'});
    my $default = { 'command' => 'makeinfo', 'options' => "--$key", 
          'status' => 0, 'files' => '%%.' . "$key", 'file' => $file };
    if (!defined($formats{$key}))
    {
        $formats{$key} = [ $default ];
    }
    else
    {
        foreach my $command (@{$formats{$key}})
        {
            next if (!$command);
            foreach my $elem (keys(%$default))
            {
                 if (!exists($command->{$elem}))
                 {
                      $command->{$elem} = $default->{$elem};
                 }
            }
        }
    }
}

#print STDERR "" . Data::Dumper->Dump([\%formats], ['formats']);
    
my $basename = basename($file);
if ($basename =~ /(.*)\./)
{
    $basename = $1;
}

sub unlink_file_dir(@)
{
    while (@_)
    {
        my $file_dir = shift;
        if (-f $file_dir)
        {
            if (unlink($file_dir) != 1)
            {
                die "Could not unlink $file_dir\n";
            }
        }
        elsif (-d $file_dir)
        {
            eval { rmtree($file_dir, 0, 1) };
            if ($@)
            {
                 die "Could not delete $file_dir directory\n";
            }
        }
    }
}

sub regenerate_files(@)
{
    foreach my $file (@_)
    {
         move ($file, $file . '.ok');
    }
}

sub print_error($$$)
{
    my $string = shift;
    my $doing = shift;
    my $need_doing = shift;
    if ($$need_doing)
    {
         $string = "\n$doing $string";
         $$need_doing = 0;
    }
    print $string;
}

my $result = 0;
foreach my $format (keys(%formats))
{
    my $command_nr = 0;
    my $need_doing = 1;
    my @files_to_unlink = ();
    my @files_to_create = ();
    foreach my $command (@{$formats{$format}})
    {
         next if !defined($command);
         $command_nr++;
         my $command_result = 0;
         foreach my $item (('command', 'options', 'files', 'file'))
         {
              $command->{$item} =~ s/%%/$basename/g;
         }
         $command->{'files'} =~ s/^\s*//;
         $command->{'files'} =~ s/\s*$//;
         my @result_files = ();
         if ($command->{'files'} ne '')
         {
              @result_files = split /\s+/, $command->{'files'};
         }
         my $doing = $format;
         if ($command_nr > 1)
         {
              $doing = "$format-$command_nr"; 
         }
         push @result_files, ("$basename.$doing.2", "$basename.$doing.1"); 
         foreach my $result_file (@result_files)
         {
             unlink_file_dir ($result_file);
         }
         print "$command->{'command'} $command->{'options'} $command->{'file'} 2>$basename.$doing.2 > $basename.$doing.1\n" if ($verbose);
         if (system ("$command->{'command'} $command->{'options'} $command->{'file'} 2>$basename.$doing.2 > $basename.$doing.1") == -1)
         {
              warn "system() failed: $command->{'command'} $command->{'options'} $command->{'file'}: $?\n";
         }
         else
         {
              $need_doing = 1;
              my $exit_value  = $? >> 8;
              if ($exit_value !=  $command->{'status'})
              {
                   $command_result += abs($command->{'status'} - $exit_value);
                   print_error ("bad status $exit_value != $command->{'status'}\n", $doing, \$need_doing);
              }
              else 
              {
                   print ".";
              }
              foreach my $result_file (@result_files)
              {
                  my $ok_file = $result_file . '.ok';
                  if (-d $ok_file)
                  {
                       if (!-d $result_file)
                       {
                            print_error ("missing dir $result_file\n", $doing, \$need_doing);
                            $command_result++;
                            next;
                       }
                  }
                  elsif (-f $ok_file)
                  {
                       if (!-f $result_file)
                       {
                            print_error ("missing file $result_file\n", $doing, \$need_doing);
                            $command_result++;
                            next;
                       }
                  }
                  else 
                  {
                       push (@files_to_unlink, $result_file) unless ($command_result or $keep);
                       if ($result_file =~ /\.dvi$/)
                       {
                            push (@files_to_unlink, "$result_file.dvicheck.1") if (-f "$result_file.dvicheck.1" and !$keep);
                            push (@files_to_unlink, "$result_file.dvicheck.2") if (-f "$result_file.dvicheck.2" and !$keep);
                       }
                       else
                       {
                       # remove stale .diff.1 file in case there was a previous 
                       # run with -k and no .ok file anymore
                            push (@files_to_unlink, "$result_file.diff.1") if (-f "$result_file.diff.1" and !$keep);
                            push (@files_to_unlink, "$result_file.diff.2") if (-f "$result_file.diff.2" and !$keep);
                            push (@files_to_unlink, $result_file) unless ($command_result or $keep);
                       }
                       next;
                  }
                  if ($regenerate)
                  {
                       regenerate_files($result_file);
                       next;
                  }
                  if ($result_file =~ /\.dvi$/)
                  {
                       if (system ("$dvicheck $result_file $ok_file 2>$result_file.dvicheck.2 > $result_file.dvicheck.1") == -1)
                       {
                            warn "system() failed: $dvicheck $result_file $ok_file: $?\n";
                       }
                       else
                       {
                            my $exit_value  = $? >> 8;
                            if ($exit_value != 0) 
                            {
                                  print_error ("Failed: $dvicheck $result_file $ok_file\n", $doing, \$need_doing);
                            }
                            else
                            {
                                  #push (@files_to_create, $result_file);
                                 push (@files_to_unlink, "$result_file.dvicheck.2", "$result_file.dvicheck.1") unless ($command_result or $keep);
                                 print STDERR ".";
                            }
                            #$result_file = $dvitype_file;
                            $command_result += abs($exit_value);
                       }
                  }
                  else
                  {
                       my $diff_cmd = 'diff -u';
                       $diff_cmd .= ' -r' if (-d $ok_file);
                       $diff_cmd .= " $ok_file $result_file > $result_file.diff.1 2>$result_file.diff.2";
                       if (system ($diff_cmd) == -1)
                       {
                            warn "system() failed: $diff_cmd  $?\n";
                       } 
                       else
                       {
                            my $exit_value  = $? >> 8;
                            if ($exit_value)
                            {
                                  $command_result += abs($exit_value);
                                  print_error ("diff failed: $result_file\n", $doing, \$need_doing);
                            }
                            else
                            {
                                push (@files_to_unlink, ($result_file, "$result_file.diff.1", "$result_file.diff.2")) unless ($keep);
                                print STDERR ".";
                            }
                       }
                  }
             }
             $result += abs($command_result);
         }
         push (@files_to_create, @result_files) if ($create);
    }
    if ($create)
    {
         foreach my $result_file (@files_to_create)
         {
             # this leaves .dvitype.2 files. Not a big deal
             move ($result_file, $result_file . '.ok') unless (-e $result_file . '.ok');
         }
    }
    else
    {
         unlink_file_dir (@files_to_unlink) unless ($create);
    }
}
print "\n";
exit ($result);