solenv/bin/packimages.pl

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