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