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