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: Tools.pm 3 2007-10-18 16:20:19Z guillaume $ |
---|
21 | # |
---|
22 | |
---|
23 | use strict ; |
---|
24 | use Test ; |
---|
25 | |
---|
26 | require 'test/A2P/Defaults.pm' ; |
---|
27 | |
---|
28 | BEGIN { |
---|
29 | plan |
---|
30 | tests => 3 , |
---|
31 | onfail => sub { exit(1) } |
---|
32 | } |
---|
33 | |
---|
34 | our ( $SHMDIR, $ADVANCED_DEBUGGING, $LOCKID, $LOGFILENAME, $DEBUG_IN_FILE ); |
---|
35 | our $Progname = 'TEST-Tools' ; |
---|
36 | |
---|
37 | &info("Loading A2P::Tools library"); |
---|
38 | ok require A2P::Tools ; |
---|
39 | |
---|
40 | &info("Control shortID without parameter"); |
---|
41 | sub ShortID ; *ShortID = \&A2P::Tools::ShortID ; |
---|
42 | my $id = &ShortID ; |
---|
43 | ok defined($id); |
---|
44 | ok length($id), 4; |
---|
45 | ok \$id =~ /^SCALAR/ ; |
---|
46 | |
---|
47 | my @list = split(//,$id); |
---|
48 | my @cons = split(//,'bcdfgjklmnprstvxz'); |
---|
49 | my @voy = split(//,'aeiou' ); |
---|
50 | my $i = 0; |
---|
51 | while ( $i < length($id)) { |
---|
52 | if ($i % 2 == 0) { |
---|
53 | ok grep {/^$list[$i]$/} (length($id)%2 == 0)?@cons:@voy; |
---|
54 | } |
---|
55 | else { |
---|
56 | ok grep {/^$list[$i]$/} (length($id)%2 == 0)?@voy:@cons; |
---|
57 | } |
---|
58 | $i++; |
---|
59 | } |
---|
60 | |
---|
61 | &info("Control shortID with parameter 5"); |
---|
62 | $id = &ShortID(5) ; |
---|
63 | ok defined($id); |
---|
64 | ok length($id), 5; |
---|
65 | ok \$id =~ /^SCALAR/ ; |
---|
66 | |
---|
67 | @list = split(//,$id); |
---|
68 | @cons = split(//,'bcdfgjklmnprstvxz'); |
---|
69 | @voy = split(//,'aeiou' ); |
---|
70 | $i = 0; |
---|
71 | while ( $i < length($id)) { |
---|
72 | if ($i % 2 == 0) { |
---|
73 | ok grep {/^$list[$i]$/} (length($id)%2 == 0)?@cons:@voy; |
---|
74 | } |
---|
75 | else { |
---|
76 | ok grep {/^$list[$i]$/} (length($id)%2 == 0)?@voy:@cons; |
---|
77 | } |
---|
78 | $i++; |
---|
79 | } |
---|
80 | |
---|
81 | &info("Check SharedList API"); |
---|
82 | my $base = $SHMDIR . '/.shared-list-TEST' ; |
---|
83 | unlink glob($base.'*'); |
---|
84 | ok ! -e $base ; |
---|
85 | ok ! -e $base . '.LCK' ; |
---|
86 | sub SharedList ; *SharedList = \&A2P::Tools::SharedList ; |
---|
87 | sub FreeSharedList ; *FreeSharedList = \&A2P::Tools::FreeSharedList ; |
---|
88 | my $list = &SharedList('TEST'); |
---|
89 | ok $list ; |
---|
90 | ok ref($list), 'ARRAY' ; |
---|
91 | ok scalar(@{$list}), 0 ; |
---|
92 | ok -e $base ; |
---|
93 | ok -e $base . '.LCK' ; |
---|
94 | my $lck = qx(/usr/sbin/lsof -l $base.LCK 2>&1 | tee /tmp/tools-locking.log 2>&1) ; |
---|
95 | &info("Check lsof result:", $lck, "toward: perl $$ $< [0-9]+wW REG [0-9,]+ 0"); |
---|
96 | ok $lck ; |
---|
97 | ok $lck =~ /perl\s+$$\s+$<\s+\d+wW\s+REG\s+[0-9,]+\s+0\s+/ ; |
---|
98 | push @{$list}, 'BEGIN', 'VALUE' ; |
---|
99 | ok scalar(@{$list}), 2 ; |
---|
100 | ok $list->[1], 'VALUE' ; |
---|
101 | &FreeSharedList('TEST') ; |
---|
102 | |
---|
103 | $lck = qx(/usr/sbin/lsof -l $base.LCK 2>&1 | tee /tmp/tools-locking.log 2>&1) ; |
---|
104 | &info("Check lsof result:", $lck, "toward: perl $$ $< [0-9]+wW REG [0-9,]+ 0"); |
---|
105 | ok $lck !~ /perl\s+$$\s+$<\s+\d+wW\s+REG\s+[0-9,]+\s+0\s+/ ; |
---|
106 | |
---|
107 | push @{$list}, 'LAST' ; |
---|
108 | undef $list ; |
---|
109 | $list = &SharedList('TEST'); |
---|
110 | ok scalar(@{$list}), 2 ; |
---|
111 | push @{$list}, 'TEST', 'END' ; |
---|
112 | ok scalar(@{$list}), 4 ; |
---|
113 | ok shift @{$list}, 'BEGIN' ; |
---|
114 | ok $list->[1], 'TEST' ; |
---|
115 | &FreeSharedList('TEST') ; |
---|
116 | |
---|
117 | exit(0) ; |
---|