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

Revision 22431, 8.5 KB (checked in by davidb, 10 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

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