source: A2P/a2p/A2P/archivage.pm @ 15

#
# 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: archivage.pm 3 2007-10-18 16:20:19Z guillaume $
#
################################################################################
# author      : yves mantel <ymantel@consultas.ch>
# adaptation  : guillaume bougard <gbougard@pkg.fr>
# description : naca archiving load client template
################################################################################

package A2P::archivage;

use strict;
use Errno qw(:POSIX);
use IO::Socket;
use IO::File;
use IO::Handle qw( autoflush );
use MIME::Base64;
use Time::HiRes qw(usleep);
use Benchmark;
use A2P::Globals;
use A2P::Syslog;

BEGIN {
    use Exporter ();

    our ( $VERSION , @ISA , @EXPORT );

    $VERSION = sprintf "%s", q$Rev: 876 $ =~ /(\d[0-9.]+)\s+/ ;

    @ISA = qw(Exporter);
    @EXPORT = qw( $SOCK &ArchivageMain );
}
our $VERSION ;

our $SOCK ;

# command parameters
my $root_filename ;       # root filename, used to construct pdf and prt filename
my $pdf_filename ;
my $prt_filename ;

# Other variables used in module version and for multi-threading
my $LOGFILE ; # Private file handle for archivage logging

my $ArchError = 0 ;

################################################################################
#
# Archivage main template
#
################################################################################
sub ArchivageMain() {

   ($root_filename) = @_ ;
   $ArchError = 0 ;
   # Adapted original implementation of archivage.pl main function
   if ($ARCH_DEBUG) {
      # The arch debug file extension should be reported in A2P::Job
      # get_arch_file member. If modified as we need to move it to result folder
      open ($LOGFILE,">>$root_filename.arch_debug.txt")
         or &Error("Can't open '$root_filename.arch_debug.txt' for writing: $!");
   }

   &init;

   # Do stuff ...

   close $LOGFILE if ($ARCH_DEBUG and defined($LOGFILE));
   undef $root_filename ;

   return $ArchError ;
}


################################################################################
#
# Init
#
################################################################################
sub init() {

   &logThis("");
   &logThis("**********************************************");
   &logThis("************** NEW LOAD REQUEST **************");
   &logThis("**********************************************");
   &logThis("");
   &logThis(&get_current_time);

   # test input files
   $pdf_filename = $root_filename . ".pdf";
   $prt_filename = $root_filename . ".arch";
   return &ArchDie("$pdf_filename does not exist !") unless (-e $pdf_filename);
   return &ArchDie("$prt_filename does not exist !") unless (-e $prt_filename);

   &logThis("root_filename is $root_filename");
   &logThis("pdf_filename is $pdf_filename");
   &logThis("prt_filename is $prt_filename");
}


################################################################################
#
# Logs to syslog and also to file if debug mode
#
################################################################################
sub logThis() {
    my $msg = shift ;
    local $\ = "\n" ;
    &Debug(split(/\n/,$msg)) if ( length($msg) and ! $ArchError );
    print $LOGFILE "[" . &format_date . "] " . $msg
        if ($ARCH_DEBUG and defined($LOGFILE));
}


################################################################################
#
# Formats date
#
################################################################################
sub format_date() {
  my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
  return sprintf "%02d.%02d.%04d %02d:%02d:%02d",$mday,($mon+1),($year+1900),$hour,$min,$sec;
}


################################################################################
#
# Chrono
#
################################################################################
sub chrono() {
  my $ref = shift @_ ;

  my $t0 = new Benchmark;
  eval($ref) ;
  &ArchDie($@) if $@;
  my $t1 = new Benchmark;
  my $td = timediff($t1, $t0);
  $ref =~ s/^&//;
  &logThis("CHRONO $ref:".timestr($td));
}


################################################################################
#
# Display time
#
################################################################################
sub get_current_time() {
   my @Weekdays = ('Sunday', 'Monday', 'Tuesday', 'Wednesday', 'Thursday', 'Friday', 'Saturday');
   my @Months = ('January', 'February', 'March', 'April', 'May', 'June', 'July', 'August', 'September', 'October', 'November', 'December');
   my @Now = localtime(time());

   my $Weekday = $Weekdays[$Now[6]];
   my $Day = $Now[3];
   my $MonthText = $Months[$Now[4]];
   my $Month = $Now[4]+1;
   $Month = "0$Month" if $Month < 10;
   my $Year = $Now[5]+1900;

   my $Hour = $Now[2];
   my $Minute = $Now[1];
   $Minute = "0$Minute" if $Minute < 10;
   my $Second = $Now[0];
   $Second = "0$Second" if $Second < 10;
   return "$Weekday $Day $MonthText $Year $Hour:$Minute:$Second";
}


################################################################################
#
# Logs ArchDie functions
#
################################################################################

sub id {
   my $level = shift;
   my($pack,$file,$line,$sub) = caller($level);
   my($id) = $file=~m|([^/]+)$|;
   return ($file,$line,$id);
}

sub stamp {
   my $time = scalar(localtime);
   my $frame = 0;
   my ($id,$pack,$file);
   do {
      $id = $file;
      ($pack,$file) = caller($frame++);
   } until (!$file or $file eq $id);
   ($id) = $id=~m|([^/]+)$|;
   return "[$time] $id: ";
}

sub ArchDie {
   &Debug("Archivage request dies");
   my $message = shift;
   my($file,$line,$id) = &id(1);
   $message .= " at $file line $line.";
   my $stamp = &stamp;
   #$message =~ s/^/$stamp/gm;
   &logThis("ERROR: $message") ;
   &Error($message); # Syslog version
   $ArchError ++ ;
}

################################################################################
#
# END
#
################################################################################
&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");

1;