root/gsdl/trunk/perllib/convertutil.pm @ 16841

Revision 16841, 7.1 KB (checked in by davidb, 11 years ago)

Supporting classes for conversion

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    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    print $outhandle "$message_prefix: $command\n" if ($verbosity > 3);
122    print $outhandle "  $message ..." if ($verbosity >= 1);
123
124    my $command_status = undef;
125    my $result = "";
126    my $had_error = 0;
127
128    my $saved_rec = &$monitor_init();
129
130    if (open(CMD,"$command 2>&1 |"))
131    {
132    my $line;
133
134    my $linecount = 0;
135    my $dot_count = 0;
136
137
138    while (defined ($line = <CMD>))
139    {
140        $linecount++;
141
142        my ($had_local_error,$generate_dot) = &$monitor_line($line);
143       
144        if ($had_local_error) {
145        # set general flag, but allow loop to continue to end building up the $result line
146        print $outhandle "$line\n";
147        $had_error = 1;
148        }
149
150        if ($generate_dot)
151        {
152        if ($dot_count == 0) { print $outhandle "\n  "; }
153        print $outhandle ".";
154        $dot_count++;
155
156        if (($dot_count%76)==0)
157        {
158            print $outhandle "\n  ";
159        }
160        }
161   
162        $result .= $line;
163       
164    }
165    print $outhandle "\n";
166
167   
168    close(CMD);
169
170    $command_status = $?;
171    if ($command_status != 0) {
172        $had_error = 1;
173
174        print $outhandle "Error: processing command failed.  Exit status $?\n";
175
176        if ($verbosity >= 3) {
177        print $outhandle "  Command was: $command\n";
178        }
179        if ($verbosity >= 4) {
180        print $outhandle "$message_prefix result: $result\n";
181        }
182    }
183    }
184    else
185    {
186    $had_error = 1;
187    print STDERR "Error: failed to execute $command\n";
188    }
189
190    &$monitor_deinit($saved_rec);
191
192    if ($verbosity >= 1) {
193    if ($had_error) {
194        print $outhandle "  ...error encounterd\n";
195    }
196    else {
197        print $outhandle "  ...done\n";
198    }
199    }
200
201    if (defined $command_status && ($command_status == 0))
202    {
203    # only want to print the following out if verbosity is high enough
204    # and we haven't already printed it out as a detected error above
205    print $outhandle "$message_prefix result: $result\n" if ($verbosity > 5);
206    }
207
208    return ($result,$had_error);
209}
210
211
212sub regenerate_general_cmd
213{
214    my ($command,$ofilename,$options) = @_;
215
216    my $regenerated = 1;
217    my $result = "";
218    my $had_error = 0;
219
220    ($result,$had_error) = run_general_cmd($command,$options);
221
222    # store command args so can be compared with subsequent runs of the command
223    my $args_filename = "$ofilename.args";
224
225    if (open(ARGSOUT,">$args_filename")) {
226    print ARGSOUT $command;
227    print ARGSOUT "\n";
228    close(ARGSOUT);
229    }
230    else {
231    my $outhandle = $options->{'outhandle'};
232    print $outhandle "Warning: Unable to write out caching information to file $args_filename\n";
233    print $outhandle "         This means $ofilename will be regenerated on next build whether\n";
234    print $outhandle "         processing args have changed or not.\n";
235    }
236
237    return ($regenerated,$result,$had_error);
238}
239
240
241
242sub run_cached_general_cmd
243{
244    my ($command,$ofilename,$options) = @_;
245
246    my $regenerated = 0;
247    my $result = "";
248    my $had_error = 0;
249
250    if (!-e $ofilename) {
251    ($regenerated,$result,$had_error)
252        = regenerate_general_cmd($command,$ofilename,$options);
253    }
254    else {
255    # file exists => check to see if command to generate it has changed
256    my $args_filename = "$ofilename.args";
257    if (open (ARGSIN,"<$args_filename")) {
258        my $prev_command = <ARGSIN>;
259        chomp($prev_command);
260
261        close(ARGSIN);
262
263        if (defined $prev_command) {
264        # if commands are different
265        if ($prev_command ne $command) {
266            # need to rerun command
267            ($regenerated,$result,$had_error)
268            = regenerate_general_cmd($command,$ofilename,$options);
269        }
270        else {
271            my $outhandle = $options->{'outhandle'};
272            my $verbosity = $options->{'verbosity'};
273
274            my $message_prefix = $options->{'message_prefix'};
275
276            my ($ofile) = ($ofilename =~ m/^.*(cached.*)$/);
277
278            my $ofile_no_dir = basename($ofile);
279            print $outhandle "  $message_prefix: Cached file $ofile_no_dir already exists.\n";
280            print $outhandle "  $message_prefix: No need to regenerate $ofile\n" if ($verbosity > 2);
281        }
282           
283        }
284    }
285    else {
286        my $outhandle = $options->{'outhandle'};
287        my $message_prefix = $options->{'message_prefix'};
288       
289        print $outhandle "  $message_prefix: No cached previous args found.  Regenerating $ofilename\n";
290
291        ($regenerated,$result,$had_error) = regenerate_general_cmd($command,$ofilename,$options);
292    }
293    }
294
295    return ($regenerated,$result,$had_error);
296}
297
298
2991;
Note: See TracBrowser for help on using the browser.