#
# 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 $
#
package A2P::EService::Tools ;
# Package of tools API to create E-Service dedicated scripts
use strict ;
use integer ;
use Carp qw(longmess);
use XML::LibXML ;
use A2P::Globals ;
use A2P::Syslog ;
BEGIN {
use Exporter ();
our $VERSION = sprintf "%s", q$Rev: 885 $ =~ /(\d[0-9.]+)\s+/ ;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw( &try &abort &get_conf &get_id &get_lib &get_work
&get_useragent );
}
our $VERSION ;
our $perllib = '/etc/afp2print/perl5lib' ;
my $try = "" ;
my $tries = 0 ;
my $service = $0 ;
sub try {
# Handle Perl signals
$SIG{'__DIE__'} = $SIG{'__WARN__'} = sub {
&abort(&longmess(@_));
};
$try = shift ;
++ $tries ;
print sprintf("Check #%03d: %s\n", $tries, $try )
if (exists($ENV{SHOW_TRIES}));
}
sub abort {
# If one argument is given, add it to try string
$try .= ": " . shift if @_ ;
$try .= " ($!)" if ($!);
# Print message only in some environment
print "$try\n"
if (exists($ENV{A2P_PATH}) or (defined($ENV{DEBUG}) and $ENV{DEBUG}));
&Error($try);
print STDERR "ABTERM: $try\n" if (defined($ENV{JOB}) and $ENV{JOB});
exit($tries);
}
sub get_conf {
$service = shift ;
my @required = @_ ;
# Prepare logging api
our $Progname = $0 = $service ;
A2P::Syslog::SetLogger(0);
my $conf_file = $service . '.conf' ;
# Configuration folder can be over-rided with EADRESSE_CONF environment
my $conf_path = defined($ENV{'EADRESSE_CONF'}) ?
$ENV{'EADRESSE_CONF'} : '/etc/afp2print/eservice' ;
# Prepare path to configuration file to 'require' it
$conf_path .= '/' unless ( $conf_path =~ m|/$| );
$conf_file = $conf_path . $conf_file ;
abort "No configuration found at $conf_file"
unless -e $conf_file ;
my $conf = {} ;
my ( $req, $eval ) = ( "", "" ) ;
map {
$req .= 'our %' . $_ . ' ;' ;
$eval .= '$conf->{' . $_ . '} = \%' . $_ . ' ; ' ;
} @required ;
eval "$req require '$conf_file' ; $eval"
or abort "Can't read '$conf_file' configuration file" ;
return $conf ;
}
sub _cons {
return substr('bcdfgjklmnprstvxz',rand(17),1);
}
sub _vowl {
return substr('aeiou',rand(5),1);
}
sub get_id {
my $reference = shift || _cons . _vowl . _cons . _vowl . _cons . _vowl ;
my $job = $ENV{JOB} || _cons . _vowl . _cons . _vowl . _cons . _vowl ;
my $host = lc($LOCKID) ;
return sprintf('%s-%s-%x@%s.%s', $job, $reference, $$, $service, $host );
}
sub get_lib {
my $library = shift or return 0 ;
my $wanted = shift || 0 ;
try "Loading '$library'" ;
eval "use lib '$perllib' ; use $library" ;
my $version = eval '$' . $library . '::VERSION' ;
abort "$library version not found" unless (defined($version) and $version);
abort "Too old $library version $version not supported"
unless ( $version >= $wanted );
# Reset errno as it is often set during library load
$! = 0 ;
return 1 ;
}
sub get_useragent {
return $service . " v" . A2P_RPM_VERSION ;
}
sub get_work {
# The work to do is provided as pdf and file attribut in a XML
my ( $pdf, $file ) = ( "", "" );
my $xml ;
my @XML ;
my $parser = new XML::LibXML ;
abort "Unable to get an XML parser" unless (defined($parser));
# Firstly expect job as argument as mode 1
if (@ARGV) {
# Still abort if got wrong count of arguments
abort "Bad argument count with '@ARGV'" unless ( @ARGV == 1 );
# Argument must be a file
my $file = shift @ARGV ;
abort "Bad file found" unless -s $file ;
$xml = $parser->parse_file( $file );
abort "Can't parse '$file' as XML" unless (defined($xml));
} else {
# Mode 0
my @XML = ;
local $" = '' ;
$xml = $parser->parse_string("@XML") if @XML ;
abort "Can't parse '@XML' string as XML" unless (defined($xml));
}
my $root = $xml->lastChild ;
abort "No XML root found in given content" unless (defined($root));
my $rootname = $root->nodeName() ;
abort "XML is not an a2P work to do "
unless ( defined($rootname) and $rootname and $rootname =~ /^a2p$/i );
$pdf = $root->getAttribute('pdf') ;
abort "No 'pdf' attribut found in a2p XML"
unless ( defined($pdf) and $pdf );
$file = $root->getAttribute('file') ;
abort "No 'file' attribut found in a2p XML"
unless ( defined($file) and $file );
# return job to do
return ( $pdf, $file ) ;
}
1;