# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
#########################

use Test;
BEGIN { plan tests => 5 };
use Text::Starfish;
use File::Copy;
use Carp;
ok(1);				# made this far

# Slash hack was added because the Windows terminal evaluates does not
# evaluate $vars (the use a %varname% form instead) and therefore would
# not require the extra escape character at the beginning of the variable.
my $slash_hack;
if ($^O =~ m/MSWin/) {
	$slash_hack = '';
}
else {
	$slash_hack = '\\';
}
mkdir 'tmp', 0700 unless -d 'tmp';
mkdir 'tmp/Text', 0700 unless -d 'tmp/Text';
copy('Starfish.pm','tmp/Text/Starfish.pm');

{
    my $f = getfile('starfish');
    $f =~ s<^#!/usr/bin/perl>{#!/usr/bin/perl -I../blib/lib} or die;
    putfile('tmp/starfish', $f);
}

chdir 'tmp' or die;

if (&is_module_available('CGI')) {
  &testcase('01', 'replace'); # "ok 2" requires CGI module
} else {
  ok(1); print "\tskipped (ok 2) - CGI module not available\n"; }

if (&is_module_available('CGI')) {
  &testcase('02', 'replace'); # "ok 3" requires CGI module
} else {
  ok(1); print "\tskipped (ok 3) - CGI module not available\n"; }

&testcase('03', 'replace'); # "ok 4"
&testcase('05', 'replace'); # "ok 5"
&testcase('06'); # was 5 "ok 6"
&testcase('07'); # was 25, Makefile "ok 7"
&testcase('08'); # Makefile "ok 8"
&testcase('09', 'replace'); # old 7, html "ok 9"
&testcase(2);
&testcase(3);
&testcase(4);
&testcase(6, 'out');
&testcase(8);
&testcase(9, 'out');
&testcase(30); # html.sfish to html (16 ok)
# 10 (ok 17)
copy('../testfiles/9_java.out', '9_java.out');
starfish_cmd(qw(-o=10_java.out -e=$Starfish::HideMacros=1 9_java.out));
ok(getfile('10_java.out'),
   getfile("../testfiles/10_java.out"));
# 11 (ok 18)
copy('../testfiles/10_java.out', '10.java');
starfish_cmd(qw(-o=11_java.out 10.java));
ok(getfile('11_java.out'),
   getfile("../testfiles/11_java.out"));

# 12 (ok 19)
`echo "OSNAME | $OSNAME |"`;
# Skip if it is windows
if ($^O =~ m/MSWin/) {
  skip('Skipped under windows...');
}
else {
  copy('../testfiles/10_java.out', '12.java');
  #`perl -I. -- starfish -o=12.out -mode=0444 12.java`;
  starfish_cmd(qw(-o=12.out -mode=0444 12.java));
  #my $tmp = `ls -l 12.out|sed 's/ .*//'`;
  #my $tmp = `stat -c %a 12.out`;
  # checking permissions
  my $tmp = sprintf("%o", 0777 & (stat '12.out')[2]);
  chmod 0600, '12.out';
  ok($tmp, "444");
}

# (ok 20)
&testcase(13, 'out');

# 14 (ok 21)
copy('../testfiles/13_java.in','14.java');
#`perl -I. -- starfish -o=14.out -e="$slash_hack\$Star::HideMacros=1" 14.java`;
starfish_cmd(qw(-o=14.out -e=$Star::HideMacros=1 14.java));
comparefiles('../testfiles/14.out', '14.out');

    # 15,16
    copy('../testfiles/15.java','tmp.java');
    `$^X -I. -- starfish -o=tmp.ERR -e="$slash_hack\$Star::HideMacros=1" tmp.java>tmp1 2>&1`;
    ok($? != 0);
    okfiles('../testfiles/15.out', 'tmp1');

    # 17, old 16
    copy('../testfiles/16develop.SLeP','tmp.SLeP');
    copy('../testfiles/16.tex','tmp.tex');
    `$^X -I. -- starfish tmp.SLeP tmp.tex`;
	if ($^O =~ m/MSWin/) {
	    `copy /B /Y tmp.SLeP+tmp.tex tmp1`;
	}
	else {
	    `cat tmp.SLeP tmp.tex>tmp1`;
	}
    okfiles('../testfiles/16.out', 'tmp1');

    # 18, old 17
    copy('../testfiles/p_t.java','tmp.java');
    `$^X -I. -- starfish -o=tmp1 tmp.java`;
    okfiles('../testfiles/17.out', 'tmp1');

    # 19, old 18
    copy('../testfiles/p_t.java', 'tmp.java');
    `$^X -I. -- starfish -e="$slash_hack\$Release=1" -o=tmp1 tmp.java`;
    okfiles('../testfiles/18.out', 'tmp1');

