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