| 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 |
|
|---|
| 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 | # for commands that go via an intermediate layer (like commands to imagemagick go
|
|---|
| 179 | # through gs-magick.pl), need to shift exit code by 8 and then convert to its
|
|---|
| 180 | # signed value to get the actual exit code that imagemagick had emitted.
|
|---|
| 181 | $command_status >>= 8;
|
|---|
| 182 | $command_status = (($command_status & 0x80) ? -(0x100 - ($command_status & 0xFF)) : $command_status);
|
|---|
| 183 |
|
|---|
| 184 | print $outhandle "Error: processing command failed. Exit status $command_status\n";
|
|---|
| 185 |
|
|---|
| 186 | if ($verbosity >= 3) {
|
|---|
| 187 | print $outhandle " Command was: $command\n";
|
|---|
| 188 | }
|
|---|
| 189 | if ($verbosity >= 4) {
|
|---|
| 190 | print $outhandle "$message_prefix result: $result\n";
|
|---|
| 191 | }
|
|---|
| 192 | }
|
|---|
| 193 | }
|
|---|
| 194 | else
|
|---|
| 195 | {
|
|---|
| 196 | $had_error = 1;
|
|---|
| 197 | print STDERR "Error: failed to execute $command\n";
|
|---|
| 198 | }
|
|---|
| 199 |
|
|---|
| 200 | &$monitor_deinit($saved_rec);
|
|---|
| 201 |
|
|---|
| 202 | if ($verbosity >= 1) {
|
|---|
| 203 | if ($had_error) {
|
|---|
| 204 | print $outhandle " ...error encountered\n";
|
|---|
| 205 | }
|
|---|
| 206 | else {
|
|---|
| 207 | print $outhandle " ...done\n";
|
|---|
| 208 | }
|
|---|
| 209 | }
|
|---|
| 210 |
|
|---|
| 211 | if (defined $command_status && ($command_status == 0))
|
|---|
| 212 | {
|
|---|
| 213 | # only want to print the following out if verbosity is high enough
|
|---|
| 214 | # and we haven't already printed it out as a detected error above
|
|---|
| 215 | print $outhandle "$message_prefix result: $result\n" if ($verbosity > 5);
|
|---|
| 216 | }
|
|---|
| 217 |
|
|---|
| 218 | return ($result,$had_error);
|
|---|
| 219 | }
|
|---|
| 220 |
|
|---|
| 221 |
|
|---|
| 222 | sub regenerate_general_cmd
|
|---|
| 223 | {
|
|---|
| 224 | my ($command,$ifilename,$ofilename,$options) = @_;
|
|---|
| 225 |
|
|---|
| 226 | my $regenerated = 1;
|
|---|
| 227 | my $result = "";
|
|---|
| 228 | my $had_error = 0;
|
|---|
| 229 |
|
|---|
| 230 | ($result,$had_error) = run_general_cmd($command,$options);
|
|---|
| 231 |
|
|---|
| 232 | # store command args so can be compared with subsequent runs of the command
|
|---|
| 233 | my $args_filename = "$ofilename.args";
|
|---|
| 234 |
|
|---|
| 235 | if (open(ARGSOUT,">$args_filename")) {
|
|---|
| 236 | print ARGSOUT $command;
|
|---|
| 237 | print ARGSOUT "\n";
|
|---|
| 238 | close(ARGSOUT);
|
|---|
| 239 | }
|
|---|
| 240 | else {
|
|---|
| 241 | my $outhandle = $options->{'outhandle'};
|
|---|
| 242 | print $outhandle "Warning: Unable to write out caching information to file $args_filename\n";
|
|---|
| 243 | print $outhandle " This means $ofilename will be regenerated on next build whether\n";
|
|---|
| 244 | print $outhandle " processing args have changed or not.\n";
|
|---|
| 245 | }
|
|---|
| 246 |
|
|---|
| 247 | # Store the result, since ImageConverter.pm extracts the image height and width from the processed result
|
|---|
| 248 | my $result_filename = "$ofilename.result";
|
|---|
| 249 | if (open(RESOUT, ">$result_filename"))
|
|---|
| 250 | {
|
|---|
| 251 | print RESOUT $result;
|
|---|
| 252 | close(RESOUT);
|
|---|
| 253 | }
|
|---|
| 254 | else
|
|---|
| 255 | {
|
|---|
| 256 | my $outhandle = $options->{'outhandle'};
|
|---|
| 257 | print $outhandle "Warning: Unable to write out cached process result to file $result_filename.\n";
|
|---|
| 258 | }
|
|---|
| 259 |
|
|---|
| 260 | return ($regenerated,$result,$had_error);
|
|---|
| 261 | }
|
|---|
| 262 |
|
|---|
| 263 |
|
|---|
| 264 |
|
|---|
| 265 | sub run_cached_general_cmd
|
|---|
| 266 | {
|
|---|
| 267 | my ($command,$ifilename,$ofilename,$options) = @_;
|
|---|
| 268 |
|
|---|
| 269 | my $outhandle = $options->{'outhandle'};
|
|---|
| 270 | my $verbosity = $options->{'verbosity'};
|
|---|
| 271 | my $message_prefix = $options->{'message_prefix'};
|
|---|
| 272 |
|
|---|
| 273 | my $regenerated = 0;
|
|---|
| 274 | my $result = "";
|
|---|
| 275 | my $had_error = 0;
|
|---|
| 276 |
|
|---|
| 277 | my $args_filename = "$ofilename.args";
|
|---|
| 278 |
|
|---|
| 279 | if ((!-e $ofilename) || (!-e $args_filename)) {
|
|---|
| 280 | ($regenerated,$result,$had_error)
|
|---|
| 281 | = regenerate_general_cmd($command,$ifilename,$ofilename,$options);
|
|---|
| 282 | }
|
|---|
| 283 | elsif (-M $ifilename < -M $args_filename) {
|
|---|
| 284 | # Source files has been updated/changed in some way
|
|---|
| 285 | # => regenerate
|
|---|
| 286 | print $outhandle "$ifilename modified more recently than cached version\n";
|
|---|
| 287 |
|
|---|
| 288 | ($regenerated,$result,$had_error)
|
|---|
| 289 | = regenerate_general_cmd($command,$ifilename,$ofilename,$options);
|
|---|
| 290 | }
|
|---|
| 291 | else {
|
|---|
| 292 | # file exists => check to see if command to generate it has changed
|
|---|
| 293 |
|
|---|
| 294 | if (open (ARGSIN,"<$args_filename")) {
|
|---|
| 295 | my $prev_command = <ARGSIN>;
|
|---|
| 296 | chomp($prev_command);
|
|---|
| 297 |
|
|---|
| 298 | close(ARGSIN);
|
|---|
| 299 |
|
|---|
| 300 | if (defined $prev_command) {
|
|---|
| 301 | # if commands are different
|
|---|
| 302 | if ($prev_command ne $command) {
|
|---|
| 303 | # need to rerun command
|
|---|
| 304 | ($regenerated,$result,$had_error)
|
|---|
| 305 | = regenerate_general_cmd($command,$ifilename,$ofilename,$options);
|
|---|
| 306 | }
|
|---|
| 307 | else {
|
|---|
| 308 | my ($ofile) = ($ofilename =~ m/^.*(cached.*)$/);
|
|---|
| 309 |
|
|---|
| 310 | my $ofile_no_dir = basename($ofile);
|
|---|
| 311 | print $outhandle " $message_prefix: Cached file $ofile_no_dir already exists.\n";
|
|---|
| 312 | print $outhandle " $message_prefix: No need to regenerate $ofile\n" if ($verbosity > 2);
|
|---|
| 313 |
|
|---|
| 314 | if ((defined $options->{'cache_mode'})
|
|---|
| 315 | && $options->{'cache_mode'} eq "without_result") {
|
|---|
| 316 | $result = "";
|
|---|
| 317 | }
|
|---|
| 318 | else {
|
|---|
| 319 | # Read in the cached result lines and join them into a single string
|
|---|
| 320 | my $result_filename = "$ofilename.result";
|
|---|
| 321 | if (open(RESIN, "<$result_filename"))
|
|---|
| 322 | {
|
|---|
| 323 | my @result_lines = <RESIN>;
|
|---|
| 324 | $result = join("\n", @result_lines);
|
|---|
| 325 | close(RESIN);
|
|---|
| 326 | }
|
|---|
| 327 | else
|
|---|
| 328 | {
|
|---|
| 329 | print $outhandle " $message_prefix: Error, failed to obtain cached result from $result_filename.\n";
|
|---|
| 330 | }
|
|---|
| 331 | }
|
|---|
| 332 | }
|
|---|
| 333 |
|
|---|
| 334 | }
|
|---|
| 335 | }
|
|---|
| 336 | else {
|
|---|
| 337 | print $outhandle " $message_prefix: No cached previous args found. Regenerating $ofilename\n";
|
|---|
| 338 |
|
|---|
| 339 | ($regenerated,$result,$had_error)
|
|---|
| 340 | = regenerate_general_cmd($command,$ifilename,$ofilename,$options);
|
|---|
| 341 | }
|
|---|
| 342 | }
|
|---|
| 343 |
|
|---|
| 344 | return ($regenerated,$result,$had_error);
|
|---|
| 345 | }
|
|---|
| 346 |
|
|---|
| 347 |
|
|---|
| 348 | 1;
|
|---|
