#! /usr/bin/perl

=comment
README.txt:

User contributed content on the Perforce Public Depot is not supported  
by Perforce, although it may be supported by its author. This applies  
to all contributions even those submitted by Perforce employees.

LICENSE.txt:

Copyright (c) Perforce Software, Inc., 1997-2008. All rights reserved  
Redistribution and use in source and binary forms, with or without  
modification, are permitted provided that the following conditions are  
met:
  1. Redistributions of source code must retain the above copyright  
notice, this list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright  
notice, this list of conditions and the following disclaimer in the  
documentation and/or other materials provided with the distribution.
  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS  
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT  
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR  
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL PERFORCE  
SOFTWARE, INC. BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,  
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT  
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,  
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY  
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT  
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE  
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

=cut

# 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";