[16841] | 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 |
|
---|
| 24 | package convertutil;
|
---|
| 25 |
|
---|
| 26 | use strict;
|
---|
| 27 | no strict 'refs'; # allow filehandles to be variables and viceversa
|
---|
| 28 |
|
---|
| 29 |
|
---|
| 30 | use File::Basename;
|
---|
| 31 |
|
---|
| 32 |
|
---|
| 33 | sub monitor_init
|
---|
| 34 | {
|
---|
| 35 | # do nothing
|
---|
| 36 | return {};
|
---|
| 37 | }
|
---|
| 38 |
|
---|
| 39 | sub monitor_deinit
|
---|
| 40 | {
|
---|
| 41 | my ($saved_rec) = @_;
|
---|
| 42 |
|
---|
| 43 | # nothing to do
|
---|
| 44 | }
|
---|
| 45 |
|
---|
| 46 | sub 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 |
|
---|
| 56 | sub 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 |
|
---|
| 65 | sub 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 |
|
---|
| 75 | sub 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 |
|
---|
| 86 | sub 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 |
|
---|
[18555] | 101 |
|
---|
[16841] | 102 | my $verbosity = $options->{'verbosity'};
|
---|
| 103 | my $outhandle = $options->{'outhandle'};
|
---|
| 104 |
|
---|
| 105 | my $message_prefix = $options->{'message_prefix'};
|
---|
| 106 | my $message = $options->{'message'};
|
---|
[20343] | 107 |
|
---|
[16841] | 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 |
|
---|
[22469] | 122 | # my ($cpackage,$cfilename,$cline,$csubr,$chas_args,$cwantarray) = caller(4);
|
---|
| 123 | # print STDERR "Calling method: $cfilename:$cline $cpackage->$csubr:$cline\n";
|
---|
[22431] | 124 |
|
---|
[16841] | 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 |
|
---|
[20343] | 154 |
|
---|
| 155 | if ($generate_dot)
|
---|
[16841] | 156 | {
|
---|
[20343] | 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 | }
|
---|
[16841] | 164 | }
|
---|
[20343] | 165 |
|
---|
[16841] | 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 |
|
---|
| 216 | sub regenerate_general_cmd
|
---|
| 217 | {
|
---|
[22431] | 218 | my ($command,$ifilename,$ofilename,$options) = @_;
|
---|
[16841] | 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 |
|
---|
[18474] | 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 |
|
---|
[16841] | 254 | return ($regenerated,$result,$had_error);
|
---|
| 255 | }
|
---|
| 256 |
|
---|
| 257 |
|
---|
| 258 |
|
---|
| 259 | sub run_cached_general_cmd
|
---|
| 260 | {
|
---|
[22431] | 261 | my ($command,$ifilename,$ofilename,$options) = @_;
|
---|
[16841] | 262 |
|
---|
[18555] | 263 | my $outhandle = $options->{'outhandle'};
|
---|
| 264 | my $verbosity = $options->{'verbosity'};
|
---|
| 265 | my $message_prefix = $options->{'message_prefix'};
|
---|
| 266 |
|
---|
[16841] | 267 | my $regenerated = 0;
|
---|
| 268 | my $result = "";
|
---|
| 269 | my $had_error = 0;
|
---|
| 270 |
|
---|
[18555] | 271 | my $args_filename = "$ofilename.args";
|
---|
| 272 |
|
---|
[20539] | 273 | if ((!-e $ofilename) || (!-e $args_filename)) {
|
---|
[16841] | 274 | ($regenerated,$result,$had_error)
|
---|
[22431] | 275 | = regenerate_general_cmd($command,$ifilename,$ofilename,$options);
|
---|
[16841] | 276 | }
|
---|
[22431] | 277 | elsif (-M $ifilename < -M $args_filename) {
|
---|
[18555] | 278 | # Source files has been updated/changed in some way
|
---|
| 279 | # => regenerate
|
---|
[22431] | 280 | print $outhandle "$ifilename modified more recently than cached version\n";
|
---|
[18555] | 281 |
|
---|
| 282 | ($regenerated,$result,$had_error)
|
---|
[22431] | 283 | = regenerate_general_cmd($command,$ifilename,$ofilename,$options);
|
---|
[18555] | 284 | }
|
---|
[16841] | 285 | else {
|
---|
| 286 | # file exists => check to see if command to generate it has changed
|
---|
[18555] | 287 |
|
---|
[16841] | 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)
|
---|
[22431] | 299 | = regenerate_general_cmd($command,$ifilename,$ofilename,$options);
|
---|
[16841] | 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);
|
---|
[20539] | 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 | }
|
---|
[16841] | 326 | }
|
---|
| 327 |
|
---|
| 328 | }
|
---|
| 329 | }
|
---|
| 330 | else {
|
---|
| 331 | print $outhandle " $message_prefix: No cached previous args found. Regenerating $ofilename\n";
|
---|
| 332 |
|
---|
[22431] | 333 | ($regenerated,$result,$had_error)
|
---|
| 334 | = regenerate_general_cmd($command,$ifilename,$ofilename,$options);
|
---|
[16841] | 335 | }
|
---|
| 336 | }
|
---|
| 337 |
|
---|
| 338 | return ($regenerated,$result,$had_error);
|
---|
| 339 | }
|
---|
| 340 |
|
---|
| 341 |
|
---|
| 342 | 1;
|
---|