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