source: A2P/a2p/A2P/EService/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 $
#

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 <a2p/> 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 = <STDIN> ;
        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;