#
# 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: Com.pm 3 2007-10-18 16:20:19Z guillaume $
#
package A2P::Com ;
use strict ;
use Socket ;
use Time::HiRes qw( gettimeofday usleep );
use Fcntl qw(:flock F_SETLK F_WRLCK SEEK_SET);
use IO::Socket ;
use A2P::Globals ;
BEGIN {
use Exporter ();
our ( $VERSION , @ISA , @EXPORT_OK , @TT );
$VERSION = sprintf "%s", q$Rev: 490 $ =~ /(\d[0-9.]+)\s+/ ;
@ISA = qw(Exporter);
@EXPORT_OK = qw( &IsCom &GetCom
&comCOM &comASK &comREQ &comLOG &comJOB &comSAY &comDONE &comINF &comTEST
&comZIP &comUPD &comFILE &GetTmpFile &TakeComLocking &ReleaseComLocking
&comXML
);
# Set timer ref to starting time
@TT = ( $^T , ( $^T * 1_000_000 ) % 1_000_000 ) unless @TT ;
}
our $VERSION ;
our @TT ;
#############################################################################
## Com tags lists ##
#############################################################################
# Constant tag index
sub comCOM () { 0 };
sub comASK () { 1 };
sub comREQ () { 2 };
sub comLOG () { 3 };
sub comJOB () { 4 };
sub comSAY () { 5 };
sub comINF () { 6 };
sub comZIP () { 7 };
sub comUPD () { 8 };
sub comFILE () { 50 };
sub comXML () { 1111 };
sub comTEST () { 8888 };
sub comDONE () { 9999 };
my $id = 1000 ;
my %Coms = (
comCOM , [ "" , "" , 'COM' ],
comASK , [ "" , "" , 'ASK' ],
comREQ , [ "" , "" , 'REQ' ],
comLOG , [ "" , "" , 'LOG' ],
comJOB , [ "" , "" , 'JOB' ],
comSAY , [ "" , "" , 'SAY' ],
comINF , [ "" , "", 'INFO'],
comZIP , [ "" , "" , 'ZIP' ],
comUPD , [ "" , "" , 'MAJ' ],
comFILE , [ "" , "", 'FILE'],
comDONE , [ "" , "", 'DONE']
);
my %RegExp = (
comCOM , qr|^(.*)$|i ,
comASK , qr|^(.*)$|i ,
comREQ , qr|^(.*)$|i ,
comLOG , qr|^(.*)$|i ,
comJOB , qr|^(.*)$|i ,
comSAY , qr|^(.*)$|i,
comINF , qr|^(.*)$|i,
comZIP , qr|^]+)\1 *>(.*)$|i,
comUPD , qr|^(.*)$|i,
comFILE , qr|^]+)\1 *>(.*)$|i,
comDONE , qr|^<(done) +id=\d{4}.*>(.*)$|i,
comXML , qr|^\s*<\w+.*>\s*$|s
);
sub GetCom {
local $" = '' ;
my $com = shift ;
$Coms{$com}->[1] = $id < 10000 ? $id ++ : ( $id = 1000 ) ;
$Coms{$com}->[3] = shift || "" ;
return "@{$Coms{$com}}[0..4]@_" . $Coms{$com}->[5] ;
}
# IsCom returns a list of matched pattern (pattern is s=choosen from first arg)
sub IsCom {
if ( $_[0] > 999 ) {
return $_[1] =~ $RegExp{$_[0]} ;
} else {
@_ = $_[1] =~ $RegExp{$_[0]} ;
# Remove matching apos before returning
shift unless ( @_ and $_[0] =~ /^[^"']+$/ );
return @_ ;
}
}
sub timestamp {
# Keep timer in the current minute
my @tt = &gettimeofday() ;
return sprintf("%.8d > ",
(( $tt[0] - $TT[0] ) * 1_000_000 + ( $tt[1] - $TT[1] )) % 60_000_000 );
}
sub GetTmpFile {
return $SERVICE_TMP . '/' . $_[0] ;
}
sub TakeComLocking {
my $fh = shift ;
my $locked = 0 ;
if (defined($fh)) {
# Try non blocking exclusive lock
$locked = flock( $fh, LOCK_EX | LOCK_NB );
# Else try blocking one
$locked = flock( $fh, LOCK_EX ) unless ( $locked );
&UPSTAT($locked?'GOOD-COMLOCKING':'BAD-COMLOCKING');
}
return $locked ;
}
sub ReleaseComLocking {
my $fh = shift or return 0 ;
flock( $fh, LOCK_UN );
}
1;