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