[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: SpoolManager.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 => 30 , |
---|
| 31 | onfail => sub { exit(1) } |
---|
| 32 | } |
---|
| 33 | |
---|
| 34 | $| = 1 ; |
---|
| 35 | |
---|
| 36 | our $tie_file ; |
---|
| 37 | our $test_string ; |
---|
| 38 | |
---|
| 39 | our ( $SERVICE_TMP, $SHMDIR, $ADVANCED_DEBUGGING, $LOCKID, |
---|
| 40 | $LOGFILENAME, $DEBUG_IN_FILE, $AFPSPOOL ); |
---|
| 41 | our $Progname = 'TEST-SpoolManager' ; |
---|
| 42 | |
---|
| 43 | # Be sure |
---|
| 44 | unlink $AFPSPOOL unless -d $AFPSPOOL ; |
---|
| 45 | mkdir $AFPSPOOL unless -d $AFPSPOOL ; |
---|
| 46 | mkdir $AFPSPOOL.'/.a2p' unless -d $AFPSPOOL.'/.a2p' ; |
---|
| 47 | |
---|
| 48 | &info("Loading A2P::SpoolManager library"); |
---|
| 49 | ok require A2P::SpoolManager ; |
---|
| 50 | |
---|
| 51 | sub update_prefix ; *update_prefix = \&A2P::SpoolManager::update_prefix ; |
---|
| 52 | |
---|
| 53 | &info("Update prefix"); |
---|
| 54 | # Default for $SPOOL_PREFIX is "TRANS ARCHI" ; |
---|
| 55 | ok join('-',&update_prefix("TRANS ARCHI")), "TRANS-ARCHI" ; #2 |
---|
| 56 | |
---|
| 57 | sub prefix ; *prefix = \&A2P::SpoolManager::prefix ; |
---|
| 58 | |
---|
| 59 | &info("Check file match a prefix"); |
---|
| 60 | ok &prefix("TRANS.TEST"), "TRANS" ; |
---|
| 61 | ok &prefix("TrANs.TEST"), "TrANs" ; |
---|
| 62 | ok &prefix("ARCHI.A"), "ARCHI" ; |
---|
| 63 | ok &prefix("archi."), "" ; |
---|
| 64 | ok &prefix("TEST"), "" ; |
---|
| 65 | ok &prefix(""), "" ; |
---|
| 66 | ok &prefix("none"), "" ; |
---|
| 67 | ok &prefix("none.TEST.none"), "" ; #10 |
---|
| 68 | |
---|
| 69 | |
---|
| 70 | &info("Check get locking"); |
---|
| 71 | |
---|
| 72 | |
---|
| 73 | sub openLockingPrefix ; *openLockingPrefix = \&A2P::SpoolManager::openLockingPrefix ; |
---|
| 74 | sub lockprefix ; *lockprefix = \&A2P::SpoolManager::lockprefix ; |
---|
| 75 | sub unlockprefix ; *unlockprefix = \&A2P::SpoolManager::unlockprefix ; |
---|
| 76 | sub closeLockingPrefix ; *closeLockingPrefix = \&A2P::SpoolManager::closeLockingPrefix ; |
---|
| 77 | |
---|
| 78 | &info("Check locking on prefix"); |
---|
| 79 | my $hashref = { LockingPrefix => {} }; |
---|
| 80 | my $lockfile = $AFPSPOOL . '/.a2p/TRANS.LCK' ; |
---|
| 81 | unlink $lockfile ; |
---|
| 82 | ok ! -e $lockfile ; |
---|
| 83 | ok &openLockingPrefix($hashref), 1 ; |
---|
| 84 | ok -e $lockfile ; |
---|
| 85 | ok exists($hashref->{LockingPrefix}->{TRANS}) ; #14 |
---|
| 86 | ok exists($hashref->{LockingPrefix}->{ARCHI}) ; |
---|
| 87 | my $TRANS = $hashref->{LockingPrefix}->{TRANS} ; |
---|
| 88 | my $ARCHI = $hashref->{LockingPrefix}->{ARCHI} ; |
---|
| 89 | ok (defined($TRANS) and defined($ARCHI)); |
---|
| 90 | ok ref($TRANS), 'GLOB' ; |
---|
| 91 | ok ref($ARCHI), 'GLOB' ; |
---|
| 92 | ok &lockprefix($hashref,"TRANS") ; #19 |
---|
| 93 | my $lck = qx(/usr/sbin/lsof -l $lockfile 2>&1 | tee /tmp/test-locking.log 2>&1) ; |
---|
| 94 | &info("Check lsof result:", $lck, "toward: perl $$ $< [0-9]+wW REG [0-9,]+ 0"); |
---|
| 95 | ok $lck && $lck =~ /perl\s+$$\s+$<\s+\d+wW\s+REG\s+[0-9,]+\s+0\s+/ ; |
---|
| 96 | ok &unlockprefix($hashref,"TRANS") , 1 ; |
---|
| 97 | ok exists($hashref->{LockingPrefix}->{TRANS}) ; #22 |
---|
| 98 | ok exists($hashref->{LockingPrefix}->{ARCHI}) ; |
---|
| 99 | ok &closeLockingPrefix($hashref), 1 ; |
---|
| 100 | ok ! exists($hashref->{LockingPrefix}->{TRANS}) ; |
---|
| 101 | ok ! exists($hashref->{LockingPrefix}->{ARCHI}) ; #26 |
---|
| 102 | |
---|
| 103 | &info("Checklocking when lock file has been deleted"); |
---|
| 104 | &openLockingPrefix($hashref) ; |
---|
| 105 | unlink $lockfile ; |
---|
| 106 | ok &lockprefix($hashref,"TRANS") ; #27 |
---|
| 107 | $lck = qx(/usr/sbin/lsof -l $lockfile 2>&1 | tee /tmp/test-locking.log 2>&1) ; |
---|
| 108 | &info("Check lsof result:", $lck, "toward: perl $$ $< [0-9]+wW REG [0-9,]+ 0"); |
---|
| 109 | ok $lck && $lck =~ /perl\s+$$\s+$<\s+\d+wW\s+REG\s+[0-9,]+\s+0\s+/ ; |
---|
| 110 | ok &unlockprefix($hashref,"TRANS") , 1 ; #29 |
---|
| 111 | ok &closeLockingPrefix($hashref), 1 ; |
---|
| 112 | |
---|
| 113 | 1 ; |
---|