[3] | 1 | # |
---|
| 2 | # Copyright (c) 2004-2007 - Consultas, PKG.fr |
---|
| 3 | # |
---|
| 4 | # This file is part of A2P. |
---|
| 5 | # |
---|
| 6 | # A2P is free software; you can redistribute it and/or modify |
---|
| 7 | # it under the terms of the GNU General Public License as published by |
---|
| 8 | # the Free Software Foundation; either version 2 of the License, or |
---|
| 9 | # (at your option) any later version. |
---|
| 10 | # |
---|
| 11 | # A2P is distributed in the hope that it will be useful, |
---|
| 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of |
---|
| 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
---|
| 14 | # GNU General Public License for more details. |
---|
| 15 | # |
---|
| 16 | # You should have received a copy of the GNU General Public License |
---|
| 17 | # along with A2P; if not, write to the Free Software |
---|
| 18 | # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA |
---|
| 19 | # |
---|
| 20 | # $Id: archivage.pm 3 2007-10-18 16:20:19Z guillaume $ |
---|
| 21 | # |
---|
| 22 | ################################################################################ |
---|
| 23 | # author : yves mantel <ymantel@consultas.ch> |
---|
| 24 | # adaptation : guillaume bougard <gbougard@pkg.fr> |
---|
| 25 | # description : naca archiving load client template |
---|
| 26 | ################################################################################ |
---|
| 27 | |
---|
| 28 | package A2P::archivage; |
---|
| 29 | |
---|
| 30 | use strict; |
---|
| 31 | use Errno qw(:POSIX); |
---|
| 32 | use IO::Socket; |
---|
| 33 | use IO::File; |
---|
| 34 | use IO::Handle qw( autoflush ); |
---|
| 35 | use MIME::Base64; |
---|
| 36 | use Time::HiRes qw(usleep); |
---|
| 37 | use Benchmark; |
---|
| 38 | use A2P::Globals; |
---|
| 39 | use A2P::Syslog; |
---|
| 40 | |
---|
| 41 | BEGIN { |
---|
| 42 | use Exporter (); |
---|
| 43 | |
---|
| 44 | our ( $VERSION , @ISA , @EXPORT ); |
---|
| 45 | |
---|
| 46 | $VERSION = sprintf "%s", q$Rev: 876 $ =~ /(\d[0-9.]+)\s+/ ; |
---|
| 47 | |
---|
| 48 | @ISA = qw(Exporter); |
---|
| 49 | @EXPORT = qw( $SOCK &ArchivageMain ); |
---|
| 50 | } |
---|
| 51 | our $VERSION ; |
---|
| 52 | |
---|
| 53 | our $SOCK ; |
---|
| 54 | |
---|
| 55 | # command parameters |
---|
| 56 | my $root_filename ; # root filename, used to construct pdf and prt filename |
---|
| 57 | my $pdf_filename ; |
---|
| 58 | my $prt_filename ; |
---|
| 59 | |
---|
| 60 | # Other variables used in module version and for multi-threading |
---|
| 61 | my $LOGFILE ; # Private file handle for archivage logging |
---|
| 62 | |
---|
| 63 | my $ArchError = 0 ; |
---|
| 64 | |
---|
| 65 | ################################################################################ |
---|
| 66 | # |
---|
| 67 | # Archivage main template |
---|
| 68 | # |
---|
| 69 | ################################################################################ |
---|
| 70 | sub ArchivageMain() { |
---|
| 71 | |
---|
| 72 | ($root_filename) = @_ ; |
---|
| 73 | $ArchError = 0 ; |
---|
| 74 | # Adapted original implementation of archivage.pl main function |
---|
| 75 | if ($ARCH_DEBUG) { |
---|
| 76 | # The arch debug file extension should be reported in A2P::Job |
---|
| 77 | # get_arch_file member. If modified as we need to move it to result folder |
---|
| 78 | open ($LOGFILE,">>$root_filename.arch_debug.txt") |
---|
| 79 | or &Error("Can't open '$root_filename.arch_debug.txt' for writing: $!"); |
---|
| 80 | } |
---|
| 81 | |
---|
| 82 | &init; |
---|
| 83 | |
---|
| 84 | # Do stuff ... |
---|
| 85 | |
---|
| 86 | close $LOGFILE if ($ARCH_DEBUG and defined($LOGFILE)); |
---|
| 87 | undef $root_filename ; |
---|
| 88 | |
---|
| 89 | return $ArchError ; |
---|
| 90 | } |
---|
| 91 | |
---|
| 92 | |
---|
| 93 | ################################################################################ |
---|
| 94 | # |
---|
| 95 | # Init |
---|
| 96 | # |
---|
| 97 | ################################################################################ |
---|
| 98 | sub init() { |
---|
| 99 | |
---|
| 100 | &logThis(""); |
---|
| 101 | &logThis("**********************************************"); |
---|
| 102 | &logThis("************** NEW LOAD REQUEST **************"); |
---|
| 103 | &logThis("**********************************************"); |
---|
| 104 | &logThis(""); |
---|
| 105 | &logThis(&get_current_time); |
---|
| 106 | |
---|
| 107 | # test input files |
---|
| 108 | $pdf_filename = $root_filename . ".pdf"; |
---|
| 109 | $prt_filename = $root_filename . ".arch"; |
---|
| 110 | return &ArchDie("$pdf_filename does not exist !") unless (-e $pdf_filename); |
---|
| 111 | return &ArchDie("$prt_filename does not exist !") unless (-e $prt_filename); |
---|
| 112 | |
---|
| 113 | &logThis("root_filename is $root_filename"); |
---|
| 114 | &logThis("pdf_filename is $pdf_filename"); |
---|
| 115 | &logThis("prt_filename is $prt_filename"); |
---|
| 116 | } |
---|
| 117 | |
---|
| 118 | |
---|
| 119 | ################################################################################ |
---|
| 120 | # |
---|
| 121 | # Logs to syslog and also to file if debug mode |
---|
| 122 | # |
---|
| 123 | ################################################################################ |
---|
| 124 | sub logThis() { |
---|
| 125 | my $msg = shift ; |
---|
| 126 | local $\ = "\n" ; |
---|
| 127 | &Debug(split(/\n/,$msg)) if ( length($msg) and ! $ArchError ); |
---|
| 128 | print $LOGFILE "[" . &format_date . "] " . $msg |
---|
| 129 | if ($ARCH_DEBUG and defined($LOGFILE)); |
---|
| 130 | } |
---|
| 131 | |
---|
| 132 | |
---|
| 133 | ################################################################################ |
---|
| 134 | # |
---|
| 135 | # Formats date |
---|
| 136 | # |
---|
| 137 | ################################################################################ |
---|
| 138 | sub format_date() { |
---|
| 139 | my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); |
---|
| 140 | return sprintf "%02d.%02d.%04d %02d:%02d:%02d",$mday,($mon+1),($year+1900),$hour,$min,$sec; |
---|
| 141 | } |
---|
| 142 | |
---|
| 143 | |
---|
| 144 | ################################################################################ |
---|
| 145 | # |
---|
| 146 | # Chrono |
---|
| 147 | # |
---|
| 148 | ################################################################################ |
---|
| 149 | sub chrono() { |
---|
| 150 | my $ref = shift @_ ; |
---|
| 151 | |
---|
| 152 | my $t0 = new Benchmark; |
---|
| 153 | eval($ref) ; |
---|
| 154 | &ArchDie($@) if $@; |
---|
| 155 | my $t1 = new Benchmark; |
---|
| 156 | my $td = timediff($t1, $t0); |
---|
| 157 | $ref =~ s/^&//; |
---|
| 158 | &logThis("CHRONO $ref:".timestr($td)); |
---|
| 159 | } |
---|
| 160 | |
---|
| 161 | |
---|
| 162 | ################################################################################ |
---|
| 163 | # |
---|
| 164 | # Display time |
---|
| 165 | # |
---|
| 166 | ################################################################################ |
---|
| 167 | sub get_current_time() { |
---|
| 168 | my @Weekdays = ('Sunday', 'Monday', 'Tuesday', 'Wednesday', 'Thursday', 'Friday', 'Saturday'); |
---|
| 169 | my @Months = ('January', 'February', 'March', 'April', 'May', 'June', 'July', 'August', 'September', 'October', 'November', 'December'); |
---|
| 170 | my @Now = localtime(time()); |
---|
| 171 | |
---|
| 172 | my $Weekday = $Weekdays[$Now[6]]; |
---|
| 173 | my $Day = $Now[3]; |
---|
| 174 | my $MonthText = $Months[$Now[4]]; |
---|
| 175 | my $Month = $Now[4]+1; |
---|
| 176 | $Month = "0$Month" if $Month < 10; |
---|
| 177 | my $Year = $Now[5]+1900; |
---|
| 178 | |
---|
| 179 | my $Hour = $Now[2]; |
---|
| 180 | my $Minute = $Now[1]; |
---|
| 181 | $Minute = "0$Minute" if $Minute < 10; |
---|
| 182 | my $Second = $Now[0]; |
---|
| 183 | $Second = "0$Second" if $Second < 10; |
---|
| 184 | return "$Weekday $Day $MonthText $Year $Hour:$Minute:$Second"; |
---|
| 185 | } |
---|
| 186 | |
---|
| 187 | |
---|
| 188 | ################################################################################ |
---|
| 189 | # |
---|
| 190 | # Logs ArchDie functions |
---|
| 191 | # |
---|
| 192 | ################################################################################ |
---|
| 193 | |
---|
| 194 | sub id { |
---|
| 195 | my $level = shift; |
---|
| 196 | my($pack,$file,$line,$sub) = caller($level); |
---|
| 197 | my($id) = $file=~m|([^/]+)$|; |
---|
| 198 | return ($file,$line,$id); |
---|
| 199 | } |
---|
| 200 | |
---|
| 201 | sub stamp { |
---|
| 202 | my $time = scalar(localtime); |
---|
| 203 | my $frame = 0; |
---|
| 204 | my ($id,$pack,$file); |
---|
| 205 | do { |
---|
| 206 | $id = $file; |
---|
| 207 | ($pack,$file) = caller($frame++); |
---|
| 208 | } until (!$file or $file eq $id); |
---|
| 209 | ($id) = $id=~m|([^/]+)$|; |
---|
| 210 | return "[$time] $id: "; |
---|
| 211 | } |
---|
| 212 | |
---|
| 213 | sub ArchDie { |
---|
| 214 | &Debug("Archivage request dies"); |
---|
| 215 | my $message = shift; |
---|
| 216 | my($file,$line,$id) = &id(1); |
---|
| 217 | $message .= " at $file line $line."; |
---|
| 218 | my $stamp = &stamp; |
---|
| 219 | #$message =~ s/^/$stamp/gm; |
---|
| 220 | &logThis("ERROR: $message") ; |
---|
| 221 | &Error($message); # Syslog version |
---|
| 222 | $ArchError ++ ; |
---|
| 223 | } |
---|
| 224 | |
---|
| 225 | ################################################################################ |
---|
| 226 | # |
---|
| 227 | # END |
---|
| 228 | # |
---|
| 229 | ################################################################################ |
---|
| 230 | &Debug("Module " . __PACKAGE__ . " v$VERSION loaded"); |
---|
| 231 | |
---|
| 232 | 1; |
---|