source: A2P/a2p/test/A2P/JobStatus.pm @ 3

Last change on this file since 3 was 3, checked in by guillaume, 17 years ago
  • AUTHORS: Ajout des différents contributeurs
  • COPYING: Ajout de la licence GPL v3
  • a2p: Préparation des sources pour leur publication sous GPL
  • Property svn:executable set to *
  • Property svn:keywords set to Id
File size: 10.7 KB
Line 
1#
2# Copyright (c) 2004-2007 - Consultas, PKG.fr
3#
4# This file is part of A2P.
5#
6# A2P is free software; you can redistribute it and/or modify
7# it under the terms of the GNU General Public License as published by
8# the Free Software Foundation; either version 2 of the License, or
9# (at your option) any later version.
10#
11# A2P is distributed in the hope that it will be useful,
12# but WITHOUT ANY WARRANTY; without even the implied warranty of
13# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14# GNU General Public License for more details.
15#
16# You should have received a copy of the GNU General Public License
17# along with A2P; if not, write to the Free Software
18# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
19#
20# $Id: JobStatus.pm 3 2007-10-18 16:20:19Z guillaume $
21#
22
23use strict ;
24use Test ;
25use GDBM_File ;
26use Storable qw( freeze );
27
28require 'test/A2P/Defaults.pm' ;
29
30BEGIN {
31    plan
32        tests  => 89 ,
33        onfail => sub { exit(1) }
34}
35
36$| = 1 ;
37
38my %s = () ;
39my %h = () ;
40my %o = () ;
41
42our %STATS ;
43our ( $freezed, $SERVICE_TMP, $SHMDIR, $ADVANCED_DEBUGGING, $LOCKID,
44    $LOGFILENAME, $DEBUG_IN_FILE );
45our $Progname = 'TEST-JobStatus' ;
46
47&info("Loading A2P::JobStatus library");
48ok require A2P::JobStatus ;
49
50sub dbm_base    ; *dbm_base = \&A2P::JobStatus::dbm_base ;
51sub dbm_lock    ; *dbm_lock = \&A2P::JobStatus::dbm_lock ;
52sub dbm_unlock  ; *dbm_unlock = \&A2P::JobStatus::dbm_unlock ;
53sub is_status   ; *is_status = \&A2P::JobStatus::is_status ;
54sub is_tied_status   ; *is_tied_status = \&A2P::JobStatus::is_tied_status ;
55sub cansavetied ; *cansavetied = \&A2P::JobStatus::cansavetied ;
56sub tied_update_status ; *tied_update_status = \&A2P::JobStatus::tied_update_status ;
57sub tie_status_hash ; *tie_status_hash = \&A2P::JobStatus::tie_status_hash ;
58sub get_tied_ref ; *get_tied_ref = \&A2P::JobStatus::_get_tied_ref ;
59sub get_cache_ref ; *get_cache_ref = \&A2P::JobStatus::_get_cache_ref ;
60sub sync_dbm_to_db  ; *sync_dbm_to_db = \&A2P::JobStatus::sync_dbm_to_db ;
61sub not_tied    ; *not_tied = \&A2P::JobStatus::_not_tied ;
62sub not_tied    ; *not_tied = \&A2P::JobStatus::_not_tied ;
63sub cache_cleaner ; *cache_cleaner  = \&A2P::JobStatus::cache_cleaner ;
64sub sync_list   ; *sync_list = \&A2P::JobStatus::sync_list ;
65sub sync_list_inject_again   ; *sync_list_inject_again = \&A2P::JobStatus::sync_list_inject_again ;
66
67&info("Check some facility");
68    ok defined($SERVICE_TMP);
69    ok defined($SHMDIR);
70    ok defined(&dbm_base) ;
71    ok &dbm_base =~ /jobstatus-/ ;
72    ok &dbm_base , '/dev/shm/.test/.jobstatus-' ;
73    ok defined(&cansavetied) ;
74
75&info("Check A2P::Status usability");
76    ok require A2P::Status ;
77        $h{cached} = {} ;
78        $s{status} = new A2P::Status($h{cached},{},'test') ;
79    ok defined($s{status}) and ref($s{status}) =~ /^A2P::Status$/ ;
80    ok &is_status($s{status}) ;
81    ok ! &is_status(undef) ;
82    ok ! &is_status('test') ;
83    ok ! &is_status({}) ;
84    ok ! &is_status('test',{}) ;
85    ok ! &is_status('_test_',$h{cached}) ;
86    ok $s{stored} = &freeze($s{status}) ;
87    ok ! &is_tied_status('_SID_100_rev','UNIT-TEST') ;
88
89&info("Test locking");
90    $s{file} = &dbm_base . $LOCKID ;
91    ok $s{file} , '/dev/shm/.test/.jobstatus-'.$LOCKID ;
92    system "touch $s{file}" ;
93    ok &dbm_lock($s{file}) ;
94    ok -e $s{file}.'.LCK' ;
95    my $lck = qx(/usr/sbin/lsof -l $s{file}.LCK  2>&1 | tee $s{file}.LCK 2>&1) ;
96    &info("Check lsof result:", $lck, "toward: perl $$ $< [0-9]+wW REG [0-9,]+ 0");
97    ok $lck && $lck =~ /perl\s+$$\s+$<\s+\d+[wu]W\s+REG\s+[0-9,]+\s+0\s+/ ;
98    ok &dbm_unlock ;
99    &info("Locking file should not be removed as it could be shared");
100    ok -e $s{file}.'.LCK' ;
101    ok ! qx(/usr/sbin/lsof $s{file}.LCK) ;
102
103    &info("Check son can't access locked file");
104    ok &dbm_lock($s{file}) ;
105    my $pid = fork ;
106    unless ($pid) {
107        $0 = 'son_trying_to_lock' ;
108        &info("In $0...");
109        $SIG{ALRM} = sub { &info("$0: 5s timeout reached") ; exit(1) };
110        alarm 5 ;
111        my $ret = &dbm_lock($s{file});
112        &info("$0: Locking returned $ret");
113        exit(10 + $ret);
114    }
115    ok waitpid($pid,0), $pid ;
116    my $ret = $? ;
117    ok defined($pid);
118    &info("Check son returns without error");
119    ok $ret, 2560 ;
120    ok $ret - 2816 ;
121
122&info("Check we can tie the status hash");
123    unlink $s{file} ;
124    ok ! -e $s{file} ;
125    $h{Tie} = &tie_status_hash($LOCKID);
126    ok defined($h{Tie});
127    ok ref($h{Tie}), "GDBM_File" ;
128    ok &not_tied , 0 ;
129    ok -e $s{file} ;
130    &info("Check we have write access to tie");
131    ok &cansavetied , 1 ;
132    delete $h{Tie} ;
133    untie %{&get_tied_ref} ;
134    ok &dbm_unlock ;
135
136    &info("Check we can tie in read mode");
137    $h{Tie} = &tie_status_hash($LOCKID, 0);
138    ok defined($h{Tie});
139    ok ref($h{Tie}), "GDBM_File" ;
140    ok &not_tied , 0 ;
141    ok -e $s{file} ;
142    &info("Check we don't have write access to tie");
143    ok &cansavetied , 0 ;
144    delete $h{Tie} ;
145    untie %{&get_tied_ref} ;
146    ok &dbm_unlock ;
147
148sub get_file_tied {
149    $h{FileTied} = &tie_status_hash($LOCKID);
150    $h{TiedRef} = &get_tied_ref ;
151    return 0 unless (defined($h{TiedRef}));
152    return 1 unless (defined($h{FileTied}));
153    return 2 unless (tied(%{$h{TiedRef}}) == $h{FileTied});
154    delete $h{TiedRef} ;
155    return &cansavetied ? &get_tied_ref : 3 ;
156}
157
158sub release_file {
159    delete $h{FileTied} ;
160    untie %{&get_tied_ref};
161    &dbm_unlock ;
162}
163
164sub delete_file {
165    my $lockid = @_ ? shift : $LOCKID ;
166    unlink &dbm_base.$lockid ;
167    unlink &dbm_base.$lockid.'.LCK' ;
168}
169
170sub dump_hash {
171    $h{This} = &get_cache_ref ;
172    map { print STDERR "CACHE: $_ -> ".$h{This}->{$_},($h{This}->{$_}=~/^HASH/?
173        " -> (".keys(%{$h{This}->{$_}})." keys)":""),"\n" }
174        sort(keys(%{$h{This}})) ;
175    map { print STDERR "CACHE: __SID__ -> $_ -> ".$h{This}->{__SID__}->{$_},"\n"
176        } sort(keys(%{$h{This}->{__SID__}})) ;
177    $h{This} = &get_tied_ref ;
178    map { print STDERR "TIED : $_ -> ", ( $h{This}->{$_} =~ $freezed ?
179        "Freezed storable object" : $h{This}->{$_}),"\n" }
180        sort(keys(%{$h{This}})) ;
181    delete $h{This} ;
182}
183
184sub purge_hash {
185    $h{This} = shift ;
186    map { delete $h{$h{This}}->{$_} } keys(%{$h{$h{This}}}) ;
187    delete $h{$h{This}} ;
188    delete $h{This} ;
189}
190
191# clean
192&delete_file ;
193unlink $s{file} ;
194unlink $s{file} . '.LCK' ;
195
196&info("Check tied_update_status API without DB connection");
197    ok &tied_update_status('UNIT-TEST',5,'#');
198        &get_file_tied ;
199    ok $h{Ref} = &get_tied_ref ;
200    ok $h{Ref} =~ /^HASH/ ;
201    ok $h{cache} = &get_cache_ref ;
202    ok $h{cache} =~ /^HASH/ ;
203        #&dump_hash ;
204    ok $h{cache}->{'UNIT-TEST'} ;
205        $o{test} = $h{cache}->{'UNIT-TEST'} ;
206        $s{sid}  = $o{test}->get_sid_index ;
207    &info("SID should be AFPNAME by default");
208    ok $s{sid}, 0 ;
209    ok $h{cache}->{'__SID__'} ;
210    &info("Should not be in SID cache");
211    ok $h{cache}->{'__SID__'}->{$s{sid}}, undef ;
212    ok $h{Ref}->{$o{test}->get_sid_key} ;
213    ok $h{Ref}->{$o{test}->get_sid_version_key} ;
214# Status: tied = 2, cached = 3
215    ok keys(%{$h{Ref}}), 2 ;
216    ok keys(%{$h{cache}}), 3 ;
217    &info("SID $s{sid} at revision 1");
218    ok $o{test}->is_older_than_tied, 0 ;
219        $o{test}->{REV} = 0 ; # Artificialy make object older
220    ok $o{test}->is_older_than_tied, 1 ;
221        #&dump_hash ;
222        delete $h{cache} ;
223        &release_file ;
224
225    &info("Try status update");
226        &info("First call set the real JOBID name");
227    &tied_update_status('UNIT-TEST',5,'#',{ JOBID => 'JOBID-NAME' });
228    &info("SID $s{sid} at revision 2");
229    &tied_update_status('UNIT-TEST',5,'#',{JID => 'JOBID-NAME',STATUS=>'OK'});
230    &info("SID $s{sid} at revision 3");
231        &get_file_tied ;
232    ok $h{Ref} = &get_tied_ref ;
233    ok $h{Ref}->{'JOBID-NAME'}, 'UNIT-TEST' ;
234        #&dump_hash ;
235        delete $h{Ref} ;
236        &release_file ;
237
238&info("Check we retrieve the previous status from cache");
239    ok $h{cache} = &get_cache_ref ;
240    ok defined($h{cache}->{'UNIT-TEST'}) ;
241    ok $h{cache}->{'UNIT-TEST'}, $h{cache}->{'JOBID-NAME'} ;
242        $o{test} = $h{cache}->{'UNIT-TEST'} ;
243    ok $o{test}->get_sid_index , 0 ;
244    ok $o{test}->{JOBID}, 'JOBID-NAME' ;
245    ok $o{test}->{AFP}, 'UNIT-TEST' ;
246    ok $o{test}->is_job , 'JOBID-NAME' ;
247    ok ! defined($h{cache}->{'__SID__'}->{$s{sid}}) ;
248        &purge_hash('cache');
249
250&release_file ;
251&delete_file ;
252
253sub populate_tie {
254    my $count = shift ;
255        &release_file ;
256    ok &not_tied, 1 ;
257    ok $h{cached} = &get_cache_ref ;
258    ok $h{'tied'} = &get_tied_ref ;
259        &get_file_tied ;
260    ok &not_tied, 0 ;
261        my $index = 1 ;
262        while ($index <= $count) {
263            my $test = sprintf('test-%s-%06d',$LOCKID,$index);
264            $s{status} = new A2P::Status($h{cached},$h{'tied'},$test) ;
265            $s{status}->save_tied ;
266            $index ++ ;
267        } ;
268        delete $s{status} ;
269}
270
271&info("Check sync_cache_with_gdbm");
272        $LOCKID = 'TEST-1' ;
273    ok $h{cached} = &get_cache_ref ;
274    ok $h{'tied'} = &get_tied_ref ;
275# Status: tied = 0, cached = 0
276    ok keys(%{$h{'tied'}}), 0 ;
277    ok keys(%{$h{cached}}), 0 ;
278        #&dump_hash ;
279
280        &info("Create 6 status for $LOCKID");
281        &populate_tie(6);
282# Status: tied = 6*2, cached = 6+2
283    ok keys(%{$h{'tied'}}), 12 ;
284    ok keys(%{$h{cached}}), 8 ; # with __SID__ index and __GDBM_WRITER__
285    ok defined($h{cached}->{'__SID__'}) ;
286    ok defined($h{cached}->{'__GDBM_WRITER__'}) ;
287    ok keys(%{$h{cached}->{'__SID__'}}), 0 ;
288        #&dump_hash ;
289
290        $LOCKID = 'TEST-2' ;
291        &info("Create 10 other status for $LOCKID");
292        &populate_tie(10);
293# Status: tied = 10*2, cached = 6+10+2
294    ok keys(%{$h{'tied'}}), 20 ;
295    ok keys(%{$h{cached}}), 18 ; # with __SID__ index and __GDBM_WRITER__
296        #&dump_hash ;
297
298        &info("Remove status from cache");
299        map {
300            $h{cached}->{$_}->remove_from_cache ;
301        } grep { $_ !~ /^__/ } keys(%{$h{cached}}) ;
302# Status: tied = 10*2, cached = 2
303    ok keys(%{$h{'tied'}}), 20 ;
304    ok keys(%{$h{cached}}), 2 ; # with __SID__ index and __GDBM_WRITER__
305    ok keys(%{$h{cached}->{'__SID__'}}), 0 ;
306        &release_file ;
307    ok &not_tied, 1 ;
308# Status: tied = 0, cached = 1
309    ok keys(%{$h{'tied'}}), 0 ;
310    ok keys(%{$h{cached}}), 1 ; # with only __SID__ index
311    ok keys(%{$h{cached}->{'__SID__'}}), 0 ;
312        &dump_hash ;
313
314&release_file ;
315
316    &info("Internal statistics:") if (keys(%STATS));
317    map { &info(" $_: $STATS{$_}") } grep { exists($STATS{$_}) } qw(
318        CACHED-STATUS-OBJECT-KEPT CACHED-STATUS-OBJECT-CLEANED
319        STATUS-OBJECT-KEPT-IN-CACHE  STATUS-OBJECT-KEPT-IN-CACHE-MAX
320        CACHED-STATUS-OBJECT-CHECKED CACHED-STATUS-OBJECT-CHECKED-MAX
321        STATUS-OBJECT-EARLY-CLEANED CACHE-KEYS-COUNT CACHE-KEYS-COUNT
322        TIMING-SYNC-CACHE-API NO-SYNC-NEEDED-TEST-1 LOCKIDS-CHECK-CALL
323        LOCKIDS-CHECK-LISTS-NOT-EMPTY TEST-1-TIE-UPDATED
324        SYNC-LIST-REPOPULATE-TEST-1
325    );
326
3271 ;
Note: See TracBrowser for help on using the repository browser.