[3] | 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) ; |
---|