1: 2eval 'exec perl -wS $0 ${1+"$@"}' 3 if 0; 4#************************************************************** 5# 6# Licensed to the Apache Software Foundation (ASF) under one 7# or more contributor license agreements. See the NOTICE file 8# distributed with this work for additional information 9# regarding copyright ownership. The ASF licenses this file 10# to you under the Apache License, Version 2.0 (the 11# "License"); you may not use this file except in compliance 12# with the License. You may obtain a copy of the License at 13# 14# http://www.apache.org/licenses/LICENSE-2.0 15# 16# Unless required by applicable law or agreed to in writing, 17# software distributed under the License is distributed on an 18# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 19# KIND, either express or implied. See the License for the 20# specific language governing permissions and limitations 21# under the License. 22# 23#************************************************************** 24 25 26 27# 28# packimages.pl - pack images into archives 29# 30 31use strict; 32use Getopt::Long; 33use File::Find; 34use File::Basename; 35use Archive::Zip qw(:ERROR_CODES :CONSTANTS); 36 37#### globals #### 38 39my $img_global = '%GLOBALRES%'; # 'global' image prefix 40my $img_module = '%MODULE%'; # 'module' image prefix 41 42my $out_file; # path to output archive 43my $tmp_out_file; # path to temporary output file 44my $global_path; # path to global images directory 45my $module_path; # path to module images directory 46my $sort_file; # path to file containing sorting data 47my @custom_path; # path to custom images directory 48my @imagelist_path; # pathes to directories containing the image lists 49my $verbose; # be verbose 50my $extra_verbose; # be extra verbose 51my $do_rebuild = 0; # is rebuilding zipfile required? 52 53my @custom_list; 54#### script id ##### 55 56( my $script_name = $0 ) =~ s/^.*\b(\w+)\.pl$/$1/; 57 58my $script_rev; 59my $id_str = ' $Revision: 1.17 $ '; 60$id_str =~ /Revision:\s+(\S+)\s+\$/ 61 ? ($script_rev = $1) : ($script_rev = "-"); 62 63print "$script_name -- version: $script_rev\n"; 64 65#### main ##### 66 67parse_options(); 68my $image_lists_ref = get_image_lists(); 69my %image_lists_hash; 70foreach ( @{$image_lists_ref} ) { 71 $image_lists_hash{$_}=""; 72} 73$do_rebuild = is_file_newer(\%image_lists_hash) if $do_rebuild == 0; 74my ($global_hash_ref, $module_hash_ref, $custom_hash_ref) = iterate_image_lists($image_lists_ref); 75# custom_hash filled from filesystem lookup 76find_custom($custom_hash_ref); 77my $zip_hash_ref = create_zip_list($global_hash_ref, $module_hash_ref, $custom_hash_ref); 78$do_rebuild = is_file_newer($zip_hash_ref) if $do_rebuild == 0; 79if ( $do_rebuild == 1 ) { 80 create_zip_archive($zip_hash_ref); 81 replace_file($tmp_out_file, $out_file); 82 print_message("packing $out_file finished."); 83} else { 84 print_message("$out_file up to date. nothing to do."); 85} 86 87exit(0); 88 89#### subroutines #### 90 91sub parse_options 92{ 93 my $opt_help; 94 my $p = Getopt::Long::Parser->new(); 95 my @custom_path_list; 96 my $custom_path_extended; 97 my $success =$p->getoptions( 98 '-h' => \$opt_help, 99 '-o=s' => \$out_file, 100 '-g=s' => \$global_path, 101 '-s=s' => \$sort_file, 102 '-m=s' => \$module_path, 103 '-c=s' => \@custom_path_list, 104 '-e=s' => \$custom_path_extended, 105 '-l=s' => \@imagelist_path, 106 '-v' => \$verbose, 107 '-vv' => \$extra_verbose 108 ); 109 push @custom_path_list, $custom_path_extended if ($custom_path_extended); 110 if ( $opt_help || !$success || !$out_file || !$global_path 111 || !$module_path || !@custom_path_list || !@imagelist_path ) 112 { 113 usage(); 114 exit(1); 115 } 116 #define intermediate output file 117 $tmp_out_file="$out_file"."$$".$ENV{INPATH}; 118 # Sanity checks. 119 120 # Check if out_file can be written. 121 my $out_dir = dirname($out_file); 122 123 # Check paths. 124 foreach ($out_dir, $global_path, $module_path, @imagelist_path) { 125 print_error("no such directory: '$_'", 2) if ! -d $_; 126 print_error("can't search directory: '$_'", 2) if ! -x $_; 127 } 128 print_error("directory is not writable: '$out_dir'", 2) if ! -w $out_dir; 129 130 # Use just the working paths 131 @custom_path = (); 132 foreach (@custom_path_list) { 133 if ( ! -d $_ ) { 134 print_warning("skipping non-existing directory: '$_'", 2); 135 } 136 elsif ( ! -x $_ ) { 137 print_error("can't search directory: '$_'", 2); 138 } 139 else { 140 push @custom_path, $_; 141 } 142 } 143} 144 145sub get_image_lists 146{ 147 my @image_lists; 148 my $glob_imagelist_path; 149 150 foreach ( @imagelist_path ) { 151 $glob_imagelist_path = $_; 152 # cygwin perl 153 chomp( $glob_imagelist_path = qx{cygpath -u "$glob_imagelist_path"} ) if "$^O" eq "cygwin"; 154 push @image_lists, glob("$glob_imagelist_path/*.ilst"); 155 } 156 if ( !@image_lists ) { 157 print_error("can't find any image lists in '@imagelist_path'", 3); 158 } 159 160 return wantarray ? @image_lists : \@image_lists; 161} 162 163sub iterate_image_lists 164{ 165 my $image_lists_ref = shift; 166 167 my %global_hash; 168 my %module_hash; 169 my %custom_hash; 170 171 foreach my $i ( @{$image_lists_ref} ) { 172 parse_image_list($i, \%global_hash, \%module_hash, \%custom_hash); 173 } 174 175 return (\%global_hash, \%module_hash, \%custom_hash); 176} 177 178sub parse_image_list 179{ 180 my $image_list = shift; 181 my $global_hash_ref = shift; 182 my $module_hash_ref = shift; 183 my $custom_hash_ref = shift; 184 185 print_message("parsing '$image_list' ...") if $verbose; 186 my $linecount = 0; 187 open(IMAGE_LIST, "< $image_list") or die "ERROR: can't open $image_list: $!"; 188 while ( <IMAGE_LIST> ) { 189 $linecount++; 190 next if /^\s*#/; 191 next if /^\s*$/; 192 # clean up trailing whitespace 193 tr/\r\n//d; 194 s/\s+$//; 195 # clean up backslashes and double slashes 196 tr{\\}{/}s; 197 tr{/}{}s; 198 # hack "res" back into globals 199 if ( /^\Q$img_global\E\/(.*)$/o ) { 200 $global_hash_ref->{"res/".$1}++; 201 next; 202 } 203 if ( /^\Q$img_module\E\/(.*)$/o ) { 204 $module_hash_ref->{$1}++; 205 next; 206 } 207 # parse failed if we reach this point, bail out 208 close(IMAGE_LIST); 209 print_error("can't parse line $linecount from file '$image_list'", 4); 210 } 211 close(IMAGE_LIST); 212 213 return ($global_hash_ref, $module_hash_ref, $custom_hash_ref); 214} 215 216sub find_custom 217{ 218 my $custom_hash_ref = shift; 219 my $keep_back; 220 for my $path (@custom_path) { 221 find({ wanted => \&wanted, no_chdir => 0 }, $path); 222 foreach ( @custom_list ) { 223 if ( /^\Q$path\E\/(.*)$/ ) { 224 $keep_back=$1; 225 if (!defined $custom_hash_ref->{$keep_back}) { 226 $custom_hash_ref->{$keep_back} = $path; 227 } 228 } 229 } 230 } 231} 232 233sub wanted 234{ 235 my $file = $_; 236 237 if ( $file =~ /.*\.png$/ && -f $file ) { 238 push @custom_list, $File::Find::name; 239 } 240} 241 242sub create_zip_list 243{ 244 my $global_hash_ref = shift; 245 my $module_hash_ref = shift; 246 my $custom_hash_ref = shift; 247 248 my %zip_hash; 249 my @warn_list; 250 251 print_message("assemble image list ...") if $verbose; 252 foreach ( keys %{$global_hash_ref} ) { 253 # check if in 'global' and in 'module' list and add to warn list 254 if ( exists $module_hash_ref->{$_} ) { 255 push(@warn_list, $_); 256 next; 257 } 258 if ( exists $custom_hash_ref->{$_} ) { 259 $zip_hash{$_} = $custom_hash_ref->{$_}; 260 next; 261 } 262 # it's neither in 'module' nor 'custom', record it in zip hash 263 $zip_hash{$_} = $global_path; 264 } 265 foreach ( keys %{$module_hash_ref} ) { 266 if ( exists $custom_hash_ref->{$_} ) { 267 $zip_hash{$_} = $custom_hash_ref->{$_}; 268 next; 269 } 270 # it's not in 'custom', record it in zip hash 271 $zip_hash{$_} = $module_path; 272 } 273 274 if ( @warn_list ) { 275 foreach ( @warn_list ) { 276 print_warning("$_ is duplicated in 'global' and 'module' list"); 277 } 278 } 279 280 return \%zip_hash 281} 282 283sub is_file_newer 284{ 285 my $test_hash_ref = shift; 286 my $reference_stamp = 0; 287 288 print_message("checking timestamps ...") if $verbose; 289 if ( -e $out_file ) { 290 $reference_stamp = (stat($out_file))[9]; 291 print_message("found $out_file with $reference_stamp ...") if $verbose; 292 } 293 return 1 if $reference_stamp == 0; 294 295 foreach ( sort keys %{$test_hash_ref} ) { 296 my $path = $test_hash_ref->{$_}; 297 $path .= "/" if "$path" ne ""; 298 $path .= "$_"; 299 print_message("checking '$path' ...") if $extra_verbose; 300 my $mtime = (stat($path))[9]; 301 return 1 if $reference_stamp < $mtime; 302 } 303 return 0; 304} 305 306sub optimize_zip_layout($) 307{ 308 my $zip_hash_ref = shift; 309 310 if (!defined $sort_file) { 311 print_message("no sort file - sorting alphabetically ...") if $verbose; 312 return sort keys %{$zip_hash_ref}; 313 } 314 print_message("sorting from $sort_file ...") if $verbose; 315 316 my $orderh; 317 my %included; 318 my @sorted; 319 open ($orderh, $sort_file) || die "Can't open $sort_file: $!"; 320 while (<$orderh>) { 321 /^\#.*/ && next; # comments 322 s/[\r\n]*$//; 323 /^\s*$/ && next; 324 my $file = $_; 325 if (!defined $zip_hash_ref->{$file}) { 326 print "unknown file '$file'\n" if ($extra_verbose); 327 } else { 328 push @sorted, $file; 329 $included{$file} = 1; 330 } 331 } 332 close ($orderh); 333 334 for my $img (sort keys %{$zip_hash_ref}) { 335 push @sorted, $img if (!$included{$img}); 336 } 337 338 print_message("done sort ...") if $verbose; 339 340 return @sorted; 341} 342 343sub create_zip_archive 344{ 345 my $zip_hash_ref = shift; 346 347 print_message("creating image archive ...") if $verbose; 348 my $zip = Archive::Zip->new(); 349 350# FIXME: test - $member = addfile ... $member->desiredCompressionMethod( COMPRESSION_STORED ); 351# any measurable performance win/loss ? 352 foreach ( optimize_zip_layout($zip_hash_ref) ) { 353 my $path = $zip_hash_ref->{$_} . "/$_"; 354 print_message("zipping '$path' ...") if $extra_verbose; 355 my $member = $zip->addFile($path, $_); 356 if ( !$member ) { 357 print_error("can't add file '$path' to image zip archive: $!", 5); 358 } 359 } 360 my $status = $zip->writeToFileNamed($tmp_out_file); 361 if ( $status != AZ_OK ) { 362 print_error("write image zip archive '$tmp_out_file' failed. Reason: $status", 6); 363 } 364 return; 365} 366 367sub replace_file 368{ 369 my $source_file = shift; 370 my $dest_file = shift; 371 my $result = 0; 372 373 $result = unlink($dest_file) if -f $dest_file; 374 if ( $result != 1 && -f $dest_file ) { 375 unlink $source_file; 376 print_error("couldn't remove '$dest_file'",1); 377 } else { 378 if ( !rename($source_file, $dest_file)) { 379 unlink $source_file; 380 print_error("couldn't rename '$source_file'",1); 381 } 382 } 383 return; 384} 385 386sub usage 387{ 388 print STDERR "Usage: packimages.pl [-h] -o out_file -g g_path -m m_path -c c_path -l imagelist_path\n"; 389 print STDERR "Creates archive of images\n"; 390 print STDERR "Options:\n"; 391 print STDERR " -h print this help\n"; 392 print STDERR " -o out_file path to output archive\n"; 393 print STDERR " -g g_path path to global images directory\n"; 394 print STDERR " -m m_path path to module images directory\n"; 395 print STDERR " -c c_path path to custom images directory\n"; 396 print STDERR " -s sort_file path to image sort order file\n"; 397 print STDERR " -l imagelist_path path to directory containing image lists (may appear mutiple times)\n"; 398 print STDERR " -v verbose\n"; 399 print STDERR " -vv very verbose\n"; 400} 401 402sub print_message 403{ 404 my $message = shift; 405 406 print "$script_name: "; 407 print "$message\n"; 408 return; 409} 410 411sub print_warning 412{ 413 my $message = shift; 414 415 print STDERR "$script_name: "; 416 print STDERR "WARNING $message\n"; 417 return; 418} 419 420sub print_error 421{ 422 my $message = shift; 423 my $error_code = shift; 424 425 print STDERR "$script_name: "; 426 print STDERR "ERROR: $message\n"; 427 428 if ( $error_code ) { 429 print STDERR "\nFAILURE: $script_name aborted.\n"; 430 exit($error_code); 431 } 432 return; 433} 434