# # 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;