#!/usr/bin/perl
# Tests for TWiki::Store::RcsLite and TWiki::Store::RcsWrap


use lib ( '../../lib' );
use lib ( '.' );
use TWiki;

use TWiki::Store::RcsLite;
use TWiki::Store::RcsWrap;
use TestUtil;

@storeSettings = @TWiki::storeSettings;


sub readKnown
{
    my( $file ) = @_;
    
    $rcs = TWiki::Data::RcsLite->new($file);

    print "Head = " . $rcs->numRevisions() . "\n";
    print "Valid to = " . $rcs->validTo() . "\n";
    print "Comment = \"" . $rcs->comment() . "\"\n";
    print "Description = \"" . $rcs->description() . "\"\n";
    for( my $i=$rcs->numRevisions(); $i>=$rcs->validTo(); $i-- ) {
       print "Version = $i\n";
       print "   Author = " . $rcs->author($i) . "\n";
       print "   Log    = " . $rcs->log($i) . "\n";
       print "   Text   = " . $rcs->delta($i) . "\n\n";
    }


    for( my $i=$rcs->numRevisions(); $i>=$rcs->validTo(); $i-- ) {
       print "---\n Revision ";
       print $i;
       print "\n";
       print $rcs->revision($i);
       print "\n";
    }
}


# save attachment and topic differently
sub addRevision
{
    my( $handler, $attachment, $text, $comment, $who ) = @_;
    
    if( $attachment ) {
      if(  $attachment eq "usefile.tmp" ) {
      } else {
        my $name = "tmp-attachment.tmp";
        umask( 002 );
        open( FILE, ">$name" ) or warn "Can't create file $name\n";
        binmode( FILE );
        print FILE $text;
        close( FILE);
        $text = $name;
      }
    }
    
    $handler->addRevision( $text, $comment, $who );
}


sub testRead
{
    my( $count, $topic, $attachment, @vals ) = @_;
    
    print "Test Read ($attachment) $count\n";
    
    my $web = "Test";

    my $rcs = TWiki::Store::RcsWrap->new( $web, $topic, $attachment, @storeSettings );
    $rcs->delete();
    
    my $numRevs = $#vals + 1;
    for( my $i=0; $i<$numRevs; $i++ ) {
        addRevision( $rcs, $attachment, $vals[$i], "comment " . $i, "JohnTalintyre" );
    }
    my $rcsLite = TWiki::Store::RcsLite->new( $web, $topic, $attachment, @storeSettings );
    TestUtil::check_equal( $rcsLite->numRevisions(), $numRevs, "Number of revisions should be the same" );
    
    for( my $i=$numRevs; $i>0; $i-- ) {
       my $text = $rcsLite->getRevision( $i );
       TestUtil::check_equal( $text, $vals[$i-1], "Text should be same for revision $i" );
    }
    
    return $rcsLite;
}


sub now
{
    my $time = time();
    $date = &TWiki::formatGmTime( $time, "rcs" );
    return $date;
}



sub testRepRev
{

    my $web = "Test";
    my $topic = "RcsLiteRepRev";
    
    print "Test Rep Rev\n";
    my $rcsLite = TWiki::Store::RcsLite->new( $web, $topic, "", @storeSettings );
    $rcsLite->delete();
    
    $rcsLite->addRevision( "there was a man\n\n", "in once", "JohnTalintyre" );
    $rcsLite->replaceRevision( "there was a cat\n", "1st replace", "NotJohnTalintyre", now() );
    
    my $rcs = TWiki::Store::RcsWrap->new( $web, $topic, "", @storeSettings );
    my $numRevs = $rcs->numRevisions();
    TestUtil::check_equal( $numRevs, 1, "Should be one revision" );
    my $text = $rcs->getRevision(1);
    TestUtil::check_equal( $text, "there was a cat\n", "Text for 1st replaced revision should match" );
    
    $rcsLite->addRevision( "and now this\n\n\n", "2nd entry", "J1" );
    $rcsLite->replaceRevision( "then this", "2nd replace", "J2", now() );
    TestUtil::check_equal( $rcs->numRevisions, 2 );
    TestUtil::check_equal( $rcs->getRevision(1), "there was a cat\n" );
    TestUtil::check_equal( $rcs->getRevision(2), "then this" );

    $rcs->delete();
    $rcs->addRevision( "there was a man\n\n", "in once", "JohnTalintyre" );
    $rcs->replaceRevision( "there was a cat\n", "1st replace", "NotJohnTalintyre", now() );
    
    $rcsLite = TWiki::Store::RcsLite->new( $web, $topic, "", @storeSettings );
    $numRevs = $rcsLite->numRevisions();
    TestUtil::check_equal( $numRevs, 1 );
    $text = $rcsLite->getRevision(1);
    TestUtil::check_equal( $text, "there was a cat\n" );
    
    $rcs->addRevision( "and now this\n\n\n", "2nd entry", "J1" );
    $rcs->replaceRevision( "then this\n", "2nd replace", "J2", now() );
    $rcsLite = TWiki::Store::RcsLite->new( $web, $topic, "", @storeSettings );    
    TestUtil::check_equal( $rcsLite->numRevisions, 2 );
    TestUtil::check_equal( $rcsLite->getRevision(1), "there was a cat\n" );
    TestUtil::check_equal( $rcsLite->getRevision(2), "then this\n" );

}
    


