#
# Copyright (c) 2004-2007 - Consultas, PKG.fr
#
# This file is part of A2P.
#
# A2P is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# A2P is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with A2P; if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
#
# $Id: JobStatus.pm 3 2007-10-18 16:20:19Z guillaume $
#

use strict ;
use Test ;
use GDBM_File ;
use Storable qw( freeze );

require 'test/A2P/Defaults.pm' ;

BEGIN {
    plan
        tests  => 89 ,
        onfail => sub { exit(1) }
}

$| = 1 ;

my %s = () ;
my %h = () ;
my %o = () ;

our %STATS ;
our ( $freezed, $SERVICE_TMP, $SHMDIR, $ADVANCED_DEBUGGING, $LOCKID,
    $LOGFILENAME, $DEBUG_IN_FILE );
our $Progname = 'TEST-JobStatus' ;

&info("Loading A2P::JobStatus library");
ok require A2P::JobStatus ;

sub dbm_base    ; *dbm_base = \&A2P::JobStatus::dbm_base ;
sub dbm_lock    ; *dbm_lock = \&A2P::JobStatus::dbm_lock ;
sub dbm_unlock  ; *dbm_unlock = \&A2P::JobStatus::dbm_unlock ;
sub is_status   ; *is_status = \&A2P::JobStatus::is_status ;
sub is_tied_status   ; *is_tied_status = \&A2P::JobStatus::is_tied_status ;
sub cansavetied ; *cansavetied = \&A2P::JobStatus::cansavetied ;
sub tied_update_status ; *tied_update_status = \&A2P::JobStatus::tied_update_status ;
sub tie_status_hash ; *tie_status_hash = \&A2P::JobStatus::tie_status_hash ;
sub get_tied_ref ; *get_tied_ref = \&A2P::JobStatus::_get_tied_ref ;
sub get_cache_ref ; *get_cache_ref = \&A2P::JobStatus::_get_cache_ref ;
sub sync_dbm_to_db  ; *sync_dbm_to_db = \&A2P::JobStatus::sync_dbm_to_db ;
sub not_tied    ; *not_tied = \&A2P::JobStatus::_not_tied ;
sub not_tied    ; *not_tied = \&A2P::JobStatus::_not_tied ;
sub cache_cleaner ; *cache_cleaner  = \&A2P::JobStatus::cache_cleaner ;
sub sync_list   ; *sync_list = \&A2P::JobStatus::sync_list ;
sub sync_list_inject_again   ; *sync_list_inject_again = \&A2P::JobStatus::sync_list_inject_again ;

&info("Check some facility");
    ok defined($SERVICE_TMP);
    ok defined($SHMDIR);
    ok defined(&dbm_base) ;
    ok &dbm_base =~ /jobstatus-/ ;
    ok &dbm_base , '/dev/shm/.test/.jobstatus-' ;
    ok defined(&cansavetied) ;

&info("Check A2P::Status usability");
    ok require A2P::Status ;
        $h{cached} = {} ;
        $s{status} = new A2P::Status($h{cached},{},'test') ;
    ok defined($s{status}) and ref($s{status}) =~ /^A2P::Status$/ ;
    ok &is_status($s{status}) ;
    ok ! &is_status(undef) ;
    ok ! &is_status('test') ;
    ok ! &is_status({}) ;
    ok ! &is_status('test',{}) ;
    ok ! &is_status('_test_',$h{cached}) ;
    ok $s{stored} = &freeze($s{status}) ;
    ok ! &is_tied_status('_SID_100_rev','UNIT-TEST') ;

&info("Test locking");
    $s{file} = &dbm_base . $LOCKID ;
    ok $s{file} , '/dev/shm/.test/.jobstatus-'.$LOCKID ;
    system "touch $s{file}" ;
    ok &dbm_lock($s{file}) ;
    ok -e $s{file}.'.LCK' ;
    my $lck = qx(/usr/sbin/lsof -l $s{file}.LCK  2>&1 | tee $s{file}.LCK 2>&1) ;
    &info("Check lsof result:", $lck, "toward: perl $$ $< [0-9]+wW REG [0-9,]+ 0");
    ok $lck && $lck =~ /perl\s+$$\s+$<\s+\d+[wu]W\s+REG\s+[0-9,]+\s+0\s+/ ;
    ok &dbm_unlock ;
    &info("Locking file should not be removed as it could be shared");
    ok -e $s{file}.'.LCK' ;
    ok ! qx(/usr/sbin/lsof $s{file}.LCK) ;

    &info("Check son can't access locked file");
    ok &dbm_lock($s{file}) ;
    my $pid = fork ;
    unless ($pid) {
        $0 = 'son_trying_to_lock' ;
        &info("In $0...");
        $SIG{ALRM} = sub { &info("$0: 5s timeout reached") ; exit(1) };
        alarm 5 ;
        my $ret = &dbm_lock($s{file});
        &info("$0: Locking returned $ret");
        exit(10 + $ret);
    }
    ok waitpid($pid,0), $pid ;
    my $ret = $? ;
    ok defined($pid);
    &info("Check son returns without error");
    ok $ret, 2560 ;
    ok $ret - 2816 ;

