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

Last change on this file since 30599 was 30599, checked in by ak19, 5 years ago

Minor spelling correction to convertutil.pm.

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 encountered\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.