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

Revision 22469, 8.5 KB (checked in by davidb, 10 years ago)

Debugging statement had been left in. Now commented out

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.