source: main/trunk/greenstone2/perllib/convertutil.pm@ 22350

Last change on this file since 22350 was 22350, checked in by davidb, 11 years ago

Testing for newer version of cached file had the 'sign' incorrect. Was largely working before because the .args file and the generated file had *exactly* the same time-stamp.

File size: 8.2 KB
Line 
1###########################################################################
2#
3# convertutil.pm -- utility to help convert files using external applications
4#
5# Copyright (C) 1999 DigiLib Systems Limited, NZ
6#
7# This program is free software; you can redistribute it and/or modify
8# it under the terms of the GNU General Public License as published by
9# the Free Software Foundation; either version 2 of the License, or
10# (at your option) any later version.
11#
12# This program is distributed in the hope that it will be useful,
13# but WITHOUT ANY WARRANTY; without even the implied warranty of
14# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15# GNU General Public License for more details.
16#
17# You should have received a copy of the GNU General Public License
18# along with this program; if not, write to the Free Software
19# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
20#
21###########################################################################
22
23
24package convertutil;
25
26use strict;
27no strict 'refs'; # allow filehandles to be variables and viceversa
28
29
30use File::Basename;
31
32
33sub monitor_init
34{
35 # do nothing
36 return {};
37}
38
39sub monitor_deinit
40{
41 my ($saved_rec) = @_;
42
43 # nothing to do
44}
45
46sub monitor_init_unbuffered
47{
48 my $saved_buffer_len = $|;
49 $| = 1;
50
51 my $saved_rec = { 'saved_buffer_len' => $saved_buffer_len };
52
53 return $saved_rec;
54}
55
56sub monitor_deinit_unbuffered
57{
58 my ($saved_rec) = @_;
59
60 my $saved_buffer_len = $saved_rec->{'saved_buffer_len'};
61
62 $| = $saved_buffer_len;
63}
64
65sub monitor_line
66{
67 my ($line) = @_;
68
69 my $had_error = 0;
70 my $generate_dot = 0;
71
72 return ($had_error,$generate_dot);
73}
74
75sub monitor_line_with_dot
76{
77 my ($line) = @_;
78
79 my $had_error = 0;
80 my $generate_dot = 1;
81
82 return ($had_error,$generate_dot);
83}
84
85
86sub run_general_cmd
87{
88 my ($command,$options) = @_;
89
90
91 # $options points to a hashtable that must have fields for:
92 # 'verbosity', 'outhandle', 'message_prefix' and 'message'
93 #
94 # it can also include functions for monitoring
95 # 'monitor_init' => takes no input arguments and returns a hashtable for saved data values
96 # 'monitor_line' => takes $line as input argument, return tuple (had_error,generate_dot)
97 # 'monitor_deinit' => takes the saved data values as input, restores saved values
98 #
99 # Default are provided for these monitor functions if none specified
100
101
102 my $verbosity = $options->{'verbosity'};
103 my $outhandle = $options->{'outhandle'};
104
105 my $message_prefix = $options->{'message_prefix'};
106 my $message = $options->{'message'};
107
108 my $monitor_init = $options->{'monitor_init'};
109 my $monitor_line = $options->{'monitor_line'};
110 my $monitor_deinit = $options->{'monitor_deinit'};
111
112 if (!defined $monitor_init) {
113 $monitor_init = "monitor_init";
114 }
115 if (!defined $monitor_line) {
116 $monitor_line = "monitor_line";
117 }
118 if (!defined $monitor_deinit) {
119 $monitor_deinit = "monitor_deinit";
120 }
121
122 print $outhandle "$message_prefix: $command\n" if ($verbosity > 3);
123 print $outhandle " $message ..." if ($verbosity >= 1);
124
125 my $command_status = undef;
126 my $result = "";
127 my $had_error = 0;
128
129 my $saved_rec = &$monitor_init();
130
131 if (open(CMD,"$command 2>&1 |"))
132 {
133 my $line;
134
135 my $linecount = 0;
136 my $dot_count = 0;
137
138
139 while (defined ($line = <CMD>))
140 {
141 $linecount++;
142
143 my ($had_local_error,$generate_dot) = &$monitor_line($line);
144
145 if ($had_local_error) {
146 # set general flag, but allow loop to continue to end building up the $result line
147 print $outhandle "$line\n";
148 $had_error = 1;
149 }
150
151
152 if ($generate_dot)
153 {
154 if ($dot_count == 0) { print $outhandle "\n "; }
155 print $outhandle ".";
156 $dot_count++;
157 if (($dot_count%76)==0)
158 {
159 print $outhandle "\n ";
160 }
161 }
162
163 $result .= $line;
164
165 }
166 print $outhandle "\n";
167
168
169 close(CMD);
170
171 $command_status = $?;
172 if ($command_status != 0) {
173 $had_error = 1;
174
175 print $outhandle "Error: processing command failed. Exit status $?\n";
176
177 if ($verbosity >= 3) {
178 print $outhandle " Command was: $command\n";
179 }
180 if ($verbosity >= 4) {
181 print $outhandle "$message_prefix result: $result\n";
182 }
183 }
184 }
185 else
186 {
187 $had_error = 1;
188 print STDERR "Error: failed to execute $command\n";
189 }
190
191 &$monitor_deinit($saved_rec);
192
193 if ($verbosity >= 1) {
194 if ($had_error) {
195 print $outhandle " ...error encounterd\n";
196 }
197 else {
198 print $outhandle " ...done\n";
199 }
200 }
201
202 if (defined $command_status && ($command_status == 0))
203 {
204 # only want to print the following out if verbosity is high enough
205 # and we haven't already printed it out as a detected error above
206 print $outhandle "$message_prefix result: $result\n" if ($verbosity > 5);
207 }
208
209 return ($result,$had_error);
210}
211
212
213sub regenerate_general_cmd
214{
215 my ($command,$ofilename,$options) = @_;
216
217 my $regenerated = 1;
218 my $result = "";
219 my $had_error = 0;
220
221 ($result,$had_error) = run_general_cmd($command,$options);
222
223 # store command args so can be compared with subsequent runs of the command
224 my $args_filename = "$ofilename.args";
225
226 if (open(ARGSOUT,">$args_filename")) {
227 print ARGSOUT $command;
228 print ARGSOUT "\n";
229 close(ARGSOUT);
230 }
231 else {
232 my $outhandle = $options->{'outhandle'};
233 print $outhandle "Warning: Unable to write out caching information to file $args_filename\n";
234 print $outhandle " This means $ofilename will be regenerated on next build whether\n";
235 print $outhandle " processing args have changed or not.\n";
236 }
237
238 # Store the result, since ImageConverter.pm extracts the image height and width from the processed result
239 my $result_filename = "$ofilename.result";
240 if (open(RESOUT, ">$result_filename"))
241 {
242 print RESOUT $result;
243 close(RESOUT);
244 }
245 else
246 {
247 my $outhandle = $options->{'outhandle'};
248 print $outhandle "Warning: Unable to write out cached process result to file $result_filename.\n";
249 }
250
251 return ($regenerated,$result,$had_error);
252}
253
254
255
256sub run_cached_general_cmd
257{
258 my ($command,$ofilename,$options) = @_;
259
260 my $outhandle = $options->{'outhandle'};
261 my $verbosity = $options->{'verbosity'};
262 my $message_prefix = $options->{'message_prefix'};
263
264 my $regenerated = 0;
265 my $result = "";
266 my $had_error = 0;
267
268 my $args_filename = "$ofilename.args";
269
270 if ((!-e $ofilename) || (!-e $args_filename)) {
271 ($regenerated,$result,$had_error)
272 = regenerate_general_cmd($command,$ofilename,$options);
273 }
274 elsif (-M $ofilename < -M $args_filename) {
275 # Source files has been updated/changed in some way
276 # => regenerate
277 print $outhandle "$ofilename modified more recently than cached version\n";
278
279 ($regenerated,$result,$had_error)
280 = regenerate_general_cmd($command,$ofilename,$options);
281 }
282 else {
283 # file exists => check to see if command to generate it has changed
284
285 if (open (ARGSIN,"<$args_filename")) {
286 my $prev_command = <ARGSIN>;
287 chomp($prev_command);
288
289 close(ARGSIN);
290
291 if (defined $prev_command) {
292 # if commands are different
293 if ($prev_command ne $command) {
294 # need to rerun command
295 ($regenerated,$result,$had_error)
296 = regenerate_general_cmd($command,$ofilename,$options);
297 }
298 else {
299 my ($ofile) = ($ofilename =~ m/^.*(cached.*)$/);
300
301 my $ofile_no_dir = basename($ofile);
302 print $outhandle " $message_prefix: Cached file $ofile_no_dir already exists.\n";
303 print $outhandle " $message_prefix: No need to regenerate $ofile\n" if ($verbosity > 2);
304
305 if ((defined $options->{'cache_mode'})
306 && $options->{'cache_mode'} eq "without_result") {
307 $result = "";
308 }
309 else {
310 # Read in the cached result lines and join them into a single string
311 my $result_filename = "$ofilename.result";
312 if (open(RESIN, "<$result_filename"))
313 {
314 my @result_lines = <RESIN>;
315 $result = join("\n", @result_lines);
316 close(RESIN);
317 }
318 else
319 {
320 print $outhandle " $message_prefix: Error, failed to obtain cached result from $result_filename.\n";
321 }
322 }
323 }
324
325 }
326 }
327 else {
328 print $outhandle " $message_prefix: No cached previous args found. Regenerating $ofilename\n";
329
330 ($regenerated,$result,$had_error) = regenerate_general_cmd($command,$ofilename,$options);
331 }
332 }
333
334 return ($regenerated,$result,$had_error);
335}
336
337
3381;
Note: See TracBrowser for help on using the repository browser.