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

Last change on this file was 38737, checked in by davidb, 2 months ago

updated comment
File size: 9.4 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 # $options points to a hashtable that must have fields for:
91 # 'verbosity', 'outhandle', 'message_prefix' and 'message'
92 #
93 # it can also include functions for monitoring
94 # 'monitor_init' => takes no input arguments and returns a hashtable for saved data values
95 # 'monitor_line' => takes $line as input argument, return tuple (had_error,generate_dot)
96 # 'monitor_deinit' => takes the saved data values as input, restores saved values
97 #
98 # Default are provided for these monitor functions if none specified
99
100
101 my $verbosity = $options->{'verbosity'};
102 my $outhandle = $options->{'outhandle'};
103
104 my $message_prefix = $options->{'message_prefix'};
105 my $message = $options->{'message'};
106
107 my $monitor_init = $options->{'monitor_init'};
108 my $monitor_line = $options->{'monitor_line'};
109 my $monitor_deinit = $options->{'monitor_deinit'};
110
111 if (!defined $monitor_init) {
112 $monitor_init = "monitor_init";
113 }
114 if (!defined $monitor_line) {
115 $monitor_line = "monitor_line";
116 }
117 if (!defined $monitor_deinit) {
118 $monitor_deinit = "monitor_deinit";
119 }
120
121# my ($cpackage,$cfilename,$cline,$csubr,$chas_args,$cwantarray) = caller(4);
122# print STDERR "Calling method: $cfilename:$cline $cpackage->$csubr:$cline\n";
123
124 print $outhandle "$message_prefix: $command\n" if ($verbosity > 3);
125 print $outhandle " $message ..." if ($verbosity >= 1);
126
127 my $command_status = undef;
128 my $result = "";
129 my $had_error = 0;
130
131 my $saved_rec = &$monitor_init();
132
133 if (open(CMD,"$command 2>&1 |"))
134 {
135 my $line;
136
137 my $linecount = 0;
138 my $dot_count = 0;
139
140
141 while (defined ($line = <CMD>))
142 {
143 $linecount++;
144
145 my ($had_local_error,$generate_dot) = &$monitor_line($line);
146
147 if ($had_local_error) {
148 # set general flag, but allow loop to continue to end building up the $result line
149 print $outhandle "$line\n";
150 $had_error = 1;
151 }
152
153
154 if ($generate_dot)
155 {
156 if ($dot_count == 0) { print $outhandle "\n "; }
157 print $outhandle ".";
158 $dot_count++;
159 if (($dot_count%76)==0)
160 {
161 print $outhandle "\n ";
162 }
163 }
164
165 $result .= $line;
166
167 }
168 print $outhandle "\n";
169
170
171 close(CMD);
172
173 $command_status = $?;
174 if ($command_status != 0) {
175 $had_error = 1;
176
177 # for commands that go via an intermediate layer (like commands to imagemagick go
178 # through gs-magick.pl), need to shift exit code by 8 and then convert to its
179 # signed value to get the actual exit code that imagemagick had emitted.
180 $command_status >>= 8;
181 $command_status = (($command_status & 0x80) ? -(0x100 - ($command_status & 0xFF)) : $command_status);
182
183 print $outhandle "Error: processing command failed. Exit status $command_status\n";
184
185 if ($verbosity >= 3) {
186 print $outhandle " Command was: $command\n";
187 }
188 if ($verbosity >= 4) {
189 print $outhandle "$message_prefix result: $result\n";
190 }
191 }
192 }
193 else
194 {
195 $had_error = 1;
196 print STDERR "Error: failed to execute $command\n";
197 }
198
199 &$monitor_deinit($saved_rec);
200
201 if ($verbosity >= 1) {
202 if ($had_error) {
203 print $outhandle " ...error encountered\n";
204 }
205 else {
206 print $outhandle " ...done\n";
207 }
208 }
209
210 if (defined $command_status && ($command_status == 0))
211 {
212 # only want to print the following out if verbosity is high enough
213 # and we haven't already printed it out as a detected error above
214 print $outhandle "$message_prefix result: $result\n" if ($verbosity > 5);
215 }
216
217 return ($result,$had_error);
218}
219
220
221sub regenerate_general_cmd
222{
223 my ($command,$ifilename,$ofilename,$options) = @_;
224
225 my $regenerated = 1;
226 my $result = "";
227 my $had_error = 0;
228
229 ($result,$had_error) = run_general_cmd($command,$options);
230
231 # store command args so can be compared with subsequent runs of the command
232 my $args_filename = "$ofilename.args";
233
234 if (open(ARGSOUT,">$args_filename")) {
235 # for portability between Greenstone installation, substitute gsdl environment variable in $command
236 my $gsdl3srchome = $ENV{'GSDL3SRCHOME'};
237 my $gsdl_substitute_command = $command;
238 $gsdl_substitute_command =~ s@$gsdl3srchome@\$GSDL3SRCHOME@g;
239
240 print ARGSOUT $gsdl_substitute_command;
241 print ARGSOUT "\n";
242 close(ARGSOUT);
243 }
244 else {
245 my $outhandle = $options->{'outhandle'};
246 print $outhandle "Warning: Unable to write out caching information to file $args_filename\n";
247 print $outhandle " This means $ofilename will be regenerated on next build whether\n";
248 print $outhandle " processing args have changed or not.\n";
249 }
250
251 # Store the result, since ImageConverter.pm extracts the image height and width from the processed result
252 my $result_filename = "$ofilename.result";
253 if (open(RESOUT, ">$result_filename"))
254 {
255 print RESOUT $result;
256 close(RESOUT);
257 }
258 else
259 {
260 my $outhandle = $options->{'outhandle'};
261 print $outhandle "Warning: Unable to write out cached process result to file $result_filename.\n";
262 }
263
264 return ($regenerated,$result,$had_error);
265}
266
267
268
269sub run_cached_general_cmd
270{
271 my ($command,$ifilename,$ofilename,$options) = @_;
272
273 my $outhandle = $options->{'outhandle'};
274 my $verbosity = $options->{'verbosity'};
275 my $message_prefix = $options->{'message_prefix'};
276
277 my $regenerated = 0;
278 my $result = "";
279 my $had_error = 0;
280
281 my $args_filename = "$ofilename.args";
282
283 if ((!-e $ofilename) || (!-e $args_filename)) {
284 ($regenerated,$result,$had_error)
285 = regenerate_general_cmd($command,$ifilename,$ofilename,$options);
286 }
287 elsif (-M $ifilename < -M $args_filename) {
288 # Source files has been updated/changed in some way
289 # => regenerate
290 print $outhandle "$ifilename modified more recently than cached version\n";
291
292 ($regenerated,$result,$had_error)
293 = regenerate_general_cmd($command,$ifilename,$ofilename,$options);
294 }
295 else {
296 # file exists => check to see if command to generate it has changed
297
298 if (open (ARGSIN,"<$args_filename")) {
299 my $prev_command = <ARGSIN>;
300 chomp($prev_command);
301
302 close(ARGSIN);
303
304 if (defined $prev_command) {
305 # work out if this new 'args commands' is different to prev_command
306
307 # but first apply the gsdl environment variable substitute, for portability
308 my $gsdl3srchome = $ENV{'GSDL3SRCHOME'};
309 my $gsdl_substitute_command = $command;
310 $gsdl_substitute_command =~ s@$gsdl3srchome@\$GSDL3SRCHOME@g;
311
312 if ($prev_command ne $gsdl_substitute_command) {
313 # need to rerun command
314 ($regenerated,$result,$had_error)
315 = regenerate_general_cmd($command,$ifilename,$ofilename,$options);
316 }
317 else {
318 my ($ofile) = ($ofilename =~ m/^.*(cached.*)$/);
319
320 my $ofile_no_dir = basename($ofile);
321 print $outhandle " $message_prefix: Cached file $ofile_no_dir already exists.\n";
322 print $outhandle " $message_prefix: No need to regenerate $ofile\n" if ($verbosity > 2);
323
324 if ((defined $options->{'cache_mode'})
325 && $options->{'cache_mode'} eq "without_result") {
326 $result = "";
327 }
328 else {
329 # Read in the cached result lines and join them into a single string
330 my $result_filename = "$ofilename.result";
331 if (open(RESIN, "<$result_filename"))
332 {
333 my @result_lines = <RESIN>;
334 $result = join("\n", @result_lines);
335 close(RESIN);
336 }
337 else
338 {
339 print $outhandle " $message_prefix: Error, failed to obtain cached result from $result_filename.\n";
340 }
341 }
342 }
343
344 }
345 }
346 else {
347 print $outhandle " $message_prefix: No cached previous args found. Regenerating $ofilename\n";
348
349 ($regenerated,$result,$had_error)
350 = regenerate_general_cmd($command,$ifilename,$ofilename,$options);
351 }
352 }
353
354 return ($regenerated,$result,$had_error);
355}
356
357
3581;
Note: See TracBrowser for help on using the repository browser.