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

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

Correction to caching technique to work with input file rather than output file in terms of working out when the cached file needs to be regenerated

File size: 8.5 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 my ($cpackage,$cfilename,$cline,$csubr,$chas_args,$cwantarray) = caller(4);
123 print STDERR "Calling method; $cfilename:$cline $cpackage->$csubr:$cline\n";
124
125 print $outhandle "$message_prefix: $command\n" if ($verbosity > 3);
126 print $outhandle " $message ..." if ($verbosity >= 1);
127
128 my $command_status = undef;
129 my $result = "";
130 my $had_error = 0;
131
132 my $saved_rec = &$monitor_init();
133
134 if (open(CMD,"$command 2>&1 |"))
135 {
136 my $line;
137
138 my $linecount = 0;
139 my $dot_count = 0;
140
141
142 while (defined ($line = <CMD>))
143 {
144 $linecount++;
145
146 my ($had_local_error,$generate_dot) = &$monitor_line($line);
147
148 if ($had_local_error) {
149 # set general flag, but allow loop to continue to end building up the $result line
150 print $outhandle "$line\n";
151 $had_error = 1;
152 }
153
154
155 if ($generate_dot)
156 {
157 if ($dot_count == 0) { print $outhandle "\n "; }
158 print $outhandle ".";
159 $dot_count++;
160 if (($dot_count%76)==0)
161 {
162 print $outhandle "\n ";
163 }
164 }
165
166 $result .= $line;
167
168 }
169 print $outhandle "\n";
170
171
172 close(CMD);
173
174 $command_status = $?;
175 if ($command_status != 0) {
176 $had_error = 1;
177
178 print $outhandle "Error: processing command failed. Exit status $?\n";
179
180 if ($verbosity >= 3) {
181 print $outhandle " Command was: $command\n";
182 }
183 if ($verbosity >= 4) {
184 print $outhandle "$message_prefix result: $result\n";
185 }
186 }
187 }
188 else
189 {
190 $had_error = 1;
191 print STDERR "Error: failed to execute $command\n";
192 }
193
194 &$monitor_deinit($saved_rec);
195
196 if ($verbosity >= 1) {
197 if ($had_error) {
198 print $outhandle " ...error encounterd\n";
199 }
200 else {
201 print $outhandle " ...done\n";
202 }
203 }
204
205 if (defined $command_status && ($command_status == 0))
206 {
207 # only want to print the following out if verbosity is high enough
208 # and we haven't already printed it out as a detected error above
209 print $outhandle "$message_prefix result: $result\n" if ($verbosity > 5);
210 }
211
212 return ($result,$had_error);
213}
214
215
216sub regenerate_general_cmd
217{
218 my ($command,$ifilename,$ofilename,$options) = @_;
219
220 my $regenerated = 1;
221 my $result = "";
222 my $had_error = 0;
223
224 ($result,$had_error) = run_general_cmd($command,$options);
225
226 # store command args so can be compared with subsequent runs of the command
227 my $args_filename = "$ofilename.args";
228
229 if (open(ARGSOUT,">$args_filename")) {
230 print ARGSOUT $command;
231 print ARGSOUT "\n";
232 close(ARGSOUT);
233 }
234 else {
235 my $outhandle = $options->{'outhandle'};
236 print $outhandle "Warning: Unable to write out caching information to file $args_filename\n";
237 print $outhandle " This means $ofilename will be regenerated on next build whether\n";
238 print $outhandle " processing args have changed or not.\n";
239 }
240
241 # Store the result, since ImageConverter.pm extracts the image height and width from the processed result
242 my $result_filename = "$ofilename.result";
243 if (open(RESOUT, ">$result_filename"))
244 {
245 print RESOUT $result;
246 close(RESOUT);
247 }
248 else
249 {
250 my $outhandle = $options->{'outhandle'};
251 print $outhandle "Warning: Unable to write out cached process result to file $result_filename.\n";
252 }
253
254 return ($regenerated,$result,$had_error);
255}
256
257
258
259sub run_cached_general_cmd
260{
261 my ($command,$ifilename,$ofilename,$options) = @_;
262
263 my $outhandle = $options->{'outhandle'};
264 my $verbosity = $options->{'verbosity'};
265 my $message_prefix = $options->{'message_prefix'};
266
267 my $regenerated = 0;
268 my $result = "";
269 my $had_error = 0;
270
271 my $args_filename = "$ofilename.args";
272
273 if ((!-e $ofilename) || (!-e $args_filename)) {
274 ($regenerated,$result,$had_error)
275 = regenerate_general_cmd($command,$ifilename,$ofilename,$options);
276 }
277 elsif (-M $ifilename < -M $args_filename) {
278 # Source files has been updated/changed in some way
279 # => regenerate
280 print $outhandle "$ifilename modified more recently than cached version\n";
281
282 ($regenerated,$result,$had_error)
283 = regenerate_general_cmd($command,$ifilename,$ofilename,$options);
284 }
285 else {
286 # file exists => check to see if command to generate it has changed
287
288 if (open (ARGSIN,"<$args_filename")) {
289 my $prev_command = <ARGSIN>;
290 chomp($prev_command);
291
292 close(ARGSIN);
293
294 if (defined $prev_command) {
295 # if commands are different
296 if ($prev_command ne $command) {
297 # need to rerun command
298 ($regenerated,$result,$had_error)
299 = regenerate_general_cmd($command,$ifilename,$ofilename,$options);
300 }
301 else {
302 my ($ofile) = ($ofilename =~ m/^.*(cached.*)$/);
303
304 my $ofile_no_dir = basename($ofile);
305 print $outhandle " $message_prefix: Cached file $ofile_no_dir already exists.\n";
306 print $outhandle " $message_prefix: No need to regenerate $ofile\n" if ($verbosity > 2);
307
308 if ((defined $options->{'cache_mode'})
309 && $options->{'cache_mode'} eq "without_result") {
310 $result = "";
311 }
312 else {
313 # Read in the cached result lines and join them into a single string
314 my $result_filename = "$ofilename.result";
315 if (open(RESIN, "<$result_filename"))
316 {
317 my @result_lines = <RESIN>;
318 $result = join("\n", @result_lines);
319 close(RESIN);
320 }
321 else
322 {
323 print $outhandle " $message_prefix: Error, failed to obtain cached result from $result_filename.\n";
324 }
325 }
326 }
327
328 }
329 }
330 else {
331 print $outhandle " $message_prefix: No cached previous args found. Regenerating $ofilename\n";
332
333 ($regenerated,$result,$had_error)
334 = regenerate_general_cmd($command,$ifilename,$ofilename,$options);
335 }
336 }
337
338 return ($regenerated,$result,$had_error);
339}
340
341
3421;
Note: See TracBrowser for help on using the repository browser.