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

Last change on this file since 24601 was 24601, checked in by ak19, 9 years ago

Dr Bainbridge suggested corrections to commits of revision 24600: 1. gs-magick.pl: close call on Pipe only if successfully opened. 2. Command_status always needs to be shifted and turned into its signed value for display in convertutil.pm. 3. giget calls to imagemagick more eficient: doesn't call identify twice, but just once since the exit code and output to STDOUT can both be inspected after just one call. Moreover, exit code needed to be tested for equality against 0, not whether it is greater than 0, so no shifting and converting to signed value required.

File size: 8.9 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 # for commands that go via an intermediate layer (like commands to imagemagick go
179 # through gs-magick.pl), need to shift exit code by 8 and then convert to its
180 # signed value to get the actual exit code that imagemagick had emitted.
181 $command_status >>= 8;
182 $command_status = (($command_status & 0x80) ? -(0x100 - ($command_status & 0xFF)) : $command_status);
183
184 print $outhandle "Error: processing command failed. Exit status $command_status\n";
185
186 if ($verbosity >= 3) {
187 print $outhandle " Command was: $command\n";
188 }
189 if ($verbosity >= 4) {
190 print $outhandle "$message_prefix result: $result\n";
191 }
192 }
193 }
194 else
195 {
196 $had_error = 1;
197 print STDERR "Error: failed to execute $command\n";
198 }
199
200 &$monitor_deinit($saved_rec);
201
202 if ($verbosity >= 1) {
203 if ($had_error) {
204 print $outhandle " ...error encounterd\n";
205 }
206 else {
207 print $outhandle " ...done\n";
208 }
209 }
210
211 if (defined $command_status && ($command_status == 0))
212 {
213 # only want to print the following out if verbosity is high enough
214 # and we haven't already printed it out as a detected error above
215 print $outhandle "$message_prefix result: $result\n" if ($verbosity > 5);
216 }
217
218 return ($result,$had_error);
219}
220
221
222sub regenerate_general_cmd
223{
224 my ($command,$ifilename,$ofilename,$options) = @_;
225
226 my $regenerated = 1;
227 my $result = "";
228 my $had_error = 0;
229
230 ($result,$had_error) = run_general_cmd($command,$options);
231
232 # store command args so can be compared with subsequent runs of the command
233 my $args_filename = "$ofilename.args";
234
235 if (open(ARGSOUT,">$args_filename")) {
236 print ARGSOUT $command;
237 print ARGSOUT "\n";
238 close(ARGSOUT);
239 }
240 else {
241 my $outhandle = $options->{'outhandle'};
242 print $outhandle "Warning: Unable to write out caching information to file $args_filename\n";
243 print $outhandle " This means $ofilename will be regenerated on next build whether\n";
244 print $outhandle " processing args have changed or not.\n";
245 }
246
247 # Store the result, since ImageConverter.pm extracts the image height and width from the processed result
248 my $result_filename = "$ofilename.result";
249 if (open(RESOUT, ">$result_filename"))
250 {
251 print RESOUT $result;
252 close(RESOUT);
253 }
254 else
255 {
256 my $outhandle = $options->{'outhandle'};
257 print $outhandle "Warning: Unable to write out cached process result to file $result_filename.\n";
258 }
259
260 return ($regenerated,$result,$had_error);
261}
262
263
264
265sub run_cached_general_cmd
266{
267 my ($command,$ifilename,$ofilename,$options) = @_;
268
269 my $outhandle = $options->{'outhandle'};
270 my $verbosity = $options->{'verbosity'};
271 my $message_prefix = $options->{'message_prefix'};
272
273 my $regenerated = 0;
274 my $result = "";
275 my $had_error = 0;
276
277 my $args_filename = "$ofilename.args";
278
279 if ((!-e $ofilename) || (!-e $args_filename)) {
280 ($regenerated,$result,$had_error)
281 = regenerate_general_cmd($command,$ifilename,$ofilename,$options);
282 }
283 elsif (-M $ifilename < -M $args_filename) {
284 # Source files has been updated/changed in some way
285 # => regenerate
286 print $outhandle "$ifilename modified more recently than cached version\n";
287
288 ($regenerated,$result,$had_error)
289 = regenerate_general_cmd($command,$ifilename,$ofilename,$options);
290 }
291 else {
292 # file exists => check to see if command to generate it has changed
293
294 if (open (ARGSIN,"<$args_filename")) {
295 my $prev_command = <ARGSIN>;
296 chomp($prev_command);
297
298 close(ARGSIN);
299
300 if (defined $prev_command) {
301 # if commands are different
302 if ($prev_command ne $command) {
303 # need to rerun command
304 ($regenerated,$result,$had_error)
305 = regenerate_general_cmd($command,$ifilename,$ofilename,$options);
306 }
307 else {
308 my ($ofile) = ($ofilename =~ m/^.*(cached.*)$/);
309
310 my $ofile_no_dir = basename($ofile);
311 print $outhandle " $message_prefix: Cached file $ofile_no_dir already exists.\n";
312 print $outhandle " $message_prefix: No need to regenerate $ofile\n" if ($verbosity > 2);
313
314 if ((defined $options->{'cache_mode'})
315 && $options->{'cache_mode'} eq "without_result") {
316 $result = "";
317 }
318 else {
319 # Read in the cached result lines and join them into a single string
320 my $result_filename = "$ofilename.result";
321 if (open(RESIN, "<$result_filename"))
322 {
323 my @result_lines = <RESIN>;
324 $result = join("\n", @result_lines);
325 close(RESIN);
326 }
327 else
328 {
329 print $outhandle " $message_prefix: Error, failed to obtain cached result from $result_filename.\n";
330 }
331 }
332 }
333
334 }
335 }
336 else {
337 print $outhandle " $message_prefix: No cached previous args found. Regenerating $ofilename\n";
338
339 ($regenerated,$result,$had_error)
340 = regenerate_general_cmd($command,$ifilename,$ofilename,$options);
341 }
342 }
343
344 return ($regenerated,$result,$had_error);
345}
346
347
3481;
Note: See TracBrowser for help on using the repository browser.