&info("Check we can tie the status hash");
    unlink $s{file} ;
    ok ! -e $s{file} ;
    $h{Tie} = &tie_status_hash($LOCKID);
    ok defined($h{Tie});
    ok ref($h{Tie}), "GDBM_File" ;
    ok &not_tied , 0 ;
    ok -e $s{file} ;
    &info("Check we have write access to tie");
    ok &cansavetied , 1 ;
    delete $h{Tie} ;
    untie %{&get_tied_ref} ;
    ok &dbm_unlock ;

    &info("Check we can tie in read mode");
    $h{Tie} = &tie_status_hash($LOCKID, 0);
    ok defined($h{Tie});
    ok ref($h{Tie}), "GDBM_File" ;
    ok &not_tied , 0 ;
    ok -e $s{file} ;
    &info("Check we don't have write access to tie");
    ok &cansavetied , 0 ;
    delete $h{Tie} ;
    untie %{&get_tied_ref} ;
    ok &dbm_unlock ;

sub get_file_tied {
    $h{FileTied} = &tie_status_hash($LOCKID);
    $h{TiedRef} = &get_tied_ref ;
    return 0 unless (defined($h{TiedRef}));
    return 1 unless (defined($h{FileTied}));
    return 2 unless (tied(%{$h{TiedRef}}) == $h{FileTied});
    delete $h{TiedRef} ;
    return &cansavetied ? &get_tied_ref : 3 ;
}

sub release_file {
    delete $h{FileTied} ;
    untie %{&get_tied_ref};
    &dbm_unlock ;
}

sub delete_file {
    my $lockid = @_ ? shift : $LOCKID ;
    unlink &dbm_base.$lockid ;
    unlink &dbm_base.$lockid.'.LCK' ;
}

sub dump_hash {
    $h{This} = &get_cache_ref ;
    map { print STDERR "CACHE: $_ -> ".$h{This}->{$_},($h{This}->{$_}=~/^HASH/?
        " -> (".keys(%{$h{This}->{$_}})." keys)":""),"\n" }
        sort(keys(%{$h{This}})) ;
    map { print STDERR "CACHE: __SID__ -> $_ -> ".$h{This}->{__SID__}->{$_},"\n"
        } sort(keys(%{$h{This}->{__SID__}})) ;
    $h{This} = &get_tied_ref ;
    map { print STDERR "TIED : $_ -> ", ( $h{This}->{$_} =~ $freezed ?
        "Freezed storable object" : $h{This}->{$_}),"\n" }
        sort(keys(%{$h{This}})) ;
    delete $h{This} ;
}

sub purge_hash {
    $h{This} = shift ;
    map { delete $h{$h{This}}->{$_} } keys(%{$h{$h{This}}}) ;
    delete $h{$h{This}} ;
    delete $h{This} ;
}

# clean
&delete_file ;
unlink $s{file} ;
unlink $s{file} . '.LCK' ;

&info("Check tied_update_status API without DB connection");
    ok &tied_update_status('UNIT-TEST',5,'#');
        &get_file_tied ;
    ok $h{Ref} = &get_tied_ref ;
    ok $h{Ref} =~ /^HASH/ ;
    ok $h{cache} = &get_cache_ref ;
    ok $h{cache} =~ /^HASH/ ;
        #&dump_hash ;
    ok $h{cache}->{'UNIT-TEST'} ;
        $o{test} = $h{cache}->{'UNIT-TEST'} ;
        $s{sid}  = $o{test}->get_sid_index ;
    &info("SID should be AFPNAME by default");
    ok $s{sid}, 0 ;
    ok $h{cache}->{'__SID__'} ;
    &info("Should not be in SID cache");
    ok $h{cache}->{'__SID__'}->{$s{sid}}, undef ;
    ok $h{Ref}->{$o{test}->get_sid_key} ;
    ok $h{Ref}->{$o{test}->get_sid_version_key} ;
# Status: tied = 2, cached = 3
    ok keys(%{$h{Ref}}), 2 ;
    ok keys(%{$h{cache}}), 3 ;
    &info("SID $s{sid} at revision 1");
    ok $o{test}->is_older_than_tied, 0 ;
        $o{test}->{REV} = 0 ; # Artificialy make object older
    ok $o{test}->is_older_than_tied, 1 ;
        #&dump_hash ;
        delete $h{cache} ;
        &release_file ;

    &info("Try status update");
        &info("First call set the real JOBID name");
    &tied_update_status('UNIT-TEST',5,'#',{ JOBID => 'JOBID-NAME' });
    &info("SID $s{sid} at revision 2");
    &tied_update_status('UNIT-TEST',5,'#',{JID => 'JOBID-NAME',STATUS=>'OK'});
    &info("SID $s{sid} at revision 3");
        &get_file_tied ;
    ok $h{Ref} = &get_tied_ref ;
    ok $h{Ref}->{'JOBID-NAME'}, 'UNIT-TEST' ;
        #&dump_hash ;
        delete $h{Ref} ;
        &release_file ;