sub testWrite
{
    my( $count, $topic, $attachment, @vals ) = @_;
    
    my $web = "Test";

    print "Test Write $count ($attachment)\n";
    
    my $rcsLite = TWiki::Store::RcsLite->new( $web, $topic, $attachment, @storeSettings );
    $rcsLite->delete();

    
    my $numRevs = $#vals + 1;
    for( my $i=0; $i<$numRevs; $i++ ) {
        addRevision( $rcsLite, $attachment, $vals[$i], "comment " . $i, "JohnTalintyre" );
    }
    my $rcs = TWiki::Store::RcsWrap->new( $web, $topic, $attachment, @storeSettings );
    TestUtil::check_equal( $rcs->numRevisions(), $numRevs, "Number of revisions should be the same" );
    
    for( my $i=$numRevs; $i>0; $i-- ) {
       my $text = $rcs->getRevision( $i );
       TestUtil::check_equal( $text, $vals[$i-1], "Text should be same for revision $i" );
    }
}

# Outputs delta for helping to work out how to do things
sub refDelta
{
    my( $old, $new ) = @_;
        
    my $web = "Test";
    my $topic = "RefDelta";

    my $rcs = TWiki::Store::RcsWrap->new( $web, $topic, "", @storeSettings );
    $rcs->delete();
    
    $rcs->addRevision( $old, "old comment", "JohnTalintyre" );   
    $rcs->addRevision( $new, "old comment", "JohnTalintyre" );   

    my $rcsLite = TWiki::Store::RcsLite->new( $web, $topic, "", @storeSettings );
    my $delta = $rcsLite->delta(1);
    
    print "Old:\n\"$old\"\n";
    print "New:\n\"$new\"\n";
    print "Delta new->old:\n\"$delta\"\n\n"; 
}

sub testRcsDiff
{
   my( $num, @vals ) = @_;
   testRcsDiffOne( "$num-a", $vals[0], $vals[1] );
   testRcsDiffOne( "$num-b", $vals[1], $vals[0] );
}

sub testRcsDiffOne
{
   my( $num, @vals ) = @_;
   
   my $topic = "RcsDiffTest";
   my $web = "Test";
   my $rcs = TWiki::Store::RcsWrap->new( $web, $topic, "", @storeSettings );
   $rcs->delete();
   
   print "Rcs Diff test $num\n";
   $rcs->addRevision( $vals[0], "num 0", "JohnTalintyre" );
   $rcs->addRevision( $vals[1], "num 1", "JohnTalintyre" );
   my $diff = $rcs->revisionDiff( 1, 2 );
   #print "--$diff--\n";
   
   my $rcsLite = TWiki::Store::RcsLite->new( $web, $topic, "", @storeSettings );
   my $diffLite = $rcsLite->revisionDiff( 1, 2 );
   #print "++$diffLite++\n";
   
   TestUtil::check_equal( $diffLite, $diff, "Diff output should be same between Rcs and RcsLite" );
}

sub writeDelta
{
   my( $count, $topic, $old, $new ) = @_;
   refDelta( $old, $new );
   testWrite( $count, $topic, $old, 0, $new );
}

sub refDeltas
{
   refDelta( "one", "one\n" );
   refDelta( "one", "one\ntwo\n" );
   refDelta( "a\n", "b" );
   refDelta( "one\n", "one" );
   #refDelta( "one\n\n", "one" );
   #refDelta( "a\none\n\n", "b\none" );
   #refDelta( "one", "one\n" );
}

