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