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