sub doWriteTests
{
    my( $wTopic, $attachment ) = @_;

    # The following that are broken may be due to diff between cygwin rcs and other distributions

    testWrite( 1, $wTopic, $attachment, ( "a" ) );
    testWrite( 2, $wTopic, $attachment, ( "a\n" ) );
    testWrite( 3, $wTopic, $attachment, ( "a\n", "b\n" ) );
    testWrite( 4, $wTopic, $attachment, ( "a\n", "b" ) );
    testWrite( 5, $wTopic, $attachment, ( "a\n", "a\n\n" ) );
    testWrite( 6, $wTopic, $attachment, ( "a\nb\n", "a\nc\n" ) );
    testWrite( 7, $wTopic, $attachment, ( "one", "one\ntwo\n" ) );
    testWrite( 8, $wTopic, $attachment, ( "one\n", "one\ntwo\n" ) ); # TODO: badly broken
    testWrite( 9, $wTopic, $attachment, ( "one\nthree\nfour\n", "one\ntwo\nthree\n" ) );
    testWrite( 10, $wTopic, $attachment, ( "three\nfour\n", "one\ntwo\nthree\n" ) );
    testWrite( 11, $wTopic, $attachment, ( 'john.talintyre@drkw.com\n' ) ); # TODO: broken!
    testWrite( 13, $wTopic, $attachment, ( "", "w\n\n" ) );  
    testWrite( 14, $wTopic, $attachment, ( "det\nnwaw\ndjrz", "wjmpa\nnwaw\ndjrz" ) );
    testWrite( 15, $wTopic, $attachment, ( "ntyp\nzz", "fl\n\n" ) );
    testWrite( 16, $wTopic, $attachment, ( "nrcpb\n", "" ) );
    testWrite( 17, $wTopic, $attachment, ( "smifn", "\n" ) );
    testWrite( 18, $wTopic, $attachment, ( "\n", "mus\n" ) );
    testWrite( 19, $wTopic, $attachment, ( "jw\na\niky", "yorem\na\niky\n" ) );
    testWrite( 20, $wTopic, $attachment, ( "\nilw", "we\nilw" ) );
    
    if( $attachment ) {
       testWrite( 101, $wTopic, $attachment, ( "a\nb\n", "a\nb\nc\n", "a\nb\nc\n" . chr(0xFF) . "\n" ) );   
    }
}


sub doReadTests
{
    my( $rTopic, $attachment ) = @_;
    
    testRead( 1, $rTopic, $attachment, ( "a" ) );
    testRead( 2, $rTopic, $attachment, ( "a\n" ) );
    testRead( 3, $rTopic, $attachment, ( "a\n", "b\n" ) );
    testRead( 4, $rTopic, $attachment, ( "a\n", "b" ) );
    testRead( "4a", $rTopic, $attachment, ( "a", "b\n" ) );
    testRead( 5, $rTopic, $attachment, ( "a\n", "a\n\n" ) );
    testRead( 6, $rTopic, $attachment, ( "a\nb\n", "a\nc\n" ) );
    testRead( 7, $rTopic, $attachment, ( "one", "one\ntwo\n" ) );
    testRead( 8, $rTopic, $attachment, ( "one\n", "one\ntwo\n" ) );
    testRead( 9, $rTopic, $attachment, ( "one\nthree\nfour\n", "one\ntwo\nthree\n" ) );
    testRead( 10, $rTopic, $attachment, ( "three\nfour\n", "one\ntwo\nthree\n" ) );
    testRead( 11, $rTopic, $attachment, ( 'john.talintyre@drkw.com\n' ) );
    testRead( 12, $rTopic, $attachment, ( "" ) );
    
    testRead( 16, $rTopic, $attachment, ( "nrcpb\n", "" ) );
	testRead( 17, $rTopic, $attachment, ( "smifn", "\n" ) );
    testRead( 18, $rTopic, $attachment, ( "\n", "mus\n" ) );
    testRead( 19, $wTopic, $attachment, ( "jw\na\niky", "yorem\na\niky\n" ) );
    testRead( 20, $rTopic, $attachment, ( "\nilw", "we\nilw" ) );


    if( $attachment ) {
       testRead( 101, $rTopic, $attachment, ( "a\nb\n", "a\nb\nc\n", "a\nb\nc\n" . chr(0xFF) . "\n" ) );
    }
}

