root/main/trunk/greenstone2/perllib/convertutil.pm @ 22350

Revision 22350, 8.2 KB (checked in by davidb, 10 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.

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 browser.