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

#
# 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: Tools.pm 3 2007-10-18 16:20:19Z guillaume $
#

use strict ;
use Test ;

require 'test/A2P/Defaults.pm' ;

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

our ( $SHMDIR, $ADVANCED_DEBUGGING, $LOCKID, $LOGFILENAME, $DEBUG_IN_FILE );
our $Progname = 'TEST-Tools' ;

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

&info("Control shortID without parameter");
    sub ShortID    ; *ShortID = \&A2P::Tools::ShortID ;
    my $id = &ShortID ;
ok      defined($id);
ok  length($id), 4;
ok      \$id =~ /^SCALAR/ ;

    my @list = split(//,$id);
    my @cons = split(//,'bcdfgjklmnprstvxz');
    my @voy  = split(//,'aeiou' );
    my $i = 0;
    while ( $i < length($id)) {
        if      ($i % 2 == 0) {
ok                      grep {/^$list[$i]$/} (length($id)%2 == 0)?@cons:@voy;
        }
        else {
ok                      grep {/^$list[$i]$/} (length($id)%2 == 0)?@voy:@cons;
        }
        $i++;
    }

&info("Control shortID with parameter 5");
    $id = &ShortID(5) ;
ok      defined($id);
ok  length($id), 5;
ok      \$id =~ /^SCALAR/ ;

    @list = split(//,$id);
    @cons = split(//,'bcdfgjklmnprstvxz');
    @voy  = split(//,'aeiou' );
    $i = 0;
    while ( $i < length($id)) {
        if      ($i % 2 == 0) {
ok                      grep {/^$list[$i]$/} (length($id)%2 == 0)?@cons:@voy;
        }
        else {
ok                      grep {/^$list[$i]$/} (length($id)%2 == 0)?@voy:@cons;
        }
        $i++;
    }

&info("Check SharedList API");
    my $base = $SHMDIR . '/.shared-list-TEST' ;
    unlink glob($base.'*');
ok ! -e $base ;
ok ! -e $base . '.LCK' ;
    sub SharedList ; *SharedList = \&A2P::Tools::SharedList ;
    sub FreeSharedList ; *FreeSharedList = \&A2P::Tools::FreeSharedList ;
    my $list = &SharedList('TEST');
ok $list ;
ok ref($list), 'ARRAY' ;
ok scalar(@{$list}), 0 ;
ok -e $base ;
ok -e $base . '.LCK' ;
    my $lck = qx(/usr/sbin/lsof -l $base.LCK  2>&1 | tee /tmp/tools-locking.log 2>&1) ;
    &info("Check lsof result:", $lck, "toward: perl $$ $< [0-9]+wW REG [0-9,]+ 0");
ok $lck ;
ok $lck =~ /perl\s+$$\s+$<\s+\d+wW\s+REG\s+[0-9,]+\s+0\s+/ ;
    push @{$list}, 'BEGIN', 'VALUE' ;
ok scalar(@{$list}), 2 ;
ok $list->[1], 'VALUE' ;
    &FreeSharedList('TEST') ;

    $lck = qx(/usr/sbin/lsof -l $base.LCK  2>&1 | tee /tmp/tools-locking.log 2>&1) ;
    &info("Check lsof result:", $lck, "toward: perl $$ $< [0-9]+wW REG [0-9,]+ 0");
ok $lck !~ /perl\s+$$\s+$<\s+\d+wW\s+REG\s+[0-9,]+\s+0\s+/ ;

    push @{$list}, 'LAST' ;
    undef $list ;
    $list = &SharedList('TEST');
ok scalar(@{$list}), 2 ;
    push @{$list}, 'TEST', 'END' ;
ok scalar(@{$list}), 4 ;
ok shift @{$list}, 'BEGIN' ;
ok $list->[1], 'TEST' ;
    &FreeSharedList('TEST') ;

exit(0) ;