solenv/bin/packimages.pl

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