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 117 # if extra-verbose, set also verbose 118 if ($extra_verbose) { $verbose = 1; } 119 120 #define intermediate output file 121 $tmp_out_file="$out_file"."$$".$ENV{INPATH}; 122 # Sanity checks. 123 124 # Check if out_file can be written. 125 my $out_dir = dirname($out_file); 126 127 # Check paths. 128 foreach ($out_dir, $global_path, $module_path, @imagelist_path) { 129 print_error("no such directory: '$_'", 2) if ! -d $_; 130 print_error("can't search directory: '$_'", 2) if ! -x $_; 131 } 132 print_error("directory is not writable: '$out_dir'", 2) if ! -w $out_dir; 133 134 # Use just the working paths 135 @custom_path = (); 136 foreach (@custom_path_list) { 137 if ( ! -d $_ ) { 138 print_warning("skipping non-existing directory: '$_'", 2); 139 } 140 elsif ( ! -x $_ ) { 141 print_error("can't search directory: '$_'", 2); 142 } 143 else { 144 push @custom_path, $_; 145 } 146 } 147} 148 149sub get_image_lists 150{ 151 my @image_lists; 152 my $glob_imagelist_path; 153 154 foreach ( @imagelist_path ) { 155 $glob_imagelist_path = $_; 156 # cygwin perl 157 chomp( $glob_imagelist_path = qx{cygpath -u "$glob_imagelist_path"} ) if "$^O" eq "cygwin"; 158 push @image_lists, glob("$glob_imagelist_path/*.ilst"); 159 } 160 if ( !@image_lists ) { 161 print_error("can't find any image lists in '@imagelist_path'", 3); 162 } 163 164 return wantarray ? @image_lists : \@image_lists; 165} 166 167sub iterate_image_lists 168{ 169 my $image_lists_ref = shift; 170 171 my %global_hash; 172 my %module_hash; 173 my %custom_hash; 174 175 foreach my $i ( @{$image_lists_ref} ) { 176 parse_image_list($i, \%global_hash, \%module_hash, \%custom_hash); 177 } 178 179 return (\%global_hash, \%module_hash, \%custom_hash); 180} 181 182sub parse_image_list 183{ 184 my $image_list = shift; 185 my $global_hash_ref = shift; 186 my $module_hash_ref = shift; 187 my $custom_hash_ref = shift; 188 189 print_message("parsing '$image_list' ...") if $verbose; 190 my $linecount = 0; 191 open(IMAGE_LIST, "< $image_list") or die "ERROR: can't open $image_list: $!"; 192 while ( <IMAGE_LIST> ) { 193 $linecount++; 194 next if /^\s*#/; 195 next if /^\s*$/; 196 # clean up trailing whitespace 197 tr/\r\n//d; 198 s/\s+$//; 199 # clean up backslashes and double slashes 200 tr{\\}{/}s; 201 tr{/}{}s; 202 # hack "res" back into globals 203 if ( /^\Q$img_global\E\/(.*)$/o ) { 204 $global_hash_ref->{"res/".$1}++; 205 next; 206 } 207 if ( /^\Q$img_module\E\/(.*)$/o ) { 208 $module_hash_ref->{$1}++; 209 next; 210 } 211 # parse failed if we reach this point, bail out 212 close(IMAGE_LIST); 213 print_error("can't parse line $linecount from file '$image_list'", 4); 214 } 215 close(IMAGE_LIST); 216 217 return ($global_hash_ref, $module_hash_ref, $custom_hash_ref); 218} 219 220sub find_custom 221{ 222 my $custom_hash_ref = shift; 223 my $keep_back; 224 for my $path (@custom_path) { 225 find({ wanted => \&wanted, no_chdir => 0 }, $path); 226 foreach ( @custom_list ) { 227 if ( /^\Q$path\E\/(.*)$/ ) { 228 $keep_back=$1; 229 if (!defined $custom_hash_ref->{$keep_back}) { 230 $custom_hash_ref->{$keep_back} = $path; 231 } 232 } 233 } 234 } 235} 236 237sub wanted 238{ 239 my $file = $_; 240 241 if ( $file =~ /.*\.png$/ && -f $file ) { 242 push @custom_list, $File::Find::name; 243 } 244} 245 246sub create_zip_list 247{ 248 my $global_hash_ref = shift; 249 my $module_hash_ref = shift; 250 my $custom_hash_ref = shift; 251 252 my %zip_hash; 253 my @warn_list; 254 255 print_message("assemble image list ...") if $verbose; 256 foreach ( keys %{$global_hash_ref} ) { 257 # check if in 'global' and in 'module' list and add to warn list 258 if ( exists $module_hash_ref->{$_} ) { 259 push(@warn_list, $_); 260 next; 261 } 262 if ( exists $custom_hash_ref->{$_} ) { 263 $zip_hash{$_} = $custom_hash_ref->{$_}; 264 next; 265 } 266 # it's neither in 'module' nor 'custom', record it in zip hash 267 $zip_hash{$_} = $global_path; 268 } 269 foreach ( keys %{$module_hash_ref} ) { 270 if ( exists $custom_hash_ref->{$_} ) { 271 $zip_hash{$_} = $custom_hash_ref->{$_}; 272 next; 273 } 274 # it's not in 'custom', record it in zip hash 275 $zip_hash{$_} = $module_path; 276 } 277 278 if ( @warn_list ) { 279 foreach ( @warn_list ) { 280 print_warning("$_ is duplicated in 'global' and 'module' list"); 281 } 282 } 283 284 return \%zip_hash 285} 286 287sub is_file_newer 288{ 289 my $test_hash_ref = shift; 290 my $reference_stamp = 0; 291 292 print_message("checking timestamps ...") if $verbose; 293 if ( -e $out_file ) { 294 $reference_stamp = (stat($out_file))[9]; 295 print_message("found $out_file with $reference_stamp ...") if $verbose; 296 } 297 return 1 if $reference_stamp == 0; 298 299 foreach ( sort keys %{$test_hash_ref} ) { 300 my $path = $test_hash_ref->{$_}; 301 $path .= "/" if "$path" ne ""; 302 $path .= "$_"; 303 print_message("checking '$path' ...") if $extra_verbose; 304 my $mtime = (stat($path))[9]; 305 return 1 if $reference_stamp < $mtime; 306 } 307 return 0; 308} 309 310sub optimize_zip_layout($) 311{ 312 my $zip_hash_ref = shift; 313 314 if (!defined $sort_file) { 315 print_message("no sort file - sorting alphabetically ...") if $verbose; 316 return sort keys %{$zip_hash_ref}; 317 } 318 print_message("sorting from $sort_file ...") if $verbose; 319 320 my $orderh; 321 my %included; 322 my @sorted; 323 open ($orderh, $sort_file) || die "Can't open $sort_file: $!"; 324 while (<$orderh>) { 325 /^\#.*/ && next; # comments 326 s/[\r\n]*$//; 327 /^\s*$/ && next; 328 my $file = $_; 329 if (!defined $zip_hash_ref->{$file}) { 330 print "unknown file '$file'\n" if ($extra_verbose); 331 } else { 332 push @sorted, $file; 333 $included{$file} = 1; 334 } 335 } 336 close ($orderh); 337 338 for my $img (sort keys %{$zip_hash_ref}) { 339 push @sorted, $img if (!$included{$img}); 340 } 341 342 print_message("done sort ...") if $verbose; 343 344 return @sorted; 345} 346 347sub create_zip_archive 348{ 349 my $zip_hash_ref = shift; 350 351 print_message("creating image archive ...") if $verbose; 352 my $zip = Archive::Zip->new(); 353 354# FIXME: test - $member = addfile ... $member->desiredCompressionMethod( COMPRESSION_STORED ); 355# any measurable performance win/loss ? 356 foreach ( optimize_zip_layout($zip_hash_ref) ) { 357 my $path = $zip_hash_ref->{$_} . "/$_"; 358 print_message("zipping '$path' ...") if $extra_verbose; 359 my $member = $zip->addFile($path, $_); 360 if ( !$member ) { 361 print_error("can't add file '$path' to image zip archive: $!", 5); 362 } 363 } 364 my $status = $zip->writeToFileNamed($tmp_out_file); 365 if ( $status != AZ_OK ) { 366 print_error("write image zip archive '$tmp_out_file' failed. Reason: $status", 6); 367 } 368 return; 369} 370 371sub replace_file 372{ 373 my $source_file = shift; 374 my $dest_file = shift; 375 my $result = 0; 376 377 $result = unlink($dest_file) if -f $dest_file; 378 if ( $result != 1 && -f $dest_file ) { 379 unlink $source_file; 380 print_error("couldn't remove '$dest_file'",1); 381 } else { 382 if ( !rename($source_file, $dest_file)) { 383 unlink $source_file; 384 print_error("couldn't rename '$source_file'",1); 385 } 386 } 387 return; 388} 389 390sub usage 391{ 392 print STDERR "Usage: packimages.pl [-h] -o out_file -g g_path -m m_path -c c_path -l imagelist_path\n"; 393 print STDERR "Creates archive of images\n"; 394 print STDERR "Options:\n"; 395 print STDERR " -h print this help\n"; 396 print STDERR " -o out_file path to output archive\n"; 397 print STDERR " -g g_path path to global images directory\n"; 398 print STDERR " -m m_path path to module images directory\n"; 399 print STDERR " -c c_path path to custom images directory\n"; 400 print STDERR " -s sort_file path to image sort order file\n"; 401 print STDERR " -l imagelist_path path to directory containing image lists (may appear mutiple times)\n"; 402 print STDERR " -v verbose\n"; 403 print STDERR " -vv very verbose\n"; 404} 405 406sub print_message 407{ 408 my $message = shift; 409 410 print "$script_name: "; 411 print "$message\n"; 412 return; 413} 414 415sub print_warning 416{ 417 my $message = shift; 418 419 print STDERR "$script_name: "; 420 print STDERR "WARNING $message\n"; 421 return; 422} 423 424sub print_error 425{ 426 my $message = shift; 427 my $error_code = shift; 428 429 print STDERR "$script_name: "; 430 print STDERR "ERROR: $message\n"; 431 432 if ( $error_code ) { 433 print STDERR "\nFAILURE: $script_name aborted.\n"; 434 exit($error_code); 435 } 436 return; 437} 438