&info("Check we retrieve the previous status from cache");
    ok $h{cache} = &get_cache_ref ;
    ok defined($h{cache}->{'UNIT-TEST'}) ;
    ok $h{cache}->{'UNIT-TEST'}, $h{cache}->{'JOBID-NAME'} ;
        $o{test} = $h{cache}->{'UNIT-TEST'} ;
    ok $o{test}->get_sid_index , 0 ;
    ok $o{test}->{JOBID}, 'JOBID-NAME' ;
    ok $o{test}->{AFP}, 'UNIT-TEST' ;
    ok $o{test}->is_job , 'JOBID-NAME' ;
    ok ! defined($h{cache}->{'__SID__'}->{$s{sid}}) ;
        &purge_hash('cache');

&release_file ;
&delete_file ;

sub populate_tie {
    my $count = shift ;
        &release_file ;
    ok &not_tied, 1 ;
    ok $h{cached} = &get_cache_ref ;
    ok $h{'tied'} = &get_tied_ref ;
        &get_file_tied ;
    ok &not_tied, 0 ;
        my $index = 1 ;
        while ($index <= $count) {
            my $test = sprintf('test-%s-%06d',$LOCKID,$index);
            $s{status} = new A2P::Status($h{cached},$h{'tied'},$test) ;
            $s{status}->save_tied ;
            $index ++ ;
        } ;
        delete $s{status} ;
}

&info("Check sync_cache_with_gdbm");
        $LOCKID = 'TEST-1' ;
    ok $h{cached} = &get_cache_ref ;
    ok $h{'tied'} = &get_tied_ref ;
# Status: tied = 0, cached = 0
    ok keys(%{$h{'tied'}}), 0 ;
    ok keys(%{$h{cached}}), 0 ;
        #&dump_hash ;

        &info("Create 6 status for $LOCKID");
        &populate_tie(6);
# Status: tied = 6*2, cached = 6+2
    ok keys(%{$h{'tied'}}), 12 ;
    ok keys(%{$h{cached}}), 8 ; # with __SID__ index and __GDBM_WRITER__
    ok defined($h{cached}->{'__SID__'}) ;
    ok defined($h{cached}->{'__GDBM_WRITER__'}) ;
    ok keys(%{$h{cached}->{'__SID__'}}), 0 ;
        #&dump_hash ;

        $LOCKID = 'TEST-2' ;
        &info("Create 10 other status for $LOCKID");
        &populate_tie(10);
# Status: tied = 10*2, cached = 6+10+2
    ok keys(%{$h{'tied'}}), 20 ;
    ok keys(%{$h{cached}}), 18 ; # with __SID__ index and __GDBM_WRITER__
        #&dump_hash ;

        &info("Remove status from cache");
        map {
            $h{cached}->{$_}->remove_from_cache ;
        } grep { $_ !~ /^__/ } keys(%{$h{cached}}) ;
# Status: tied = 10*2, cached = 2
    ok keys(%{$h{'tied'}}), 20 ;
    ok keys(%{$h{cached}}), 2 ; # with __SID__ index and __GDBM_WRITER__
    ok keys(%{$h{cached}->{'__SID__'}}), 0 ;
        &release_file ;
    ok &not_tied, 1 ;
# Status: tied = 0, cached = 1
    ok keys(%{$h{'tied'}}), 0 ;
    ok keys(%{$h{cached}}), 1 ; # with only __SID__ index
    ok keys(%{$h{cached}->{'__SID__'}}), 0 ;
        &dump_hash ;

&release_file ;

    &info("Internal statistics:") if (keys(%STATS));
    map { &info(" $_: $STATS{$_}") } grep { exists($STATS{$_}) } qw(
        CACHED-STATUS-OBJECT-KEPT CACHED-STATUS-OBJECT-CLEANED
        STATUS-OBJECT-KEPT-IN-CACHE  STATUS-OBJECT-KEPT-IN-CACHE-MAX
        CACHED-STATUS-OBJECT-CHECKED CACHED-STATUS-OBJECT-CHECKED-MAX
        STATUS-OBJECT-EARLY-CLEANED CACHE-KEYS-COUNT CACHE-KEYS-COUNT
        TIMING-SYNC-CACHE-API NO-SYNC-NEEDED-TEST-1 LOCKIDS-CHECK-CALL
        LOCKIDS-CHECK-LISTS-NOT-EMPTY TEST-1-TIE-UPDATED
        SYNC-LIST-REPOPULATE-TEST-1
    );

1 ;