#! /usr/bin/perl

# test script for the sqlite_archiver.c program.
#
# will use over 1GB of RAM for the big read/write test.
# will take some time for the looping test.
#
# special-character test doesn't work on Windows.

# turn off output buffering
#$| = 1;

use strict;
use warnings;

my $prog = "./sqlite_archiver";
my $db   = "tmp.db";
my $log  = "tmp.log";
my $base = "$prog $db $log";

my $segfault  = "Segmentation fault (core dumped)";
my $help_text = "\\*EXAMPLE\\* P4D SQLite3 archive trigger for spec depot data\.";
#my $eof_char  = "\x04"; # hex ctrl-d

sub check
{
    my $id     = shift;
    my $cmd    = shift;
    my $expect = shift;

    my $result = `$cmd 2>&1`;
    if( $result !~ /$expect/ || $result =~ /$segfault/ )
    {
	die "FAIL  -  $id:\n\n" . "$result\n"
    }
}

sub slurp { $_ = shift; return do { local $/; <$_> }; }

unlink $db;
unlink $log;

=comment
# not testing these yet.
{
    print "write before db create test\n";
    my $cmd = "$base write 1.1 //spec/file";
    open( W, "| $cmd" ) or die "Couldn't open:  $cmd\n$!\n";
    my $d = "1" . "\n";
    print W $d or die "bad write\n";
    close W;
}

unlink $db;
unlink $log;

{
    print "read before db create test\n";
    my $cmd = "$base read 1.1 //spec/file";
    open( my $R, "$cmd 2>&1 |" ) or die "Couldn't open:  $cmd\n$!\n";
    my $r = &slurp( $R );
    close $R or die "bad close\n";
    my $d = "1" . "\n";
    if( $r ne $d )
    {
	die "failed normal read test:  data not the same";
    }
}

unlink $db;
unlink $log;
=cut

&check( "help1", $prog, $help_text );

&check( "create1", "$prog $db", "Database created successfully" );
if( ! -e $db )
{
    die "FAIL:  $db doesn't exist after creation.\n"
}

&check( "create2", "$prog $db", ".*\nERROR:  Database tables already exist!" );

&check( "help2", "$base",                     $help_text );
&check( "help3", "$base read",                $help_text );
&check( "help4", "$base read 1.1",            $help_text );
# one too-many args
&check( "help5", "$base read 1.1 //d/file a", $help_text );

# op and rev reversed
&check( "bad op", "$base 1.1 read //spec/file",
	".*\nERROR:  Unknown op:  1.1" );

&check( "read without write", "$base read 1.1 //spec/file",
	".*\nERROR: fetch_spec sqlite3_step...:  unknown error\n\nSpec not present" );

{
    print "writing dupe test 1\n";
    my $w_cmd = "$base write 1.1 //spec/dupe";
    open( W, "| $w_cmd" ) or die "Couldn't open:  $w_cmd\n$!\n";
    my $d = "dupe\n";
    print W $d or die "bad write\n";
    close W or die "bad close\n";

    # no error (yet) on duplicate insert.

    print "writing dupe test 2\n";
    open( W, "| $w_cmd" ) or die "Couldn't open:  $w_cmd\n$!\n";
    print W $d or die "bad write\n";
    close W or die "bad close\n";

    print "reading dupe test\n";
    my $r_cmd = "$base read 1.1 //spec/dupe";
    open( my $R, "$r_cmd |" ) or die "Couldn't open:  $r_cmd\n$!\n";
    my $r = &slurp( $R );
    close $R; # ignore this close error

    if( $r !~ /.*\nERROR: fetch_spec sqlite3_step...:  unknown error\n\nDuplicate spec entry?/ )
    {
	die "wrong error on dupe insert:\n$r";
    }
}

{
    # todo:  test crashing.  why doesn't it get recorded?
    print "normal write test\n";
    my $cmd = "$base write 1.1 //spec/file";
    open( W, "| $cmd" ) or die "Couldn't open:  $cmd\n$!\n";
    my $d = "1"x1000000 . "\n";
    print W $d or die "bad write\n";
    close W or die "bad close\n";
}