# 20, old 19 (ok 27)
if ($^O =~ m/MSWin/) {
  skip('Skipped under windows...');
} else {
  copy('../testfiles/19.html', 'tmp.html');
  #`$^X -I. -- starfish -replace -o=tmp2 -mode=0644 tmp.html`;
  starfish_cmd(qw(-replace -o=tmp2 -mode=0644 tmp.html));
  # checking permissions
  #`ls -l tmp2|sed 's/ .*//'>tmp1`;
  my $tmp = sprintf("%o", 0777 & (stat 'tmp2')[2]);
  ok($tmp, "644");
}

# 21, old 20 has to be done after previous (ok 28)
if ($^O =~ m/MSWin/) {
  skip('Skipped under windows...');
} else {
  #`$^X -I. -- starfish -replace -o=tmp2 tmp.html`;
  starfish_cmd(qw(-replace -o=tmp2 tmp.html));
  # checking permissions
  #`ls -l tmp2|sed 's/ .*//'>tmp1`;
  my $tmp = sprintf("%o", 0777 & (stat 'tmp2')[2]);
  ok($tmp, "644");
}

    # 22, old 21
    copy('../testfiles/21.html','tmp2.html');
    `$^X -I. -- starfish -replace -o=tmp1 tmp2.html`;
    okfiles('../testfiles/21.out', 'tmp1');

    # 23
    &testcase(22);    

    # 24
    &testcase(24);
    #copy('../testfiles/24.py','24.py');
    #`$^X -I. -- starfish 24.py`;
    #okfiles('../testfiles/24.py.out', '24.py');

# 26
copy('../testfiles/26_include_example.html','26_include_example.html');
copy('../testfiles/26_include_example1.html','26_include_example1.html');
starfish_cmd(qw(-replace -o=26-out.html 26_include_example.html));
okfiles('../testfiles/26-out.html', '26-out.html');

# 33
&testcase(33, 'in:33_tex.in->33.tex -replace -o=33-lecture.tex');
&testcase(34, 'in:33_tex.in->34.tex -replace -o=34-slides.tex');
&testcase(35, 'in:35_tex.in->35.tex -replace -o=35-slides.tex');

sub okfiles {
    my $f1 = shift;
    while (@_) {
	my $f2 = shift;
	if (!-f $f1)
	{ die "file $f1 does not exist (to be compared to tmp/$f2)"	}
	if (! ok(getfile($f2), getfile($f1)) )
	{ print STDERR "pwd=".`pwd`."Files: $f1 and $f2\n" }

    }
}

sub getfile($) {
    my $f = shift;
    local *F;
    open(F, "<$f") or croak "getfile:cannot open $f:$!";
    my @r = <F>;
    close(F);
    return wantarray ? @r : join ('', @r);
}

