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# packconfig.pl - pack xml configuration 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 $out_file;                # path to output archive
40my $tmp_out_file;            # path to temporary output file
41my $files_path;              # path to look for desired files
42my $verbose;                 # be verbose
43my $extra_verbose;           # be extra verbose
44my $do_rebuild = 0;          # is rebuilding zipfile required?
45
46#### script id #####
47
48( my $script_name = $0 ) =~ s/^.*\b(\w+)\.pl$/$1/;
49
50my $script_rev;
51my $id_str = ' $Revision: 1.3.24.2 $ ';
52$id_str =~ /Revision:\s+(\S+)\s+\$/
53  ? ($script_rev = $1) : ($script_rev = "-");
54
55#print "$script_name -- version: $script_rev\n";
56
57#### main #####
58
59parse_options();
60my %files_hash;
61my $file_ref = get_files();
62
63$do_rebuild = is_file_newer(\%files_hash) if $do_rebuild == 0;
64
65if ( $do_rebuild == 1 ) {
66    create_zip_archive(\%files_hash);
67    replace_file($tmp_out_file, $out_file);
68    print_message("packing  $out_file finished.");
69} else {
70    print_message("$out_file up to date. nothing to do.");
71}
72
73exit(0);
74
75#### subroutines ####
76
77sub parse_options
78{
79    my $opt_help;
80    my $p = Getopt::Long::Parser->new();
81    my $success =$p->getoptions(
82                             '-h' => \$opt_help,
83                             '-o=s' => \$out_file,
84                             '-i=s' => \$files_path,
85                             '-v'   => \$verbose,
86                             '-vv'  => \$extra_verbose
87                            );
88
89    if ( $opt_help || !$success || !$out_file || !$files_path )
90    {
91        usage();
92        exit(1);
93    }
94
95    #define intermediate output file
96    $tmp_out_file="$out_file"."$$".$ENV{INPATH};
97    # Sanity checks.
98
99    # Check if out_file can be written.
100    my $out_dir = dirname($out_file);
101    print_error("no such directory: '$out_dir'", 2) if ! -d $out_dir;
102    print_error("can't search directory: '$out_dir'", 2) if ! -x $out_dir;
103    print_error("directory is not writable: '$out_dir'", 2) if ! -w $out_dir;
104
105    # Check paths.
106    foreach ($files_path) {
107        print_error("no such directory: '$_'", 2) if ! -d $_;
108        print_error("can't search directory: '$_'", 2) if ! -x $_;
109    }
110}
111
112sub get_files
113{
114    local @main::file_list;
115
116    find_files(\%files_hash);
117
118    if ( !keys %files_hash ) {
119        print_error("can't find any image lists in '$files_path'", 3);
120    }
121
122    return wantarray ? @main::file_list : \@main::file_list;
123}
124
125sub find_files
126{
127    my $files_hash_ref = shift;
128    find({ wanted => \&wanted, no_chdir => 0 }, "$files_path");
129    foreach ( @main::file_list ) {
130        /^\Q$files_path\E\/(.*)$/o;
131        $files_hash_ref->{$1}++;
132    }
133}
134
135sub wanted
136{
137    my $file = $_;
138
139    if ( $file =~ /.*\.xml$/ && -f $file ) {
140        push @main::file_list, $File::Find::name;
141    }
142}
143
144sub is_file_newer
145{
146    my $test_hash_ref = shift;
147    my $reference_stamp = 0;
148
149    print_message("checking timestamps ...") if $verbose;
150    if ( -e $out_file ) {
151        $reference_stamp = (stat($out_file))[9];
152        print_message("found $out_file with $reference_stamp ...") if $verbose;
153    }
154    return 1 if $reference_stamp == 0;
155
156    foreach ( sort keys %{$test_hash_ref} ) {
157        my $path = $files_path;
158        $path .= "/" if "$path" ne "";
159        $path .= "$_";
160        print_message("checking '$path' ...") if $extra_verbose;
161        my $mtime = (stat($path))[9];
162        return 1 if $reference_stamp < $mtime;
163    }
164    return 0;
165}
166
167sub create_zip_archive
168{
169    my $zip_hash_ref = shift;
170    print_message("creating config archive ...") if $verbose;
171    my $zip = Archive::Zip->new();
172
173    # on Mac OS X Intel we have unxmacxi.pro, on Mac OS X PowerPC unxmacxp.pro .. and so on
174    my $platform = $ENV{INPATH};
175
176    foreach ( sort keys %{$zip_hash_ref} ) {
177        my $path = "$files_path/$_";
178	# only Mac OS X Aqua is concerned here
179	# but changes for other platforms can easely be added following the same principle
180	if ( ( $platform =~ /^.*macx*/) && ($path =~ /^.*menubar.xml/ ) ) {
181	    $path = modify_mac_menus($path);
182	}
183	print_message("zipping '$path' ...") if $extra_verbose;
184	if ( !$zip->addFile($path, $_) ) {
185	    print_error("can't add file '$path' to config zip archive: $!", 5);
186	}
187    }
188    my $status = $zip->writeToFileNamed($tmp_out_file);
189    if ( $status != AZ_OK ) {
190        print_error("write image zip archive '$tmp_out_file' failed. Reason: $status", 6);
191    }
192    return;
193}
194
195sub modify_mac_menus
196{
197    my $path_base = "$ENV{'SOLARENV'}";
198    $path_base =~ s/solenv//;
199
200    my $new_file_name = "$path_base"."postprocess"."\/"."$ENV{INPATH}"."\/"."misc"."\/"."$_";
201
202    my $new_directory = $new_file_name;
203    $new_directory =~ s/\/menubar.xml//;
204    if ( ! -e $new_directory) {
205	`mkdir -p "$new_directory"`;
206    }
207
208    my $old_file_name = "$files_path/$_";
209
210    `cp $old_file_name $new_file_name`;
211
212    my $temp_file_name = "$new_file_name"."_tmp";
213    my $xsl_file = "macosx/macosx_menubar_modification.xsl";
214
215    my $result = `xsltproc $xsl_file $new_file_name > $temp_file_name`;
216
217    if ( $result != 0) {
218	print_error("xsltproc '$xsl_file' '$new_file_name'> '$temp_file_name' failed",1)
219    }
220
221    replace_file( $temp_file_name, $new_file_name );
222    return $new_file_name;
223}
224
225sub replace_file
226{
227    my $source_file = shift;
228    my $dest_file = shift;
229    my $result = 0;
230
231    $result = unlink($dest_file) if -f $dest_file;
232    if ( $result != 1 && -f $dest_file ) {
233        unlink $source_file;
234        print_error("couldn't remove '$dest_file'",1);
235    }  else {
236        if ( !rename($source_file, $dest_file)) {
237            unlink $source_file;
238            print_error("couldn't rename '$source_file'",1);
239        }
240    }
241    return;
242}
243
244sub usage
245{
246    print STDERR "Usage: packimages.pl [-h] -o out_file -i file_path\n";
247    print STDERR "Creates archive of images\n";
248    print STDERR "Options:\n";
249    print STDERR "    -h                 print this help\n";
250    print STDERR "    -o out_file        path to output archive\n";
251    print STDERR "    -i file_path       path to directory containing the config files\n";
252    print STDERR "    -v                 verbose\n";
253    print STDERR "    -vv                very verbose\n";
254}
255
256sub print_message
257{
258    my $message     = shift;
259
260    print "$script_name: ";
261    print "$message\n";
262    return;
263}
264
265sub print_warning
266{
267    my $message     = shift;
268
269    print STDERR "$script_name: ";
270    print STDERR "WARNING $message\n";
271    return;
272}
273
274sub print_error
275{
276    my $message     = shift;
277    my $error_code  = shift;
278
279    print STDERR "$script_name: ";
280    print STDERR "ERROR: $message\n";
281
282    if ( $error_code ) {
283        print STDERR "\nFAILURE: $script_name aborted.\n";
284        exit($error_code);
285    }
286    return;
287}
288