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 require File::Temp;
  31 use File::Temp ();
  32 use Archive::Zip qw(:ERROR_CODES :CONSTANTS);
  33
  34 #### globals ####
  35
  36 my $img_global = '%GLOBALRES%';  # 'global' image prefix
  37 my $img_module = '%MODULE%';  # 'module' image prefix
  38
  39 my $out_file;                # path to output archive
  40 my $tmp_out_file;            # path to temporary output file
  41 my $global_path;             # path to global images directory
  42 my $module_path;             # path to module images directory
  43 my $sort_file;               # path to file containing sorting data
  44 my @custom_path;             # path to custom images directory
  45 my @imagelist_path;          # paths to directories containing the image lists
  46 my $verbose;                 # be verbose
  47 my $extra_verbose;           # be extra verbose
  48 my $do_rebuild = 0;          # is rebuilding zipfile required?
  49
  50 my @custom_list;
  51 #### script id #####
  52
  53 ( my $script_name = $0 ) =~ s/^.*\b(\w+)\.pl$/$1/;
  54
  55 print "$script_name -- version: 1.17\n" if $verbose;
  56
  57 #### main #####
  58
  59 parse_options();
  60 my $image_lists_ref = get_image_lists();
  61 my %image_lists_hash;
  62 foreach ( @{$image_lists_ref} ) {
  63     $image_lists_hash{$_}="";
  64 }
  65 $do_rebuild = is_file_newer(\%image_lists_hash) if $do_rebuild == 0;
  66 my ($global_hash_ref, $module_hash_ref, $custom_hash_ref) = iterate_image_lists($image_lists_ref);
  67 # custom_hash filled from filesystem lookup
  68 find_custom($custom_hash_ref);
  69
  70 # build a consolidated set of links
  71 my %links;
  72 read_links(\%links, $global_path);
  73 for my $path (@custom_path) {
  74     read_links(\%links, $path);
  75 }
  76 check_links(\%links);
  77
  78 my $zip_hash_ref = create_zip_list($global_hash_ref, $module_hash_ref, $custom_hash_ref);
  79 remove_links_from_zip_list($zip_hash_ref, \%links);
  80
  81 $do_rebuild = is_file_newer($zip_hash_ref) if $do_rebuild == 0;
  82 if ( $do_rebuild == 1 ) {
  83     create_zip_archive($zip_hash_ref, \%links);
  84     replace_file($tmp_out_file, $out_file);
  85     print_message("packing  $out_file finished.") if $verbose;
  86 } else {
  87     print_message("$out_file up to date. nothing to do.") if $verbose;
  88 }
  89
  90 exit(0);
  91
  92 #### subroutines ####
  93
  94 sub parse_options
  95 {
  96     my $opt_help;
  97     my $p = Getopt::Long::Parser->new();
  98     my @custom_path_list;
  99     my $custom_path_extended;
 100     my $success =$p->getoptions(
 101                              '-h' => \$opt_help,
 102                              '-o=s' => \$out_file,
 103                              '-g=s' => \$global_path,
 104                  '-s=s' => \$sort_file,
 105                              '-m=s' => \$module_path,
 106                              '-c=s' => \@custom_path_list,
 107                              '-e=s' => \$custom_path_extended,
 108                              '-l=s' => \@imagelist_path,
 109                              '-v'   => \$verbose,
 110                              '-vv'  => \$extra_verbose
 111                             );
 112     push @custom_path_list, $custom_path_extended if ($custom_path_extended);
 113     if ( $opt_help || !$success || !$out_file || !$global_path
 114         || !$module_path || !@custom_path_list || !@imagelist_path )
 115     {
 116         usage();
 117         exit(1);
 118     }
 119     #define intermediate output file
 120     $tmp_out_file="$out_file"."$$".".tmp";
 121     # Sanity checks.
 122
 123     # Check if out_file can be written.
 124     my $out_dir = dirname($out_file);
 125
 126     # Check paths.
 127     foreach ($out_dir, $global_path, $module_path, @imagelist_path) {
 128         print_error("no such directory: '$_'", 2) if ! -d $_;
 129         print_error("can't search directory: '$_'", 2) if ! -x $_;
 130     }
 131     print_error("directory is not writable: '$out_dir'", 2) if ! -w $out_dir;
 132
 133     # Use just the working paths
 134     @custom_path = ();
 135     foreach (@custom_path_list) {
 136         if ( ! -d $_ ) {
 137             print_warning("skipping non-existing directory: '$_'", 2);
 138         }
 139         elsif ( ! -x $_ ) {
 140             print_error("can't search directory: '$_'", 2);
 141         }
 142         else {
 143             push @custom_path, $_;
 144         }
 145     }
 146 }
 147
 148 sub get_image_lists
 149 {
 150     my @image_lists;
 151     my $glob_imagelist_path;
 152
 153     foreach ( @imagelist_path ) {
 154         $glob_imagelist_path = $_;
 155         # cygwin perl
 156         chomp( $glob_imagelist_path = qx{cygpath -u "$glob_imagelist_path"} ) if "$^O" eq "cygwin";
 157         push @image_lists, glob("$glob_imagelist_path/*.ilst");
 158     }
 159     if ( !@image_lists ) {
 160         print_error("can't find any image lists in '@imagelist_path'", 3);
 161     }
 162
 163     return wantarray ? @image_lists : \@image_lists;
 164 }
 165
 166 sub iterate_image_lists
 167 {
 168     my $image_lists_ref = shift;
 169
 170     my %global_hash;
 171     my %module_hash;
 172     my %custom_hash;
 173
 174     foreach my $i ( @{$image_lists_ref} ) {
 175         parse_image_list($i, \%global_hash, \%module_hash, \%custom_hash);
 176     }
 177
 178     return (\%global_hash, \%module_hash, \%custom_hash);
 179 }
 180
 181 sub parse_image_list
 182 {
 183     my $image_list      = shift;
 184     my $global_hash_ref = shift;
 185     my $module_hash_ref = shift;
 186     my $custom_hash_ref = shift;
 187
 188     print_message("parsing '$image_list' ...") if $verbose;
 189     my $linecount = 0;
 190     open(IMAGE_LIST, "< $image_list") or die "ERROR: can't open $image_list: $!";
 191     while ( <IMAGE_LIST> ) {
 192         $linecount++;
 193         next if /^\s*#/;
 194         next if /^\s*$/;
 195         # clean up trailing whitespace
 196         tr/\r\n//d;
 197         s/\s+$//;
 198         # clean up backslashes and double slashes
 199         tr{\\}{/}s;
 200         tr{/}{}s;
 201         # hack "res" back into globals
 202         if ( /^\Q$img_global\E\/(.*)$/o ) {
 203             $global_hash_ref->{"res/".$1}++;
 204             next;
 205         }
 206         if ( /^\Q$img_module\E\/(.*)$/o ) {
 207             $module_hash_ref->{$1}++;
 208             next;
 209         }
 210         # parse failed if we reach this point, bail out
 211         close(IMAGE_LIST);
 212         print_error("can't parse line $linecount from file '$image_list'", 4);
 213     }
 214     close(IMAGE_LIST);
 215
 216     return ($global_hash_ref, $module_hash_ref, $custom_hash_ref);
 217 }
 218
 219 sub find_custom
 220 {
 221     my $custom_hash_ref = shift;
 222     my $keep_back;
 223     for my $path (@custom_path) {
 224     find({ wanted => \&wanted, no_chdir => 0 }, $path);
 225     foreach ( @custom_list ) {
 226         if ( /^\Q$path\E\/(.*)$/ ) {
 227         $keep_back=$1;
 228         if (!defined $custom_hash_ref->{$keep_back}) {
 229             $custom_hash_ref->{$keep_back} = $path;
 230         }
 231         }
 232     }
 233     }
 234 }
 235
 236 sub wanted
 237 {
 238     my $file = $_;
 239
 240     if ( $file =~ /.*\.png$/ && -f $file ) {
 241         push @custom_list, $File::Find::name;
 242     }
 243 }
 244
 245 sub create_zip_list
 246 {
 247     my $global_hash_ref = shift;
 248     my $module_hash_ref = shift;
 249     my $custom_hash_ref = shift;
 250
 251     my %zip_hash;
 252     my @warn_list;
 253
 254     print_message("assemble image list ...") if $verbose;
 255     foreach ( keys %{$global_hash_ref} ) {
 256         # check if in 'global' and in 'module' list and add to warn list
 257         if ( exists $module_hash_ref->{$_} ) {
 258             push(@warn_list, $_);
 259             next;
 260         }
 261         if ( exists $custom_hash_ref->{$_} ) {
 262             $zip_hash{$_} = $custom_hash_ref->{$_};
 263             next;
 264         }
 265         # it's neither in 'module' nor 'custom', record it in zip hash
 266         $zip_hash{$_} = $global_path;
 267     }
 268     foreach ( keys %{$module_hash_ref} ) {
 269         if ( exists $custom_hash_ref->{$_} ) {
 270             $zip_hash{$_} = $custom_hash_ref->{$_};
 271             next;
 272         }
 273         # it's not in 'custom', record it in zip hash
 274         $zip_hash{$_} = $module_path;
 275     }
 276
 277     if ( @warn_list ) {
 278         foreach ( @warn_list ) {
 279             print_warning("$_ is duplicated in 'global' and 'module' list");
 280         }
 281     }
 282
 283     return \%zip_hash
 284 }
 285
 286 sub is_file_newer
 287 {
 288     my $test_hash_ref = shift;
 289     my $reference_stamp = 0;
 290
 291     print_message("checking timestamps ...") if $verbose;
 292     if ( -e $out_file ) {
 293         $reference_stamp = (stat($out_file))[9];
 294         print_message("found $out_file with $reference_stamp ...") if $verbose;
 295     }
 296     return 1 if $reference_stamp == 0;
 297
 298     foreach ( sort keys %{$test_hash_ref} ) {
 299         my $path = $test_hash_ref->{$_};
 300         $path .= "/" if "$path" ne "";
 301         $path .= "$_";
 302         print_message("checking '$path' ...") if $extra_verbose;
 303         my $mtime = (stat($path))[9];
 304         return 1 if $reference_stamp < $mtime;
 305     }
 306     return 0;
 307 }
 308
 309 sub optimize_zip_layout($)
 310 {
 311     my $zip_hash_ref = shift;
 312
 313     if (!defined $sort_file) {
 314     print_message("no sort file - sorting alphabetically ...") if $verbose;
 315     return sort keys %{$zip_hash_ref};
 316     }
 317     print_message("sorting from $sort_file ...") if $verbose;
 318
 319     my $orderh;
 320     my %included;
 321     my @sorted;
 322     open ($orderh, $sort_file) || die "Can't open $sort_file: $!";
 323     while (<$orderh>) {
 324     /^\#.*/ && next; # comments
 325     s/[\r\n]*$//;
 326     /^\s*$/ && next;
 327     my $file = $_;
 328     if (!defined $zip_hash_ref->{$file}) {
 329         print "unknown file '$file'\n" if ($extra_verbose);
 330     } else {
 331         push @sorted, $file;
 332         $included{$file} = 1;
 333     }
 334     }
 335     close ($orderh);
 336
 337     for my $img (sort keys %{$zip_hash_ref}) {
 338     push @sorted, $img if (!$included{$img});
 339     }
 340
 341     print_message("done sort ...") if $verbose;
 342
 343     return @sorted;
 344 }
 345
 346 sub create_zip_archive
 347 {
 348     my $zip_hash_ref = shift;
 349     my $links_hash_ref = shift;
 350
 351     print_message("creating image archive ...") if $verbose;
 352     my $zip = Archive::Zip->new();
 353
 354     my $linktmp;
 355     if (keys %{$links_hash_ref}) {
 356         $linktmp = write_links($links_hash_ref);
 357         my $member = $zip->addFile($linktmp->filename, "links.txt", COMPRESSION_DEFLATED);
 358         if (!$member) {
 359             print_error("failed to add links file: $!", 5);
 360         }
 361     }
 362
 363 # FIXME: test - $member = addfile ... $member->desiredCompressionMethod( COMPRESSION_STORED );
 364 # any measurable performance win/loss ?
 365     foreach ( optimize_zip_layout($zip_hash_ref) ) {
 366         my $path = $zip_hash_ref->{$_} . "/$_";
 367         print_message("zipping '$path' ...") if $extra_verbose;
 368         if ( -e $path) {
 369             my $member = $zip->addFile($path, $_, COMPRESSION_STORED);
 370             if ( !$member ) {
 371                 print_error("can't add file '$path' to image zip archive: $!", 5);
 372             }
 373         } else {
 374                 print_warning("file '$path' not found");
 375         }
 376     }
 377     my $status = $zip->writeToFileNamed($tmp_out_file);
 378     if ( $status != AZ_OK ) {
 379         print_error("write image zip archive '$tmp_out_file' failed. Reason: $status", 6);
 380     }
 381     return;
 382 }
 383
 384 sub replace_file
 385 {
 386     my $source_file = shift;
 387     my $dest_file = shift;
 388     my $result = 0;
 389
 390     $result = unlink($dest_file) if -f $dest_file;
 391     if ( $result != 1 && -f $dest_file ) {
 392         unlink $source_file;
 393         print_error("couldn't remove '$dest_file'",1);
 394     }  else {
 395         if ( !rename($source_file, $dest_file)) {
 396             unlink $source_file;
 397             print_error("couldn't rename '$source_file'",1);
 398         }
 399     }
 400     return;
 401 }
 402
 403 sub usage
 404 {
 405     print STDERR "Usage: packimages.pl [-h] -o out_file -g g_path -m m_path -c c_path -l imagelist_path\n";
 406     print STDERR "Creates archive of images\n";
 407     print STDERR "Options:\n";
 408     print STDERR "    -h                 print this help\n";
 409     print STDERR "    -o out_file        path to output archive\n";
 410     print STDERR "    -g g_path          path to global images directory\n";
 411     print STDERR "    -m m_path          path to module images directory\n";
 412     print STDERR "    -c c_path          path to custom images directory\n";
 413     print STDERR "    -s sort_file       path to image sort order file\n";
 414     print STDERR "    -l imagelist_path  path to directory containing image lists (may appear mutiple times)\n";
 415     print STDERR "    -v                 verbose\n";
 416     print STDERR "    -vv                very verbose\n";
 417 }
 418
 419 sub print_message
 420 {
 421     my $message     = shift;
 422
 423     print "$script_name: ";
 424     print "$message\n";
 425     return;
 426 }
 427
 428 sub print_warning
 429 {
 430     my $message     = shift;
 431
 432     print STDERR "$script_name: ";
 433     print STDERR "WARNING $message\n";
 434     return;
 435 }
 436
 437 sub print_error
 438 {
 439     my $message     = shift;
 440     my $error_code  = shift;
 441
 442     print STDERR "$script_name: ";
 443     print STDERR "ERROR: $message\n";
 444
 445     if ( $error_code ) {
 446         print STDERR "\nFAILURE: $script_name aborted.\n";
 447         exit($error_code);
 448     }
 449     return;
 450 }
 451
 452 sub read_links($$)
 453 {
 454     my $links = shift;
 455     my $path = shift;
 456
 457     my $fname = "$path/links.txt";
 458     if (!-f "$fname") {
 459         return;
 460     }
 461
 462     my $fh;
 463     open ($fh, $fname) || die "Can't open: $fname: $!";
 464     # Syntax of links file:
 465     # # comment
 466     # missing-image image-to-load-instead
 467     while (<$fh>) {
 468         my $line = $_;
 469         $line =~ s/\r//g;   # DOS line-feeds
 470         $line =~ s/\#.*$//; # kill comments
 471         $line =~ m/^\s*$/ && next; # blank lines
 472         if ($line =~ m/^([^\s]+)\s+(.*)$/) {
 473             my ($missing, $replace) = ($1, $2);
 474             # enter into hash, and overwrite previous layer if necessary
 475             $links->{$1} = $2;
 476         } else {
 477             die "Malformed links line: '$line'\n";
 478         }
 479     }
 480     close ($fh);
 481 }
 482
 483 # write out the links to a tmp file
 484 sub write_links($)
 485 {
 486     my $links = shift;
 487     my $tmp = File::Temp->new( TEMPLATE => "linksXXXXXXX" );
 488     $tmp || die "can't create tmp: $!";
 489     for my $missing (sort keys %{$links}) {
 490         my $line = $missing . " " . $links->{$missing} . "\n";
 491         print $tmp $line;
 492     }
 493     binmode $tmp; # force flush
 494     return $tmp;
 495 }
 496
 497 # Ensure that no link points to another link
 498 sub check_links($)
 499 {
 500     my $links = shift;
 501
 502     for my $link (keys %{$links}) {
 503         my $value = $links->{$link};
 504         if (defined $links->{$value}) {
 505             die "Link to another link: $link -> $value -> " . $links->{$value};
 506         }
 507     }
 508 }
 509
 510 # remove any files from our zip list that are linked
 511 sub remove_links_from_zip_list($$)
 512 {
 513     my $zip_hash_ref = shift;
 514     my $links = shift;
 515     for my $link (keys %{$links}) {
 516         if (defined $zip_hash_ref->{$link}) {
 517             delete $zip_hash_ref->{$link};
 518         }
 519     }
 520 }