sub testcase {
    my $testnum = shift;
    my ($infile, $procfile, $replace, $out, $outfile);
    my $testdir = "test-$testnum";
    if (-d $testdir) { `rm -rfv $testdir/*` }
    else { mkdir $testdir, 0700 or die "can't mkdir $testdir: $!"; }
    chdir $testdir or die;
    my $testfilesdir = '../../testfiles';

    # example: &testcase(34, 'in:33_tex.in->34.tex -replace -o=34-slides.tex');
    if ($#_==0 && $_[0] =~ /^in:(\S*)->(\S*) -replace -o=(\S*)$/) {
      $infile = $1; $procfile = $2; $outfile = $replace = $3;
    }
    elsif ( -e "$testfilesdir/$testnum.in" and $#_==-1) {
	$infile   = "$testnum.in";
	$procfile = "$testnum.in";
	$outfile  = "$testnum.out";
    }
    elsif ( -e "$testfilesdir/$testnum.in" and
	    $#_==0 and $_[0] eq 'out' ) {
	$infile   = "$testnum.in";
	$procfile = "$testnum.in";
	$outfile  = "$testnum.out";
	$out      = "$testnum.out";
    }
    elsif ( -e "$testfilesdir/$testnum.in" and
	    $#_==0 and $_[0] eq 'replace' ) {
	$infile   = "$testnum.in";
	$procfile = "$testnum.in";
	$outfile  = "$testnum.out";
	$replace  = "$testnum.out";
    }
    elsif ( -e "$testfilesdir/${testnum}_html.in" ) {
	$infile = "${testnum}_html.in";
	$procfile = "$testnum.html";
	$outfile = "${testnum}_html.out";
        if ($#_ > -1 and $_[0] eq 'replace')
	{  $replace = "${testnum}_out.html" }
    }
    elsif ( -e "$testfilesdir/${testnum}_Makefile.in" ) {
	$infile = "${testnum}_Makefile.in";
	$procfile = "Makefile";
	$outfile = "${testnum}_Makefile.out";
        if ($#_ > -1 and $_[0] eq 'replace')
	{  $replace = "${testnum}_Makefile.out" }
    }
    elsif ( -e "$testfilesdir/${testnum}_tex.in" ) {
	my $ext = $1;
	$infile = "${testnum}_tex.in";
	$procfile = "$testnum.tex";
	$outfile = "${testnum}_tex.out";
        if ($#_ > -1 and $_[0] eq 'replace')
	{  $replace = "${testnum}_out.tex" }
    }
    elsif ( -e "$testfilesdir/${testnum}.html.sfish" ) {
	$infile = "${testnum}.html.sfish";
	$procfile = "$testnum.html.sfish";
	$replace = "$testnum.html";
	$outfile = "${testnum}_html.out";
    }
    elsif ( -e "$testfilesdir/${testnum}_java.in" and
	    $#_==0 and $_[0] eq 'out' ) {
	$infile = "${testnum}_java.in";
	$procfile = "$testnum.java";
	$outfile = "${testnum}_java.out";
	$out     = "${testnum}_java.out";
    }
    elsif ( -e "$testfilesdir/${testnum}.py" and
	    -e "$testfilesdir/${testnum}.py.out" ) {
	$infile = "${testnum}.py";
	$procfile = "$testnum.py";
	$outfile = "${testnum}.py.out";
    }
    else { die }

    mycopy("$testfilesdir/$infile",  $procfile);
    my $outExpected = "$outfile-expected";
    my $outfile_masked = $outfile;
    $outfile_masked =~ s/\.tex$/_tex.out/;
    if (!-f "$testfilesdir/$outfile" && -f "$testfilesdir/$outfile_masked")
    { mycopy("$testfilesdir/$outfile_masked", "$outfile-expected"); }
    else
    { mycopy("$testfilesdir/$outfile", "$outfile-expected"); }
    my $outNew      = $procfile;
    my @sfishArgs = ( '-e=$ver="testver"', $procfile );
    if ($replace) {
      @sfishArgs = ('-e=$ver="testver"', '-replace', "-o=$replace", $procfile);
      $outNew = $replace;
    }
    elsif ($out) {
      @sfishArgs = ('-e=$ver="testver"', "-o=$out", $procfile);
      $outNew = $out;
    }

    putfile('test-description', '# CWD: '.`pwd`.
	    "# cp $testfilesdir/$outfile $outfile-expected\n".
	    "# perl -I. -- starfish @sfishArgs\n".
	    "# starfish_cmd( @sfishArgs );\n".
	    "# diff $outExpected $outNew\n");
    starfish_cmd( @sfishArgs );
    comparefiles($outExpected, $outNew);
    
    chdir '..' or die;
}

sub comparefiles {
  my $f1 = shift;
  if (!-f $f1)
  { print STDERR "Error: file $f1 does not exist\n"; ok(0); return; }
  my $fc1 = getfile($f1);
  while (@_) {
    my $f2 = shift;
    if (!-f $f2)
    { print STDERR "Error: file $f2 does not exist\n"; ok(0); return; }
    my $fc2 = getfile($f2);
    if ($fc1 eq $fc2) { next; }
    print STDERR "CWD: ".`pwd`."Difference between $f1 and $f2:\n";
    while ($fc1 ne '' or $fc2 ne '') {
      $fc1=~/^.*\n/; my $l1=$&; my $fc1r=$';
      $fc2=~/^.*\n/; my $l2=$&; my $fc2r=$';
      if ($l1 eq '' and $l2 eq '') {
      print STDERR "$f1:$fc1", "$f2:$fc2"; last; }
      if ($l1 ne $l2) { print STDERR "$f1:$l1", "$f2:$l2" }
      $fc1=$fc1r; $fc2=$fc2r;
    }
    ok(0);
    return;
  }
  ok(1);
}

sub is_module_available {
  my $module = shift; eval qq{require $module};
  return '' if $@; return 1;
}

sub mycopy {
  my $f1 = shift; my $f2 = shift;
  if (!-f $f1) { die "File $f1 does not exist." }
  copy($f1, $f2);
}

sub getfile($) {
    my $f = shift;
    local *F;
    open(F, "<$f") or die "getfile:cannot open $f:$!";
    my @r = <F>;
    close(F);
    return wantarray ? @r : join ('', @r);
}