{
    print "normal read test\n";
    my $cmd = "$base read 1.1 //spec/file";
    open( my $R, "$cmd 2>&1 |" ) or die "Couldn't open:  $cmd\n$!\n";
    my $r = &slurp( $R );
    close $R or die "bad close\n";
    my $d = "1"x1000000 . "\n";
    if( $r !~ /^$d$/ )
    {
	die "failed normal read test:  data not the same";
    }
}

{
    print "sql-character write test\n";
    my $file = "//spec/\\`\\!\@\\#\\\$\%^\\&\\*\\)\\(\\/\?\\'\\\"\\;\\:\\<\\>\\|\\\\\\/";
    my $cmd_w = "$base write 1.1 $file";
    open( W, "| $cmd_w" ) or die "Couldn't open:  $cmd_w\n$!\n";
    my $d = "`!\@#\$%^&*)(/?'\";:<>|\\\/\n";
    print W $d or die "bad write\n";
    close W or die "bad close\n";

    print "sql-character read test\n";
    my $cmd_r = "$base read 1.1 $file";
    open( my $R, "$cmd_r 2>&1 |" ) or die "Couldn't open:  $cmd_r\n$!\n";
    my $r = &slurp( $R );
    close $R or die "bad close\n";
    if( $r ne $d ) # will fail if this test ever works on Windows.
    {
	die "failed sql-character read test:  data not the same";
    }
}
if(0)
{
    print "big write test\n";
    my $cmd_w = "$base write 1.1 //spec/big_file";
    open( W, "| $cmd_w" ) or die "Couldn't open:  $cmd_w\n$!\n";
    # #25379
    my $d = "Job: new\nStatus: open\nuser: user1\n\nDescription:\n";
    for(my $x = 0; $x < 18917; $x++ ) { $d .= " $x" . "x\@y"x$x . "\n";}
    print W $d or die "bad write\n";
    close W or die "bad close:  $cmd_w\n";

    print "big read test\n";
    my $cmd_r = "$base read 1.1 //spec/big_file";
    open( my $R, "$cmd_r 2>&1 |" ) or die "Couldn't open:  $cmd_r\n$!\n";
    my $r = &slurp( $R );
    close $R or die "bad close:  $cmd_r\n";
    if( $r !~ /^$d$/ )
    {
	die "failed big read test";
    }
}

my $looptest_iters = 5000;
my $loop_start = time();
print "looping read/write test:  $looptest_iters iterations\n";
# alternatively, lower the iterations and try every value.
for( my $x = 0; $x < $looptest_iters; $x += 1 )
{
    my $cmd_w = "$base write 1.$x //spec/file$x";
    open( W, "| $cmd_w" ) or die "Couldn't open:  $cmd_w\n$!\n";
    my $d = "x"x$x . "\n";
    print W $d or die "bad write\n";
    close W or die "bad close:  $cmd_w\n";

    my $cmd_r = "$base read 1.$x //spec/file$x";
    open( my $R, "$cmd_r 2>&1 |" ) or die "Couldn't open:  $cmd_r\n$!\n";
    my $r = &slurp( $R );
    close $R or die "bad close:  $cmd_r\n";
    if( $r !~ /^$d$/ )
    {
	die "failed looping read test $x:\n'$r'\n'$d'";
    }
}
my $loop_end = time();
print "done looping read/write test:  " . ($loop_end - $loop_start) . " seconds\n";

$loop_start = time();
print "looping delete test:  $looptest_iters iterations\n";
for( my $x = 0; $x < $looptest_iters; $x += 1 )
{
    my $cmd_w = "$base delete 1.$x //spec/file$x";
    open( W, "| $cmd_w" ) or die "Couldn't open:  $cmd_w\n$!\n";
    close W or die "bad close:  $cmd_w\n";
}
$loop_end = time();
print "done looping delete test:  " . ($loop_end - $loop_start) . " seconds\n";