sub doDiffTests
{
    testRcsDiff(1, "1\n", "\n" );
    testRcsDiff(2, "1\n", "2\n" );
    testRcsDiff(3, "1\n2\n3\n", "a\n1\n2\n3\nb\n" );
    testRcsDiff(4, "1\n2\n3\n", "a\nb\n1\n2\n3\nb\nb\n" );
    testRcsDiff(100, "1\n2\n3\n4\n5\n6\n7\n8\none\nabc\nABC\ntwo\n",
            "A\n1\n2\n3\none\nIII\niii\ntwo\nthree\n");
}

# int(0.5) = 0
# int(1.0) = 1;
sub randRange
{
   my( $min, $max ) = @_;
   
   my $val = $min + int( rand($max-$min+1) );
   $val = $max if( $val > $max );
   $val = $min if( $val < $min );
   return $val;
}

sub randLines
{
   my( $maxChars ) = @_;
   my $chars = randRange( 0, $maxChars );
   my $text = "";
   for( my $i=0; $i<$chars; $i++ ) {
      my $asc = randRange(ord('a'),ord('z'));
      $text .= chr( $asc );
   }
   return $text;
}

# Random tests
# iterations - do a certain number of insertions and deletions
# count - changes for each time around
# pinsert - prob for an insert, 0 - 100
sub randTest
{
   my( $ident, $iterations, $count, $pinsert, $ndel ) = @_;
   
   
   my $web = "Test";
   my $topic = "RcsLiteRandom";
   
   my @vals = ();
   my @val  = ();
   
   for( my $i = 0; $i < $iterations; $i++ ) {
      my $changes = randRange(1,$count);
      for( my $j = 0; $j < $changes; $j++ ) {
         my $prob = randRange(0,100);
         my $insert = 1;
         $insert = 0 if( $prob > $pinsert );
         $insert = 1 if( ! @val );
         if( $insert ) {
             my $where = randRange(0, @val);
             my $what = randLines( 5 );
             splice @val, $where, 0, $what;
         } else {
             my $toDel = randRange( 0, $ndel );
             splice @val, randRange(0, @val), $toDel;
         }
      }
      push @val, ("") if( randRange( 0, 100 ) > 80 );
      my $text = join( "\n", @val );
      push @vals, $text;
   }
   
   #printVals( @vals );
   my $okay = genTest( "", $topic, "TWiki::Store::RcsLite", "TWiki::Store::RcsLite", "", @vals );
   printVals( $ident, @vals ) if( ! $okay );
   return $okay;
}

sub printVals
{
    my( $ident, @vals ) = @_;
    
    my $str = "( ";
    my $sep = "";
    foreach my $text (@vals) {
       $text =~ s/\n/\\n/go;
       $str .= $sep;
       $str .= "\"$text\"";
       $sep = ", ";
    }
    $str .= " )";
    print "$ident - $str\n";
}

sub genTest
{
    my( $ident, $topic, $write, $read, $attachment, @vals ) = @_;
    
    print "Test Generic ($attachment) $ident\n" if( $ident );
    
    my $web = "Test";

    my $writer = $write->new( $web, $topic, $attachment, @storeSettings );
    $writer->delete();
    
    my $numRevs = @vals;
    for( my $i=0; $i<$numRevs; $i++ ) {
        addRevision( $writer, $attachment, $vals[$i], "comment " . $i, "JohnTalintyre" );
    }
    
    my $reader = $read->new( $web, $topic, $attachment, @storeSettings );
    my $okay = TestUtil::check_equal( $reader->numRevisions(), $numRevs, "Number of revisions should be the same" );
    
    if( $okay ) {
        for( my $i=$numRevs; $i>0; $i-- ) {
           my $text = $reader->getRevision( $i );
           $okay = TestUtil::check_equal( $text, $vals[$i-1], "Text should be same for revision $i" );
        }
    }
    
    return $okay;
}


my $rTopic = "RcsLiteRTest";
my $wTopic = "RcsLiteWTest";
my $attachment = "it.doc";

#testRead( 5, $rTopic, $attachment, ( "a\n", "a\n\n" ) );
#exit 0;

# Lots of random tests
for( my $i=0; $i<200; $i++) {
#   my $okay = randTest($i, 2, 5, 60, 3, 0, 2);
#   last if( ! $okay );
}
#exit 0;

#### Full test ######
testRepRev();

doReadTests( $rTopic, "it.doc" );
doWriteTests( $wTopic, "it.doc" );

doReadTests( $rTopic, "" );
doWriteTests( $wTopic, "" );

doDiffTests();

### Information to help write the software
#refDeltas();



