summaryrefslogtreecommitdiff
path: root/solenv/bin/deliver.pl
diff options
context:
space:
mode:
authorMichael Stahl <mstahl@redhat.com>2012-01-28 20:18:21 +0100
committerMichael Stahl <mstahl@redhat.com>2012-01-28 20:18:21 +0100
commit97a0d15e61e991e84e6229ea90f6fc7fc301b379 (patch)
tree1420a4a22edf83393ce9921cc2bb90ad607d9042 /solenv/bin/deliver.pl
parentf9aa949d90236c3e64450544c62e62d997a55b45 (diff)
replace obsolete "master" branch with README that points at new repoHEADmaster-deletedmaster
Diffstat (limited to 'solenv/bin/deliver.pl')
-rwxr-xr-xsolenv/bin/deliver.pl1457
1 files changed, 0 insertions, 1457 deletions
diff --git a/solenv/bin/deliver.pl b/solenv/bin/deliver.pl
deleted file mode 100755
index d4080b6e0..000000000
--- a/solenv/bin/deliver.pl
+++ /dev/null
@@ -1,1457 +0,0 @@
-:
-eval 'exec perl -wS $0 ${1+"$@"}'
- if 0;
-#*************************************************************************
-#
-# DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
-#
-# Copyright 2000, 2010 Oracle and/or its affiliates.
-#
-# OpenOffice.org - a multi-platform office productivity suite
-#
-# This file is part of OpenOffice.org.
-#
-# OpenOffice.org is free software: you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License version 3
-# only, as published by the Free Software Foundation.
-#
-# OpenOffice.org is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU Lesser General Public License version 3 for more details
-# (a copy is included in the LICENSE file that accompanied this code).
-#
-# You should have received a copy of the GNU Lesser General Public License
-# version 3 along with OpenOffice.org. If not, see
-# <http://www.openoffice.org/license.html>
-# for a copy of the LGPLv3 License.
-#
-#*************************************************************************
-
-#
-# deliver.pl - copy from module output tree to solver
-#
-
-use Cwd;
-use File::Basename;
-use File::Copy;
-use File::DosGlob 'glob';
-use File::Path;
-use File::Spec;
-
-#### script id #####
-
-( $script_name = $0 ) =~ s/^.*\b(\w+)\.pl$/$1/;
-
-#### globals ####
-
-### valid actions ###
-# if you add a action 'foo', than add 'foo' to this list and
-# implement 'do_foo()' in the implemented actions area
-@action_list = ( # valid actions
- 'copy',
- 'dos',
- 'addincpath',
- 'linklib',
- 'mkdir',
- 'symlink',
- 'touch'
- );
-
-# copy filter: files matching these patterns won't be copied by
-# the copy action
-@copy_filter_patterns = (
- );
-
-$strip = '';
-$is_debug = 0;
-
-$error = 0;
-$module = 0; # module name
-$repository = 0; # parent directory of this module
-$base_dir = 0; # path to module base directory
-$dlst_file = 0; # path to d.lst
-$ilst_ext = 'ilst'; # extension of image lists
-$umask = 22; # default file/directory creation mask
-$dest = 0; # optional destination path
-$common_build = 0; # do we have common trees?
-$common_dest = 0; # common tree on solver
-
-@action_data = (); # LoL with all action data
-@macros = (); # d.lst macros
-@addincpath_list = (); # files which have to be filtered through addincpath
-@dirlist = (); # List of 'mkdir' targets
-@zip_list = (); # files which have to be zipped
-@common_zip_list = (); # common files which have to be zipped
-@log_list = (); # LoL for logging all copy and link actions
-@common_log_list = (); # LoL for logging all copy and link actions in common_dest
-$logfiledate = 0; # Make log file as old as newest delivered file
-$commonlogfiledate = 0; # Make log file as old as newest delivered file
-
-$files_copied = 0; # statistics
-$files_unchanged = 0; # statistics
-
-$opt_force = 0; # option force copy
-$opt_check = 0; # do actually execute any action
-$opt_zip = 0; # create an additional zip file
-$opt_silent = 0; # be silent, only report errors
-$opt_verbose = 0; # be verbose (former default behaviour)
-$opt_log = 1; # create an additional log file
-$opt_link = 0; # hard link files into the solver to save disk space
-$opt_deloutput = 0; # delete the output tree for the project once successfully delivered
-$opt_checkdlst = 0;
-$delete_common = 1; # for "-delete": if defined delete files from common tree also
-
-if ($^O ne 'cygwin') { # iz59477 - cygwin needes a dot "." at the end of filenames to disable
- $maybedot = ''; # some .exe transformation magic.
-} else {
- my $cygvernum = `uname -r`;
- my @cygvernum = split( /\./, $cygvernum);
- $cygvernum = shift @cygvernum;
- $cygvernum .= shift @cygvernum;
- if ( $cygvernum < 17 ) {
- $maybedot = '.';
- } else {
- $maybedot = ''; # no longer works with cygwin 1.7. other magic below.
- }
-}
-
-($gui = lc($ENV{GUI})) || die "Can't determine 'GUI'. Please set environment.\n";
-$tempcounter = 0;
-
-# zip is default for RE master builds
-$opt_zip = 1 if ( defined($ENV{DELIVER_TO_ZIP}) && uc($ENV{DELIVER_TO_ZIP}) eq 'TRUE');
-
-$has_symlinks = 0; # system supports symlinks
-
-for (@action_list) {
- $action_hash{$_}++;
-}
-
-# trap normal signals (HUP, INT, PIPE, TERM)
-# for clean up on unexpected termination
-use sigtrap 'handler' => \&cleanup_and_die, 'normal-signals';
-
-#### main ####
-
-parse_options();
-
-if ( ! $opt_delete ) {
- if ( $ENV{GUI} eq 'WNT' ) {
- if ($ENV{COM} eq 'GCC') {
- initialize_strip() ;
- };
- } else {
- initialize_strip();
- }
-}
-
-init_globals();
-push_default_actions();
-parse_dlst();
-check_dlst() if $opt_checkdlst;
-walk_action_data();
-walk_addincpath_list();
-write_log() if $opt_log;
-zip_files() if $opt_zip;
-cleanup() if $opt_delete;
-delete_output() if $opt_deloutput;
-print_stats();
-
-exit($error);
-
-#### implemented actions #####
-
-sub do_copy
-{
- # We need to copy two times:
- # from the platform dependent output tree
- # and from the common output tree
- my ($dependent, $common, $from, $to, $file_list);
- my $line = shift;
- my $touch = 0;
-
- $dependent = expand_macros($line);
- ($from, $to) = split(' ', $dependent);
- print "copy dependent: from: $from, to: $to\n" if $is_debug;
- glob_and_copy($from, $to, $touch);
-
- if ($delete_common && $common_build && ( $line !~ /%COMMON_OUTDIR%/ ) ) {
- $line =~ s/%__SRC%/%COMMON_OUTDIR%/ig;
- if ( $line =~ /%COMMON_OUTDIR%/ ) {
- $line =~ s/%_DEST%/%COMMON_DEST%/ig;
- $common = expand_macros($line);
- ($from, $to) = split(' ', $common);
- print "copy common: from: $from, to: $to\n" if $is_debug;
- glob_and_copy($from, $to, $touch);
- }
- }
-}
-
-sub do_dos
-{
- my $line = shift;
-
- my $command = expand_macros($line);
- if ( $opt_check ) {
- print "DOS: $command\n";
- }
- else {
- # HACK: remove MACOSX stuff which is wrongly labled with dos
- # better: fix broken d.lst
- return if ( $command =~ /MACOSX/ );
- $command =~ s#/#\\#g if $^O eq 'MSWin32';
- system($command);
- }
-}
-
-sub do_addincpath
-{
- # just collect all addincpath files, actual filtering is done later
- my $line = shift;
- my ($from, $to);
- my @globbed_files = ();
-
- $line = expand_macros($line);
- ($from, $to) = split(' ', $line);
-
- push( @addincpath_list, @{glob_line($from, $to)});
-}
-
-sub do_linklib
-{
- my ($lib_base, $lib_major,$from_dir, $to_dir);
- my $lib = shift;
- my @globbed_files = ();
- my %globbed_hash = ();
-
- print "linklib: $lib\n" if $is_debug;
- print "has symlinks\n" if ( $has_symlinks && $is_debug );
-
- return unless $has_symlinks;
-
- $from_dir = expand_macros('../%__SRC%/lib');
- $to_dir = expand_macros('%_DEST%/lib');
-
- @globbed_files = glob("$from_dir/$lib");
-
- if ( $#globbed_files == -1 ) {
- return;
- }
-
- foreach $lib (@globbed_files) {
- $lib = basename($lib);
- if ( $lib =~ /^(lib\S+(\.so|\.dylib))\.(\d+)\.(\d+)(\.(\d+))?$/
- || $lib =~ /^(lib\S+(\.so|\.dylib))\.(\d+)$/ )
- {
- push(@{$globbed_hash{$1}}, $lib);
- }
- else {
- print_warning("invalid library name: $lib");
- }
- }
-
- foreach $lib_base ( sort keys %globbed_hash ) {
- $lib = get_latest_patchlevel(@{$globbed_hash{$lib_base}});
-
- if ( $lib =~ /^(lib\S+(\.so|\.dylib))\.(\d+)\.(\d+)(\.(\d+))?$/ )
- {
- $lib_major = "$lib_base.$3";
- $long = 1;
- }
- else
- {
- $long = 0;
- }
-
- if ( $opt_check ) {
- if ( $opt_delete ) {
- print "REMOVE: $to_dir/$lib_major\n" if $long;
- print "REMOVE: $to_dir/$lib_base\n";
- }
- else {
- print "LINKLIB: $to_dir/$lib -> $to_dir/$lib_major\n" if $long;
- print "LINKLIB: $to_dir/$lib -> $to_dir/$lib_base\n";
- }
- }
- else {
- if ( $opt_delete ) {
- print "REMOVE: $to_dir/$lib_major\n" if ($long && $opt_verbose);
- print "REMOVE: $to_dir/$lib_base\n" if $opt_verbose;
- unlink "$to_dir/$lib_major" if $long;
- unlink "$to_dir/$lib_base";
- if ( $opt_zip ) {
- push_on_ziplist("$to_dir/$lib_major") if $long;
- push_on_ziplist("$to_dir/$lib_base");
- }
- return;
- }
- my $symlib;
- my @symlibs;
- if ($long)
- {
- @symlibs = ("$to_dir/$lib_major", "$to_dir/$lib_base");
- }
- else
- {
- @symlibs = ("$to_dir/$lib_base");
- }
- # remove old symlinks
- unlink(@symlibs);
- foreach $symlib (@symlibs) {
- print "LINKLIB: $lib -> $symlib\n" if $opt_verbose;
- if ( !symlink("$lib", "$symlib") ) {
- print_error("can't symlink $lib -> $symlib: $!",0);
- }
- else {
- push_on_ziplist($symlib) if $opt_zip;
- push_on_loglist("LINK", "$lib", "$symlib") if $opt_log;
- }
- }
- }
- }
-}
-
-sub do_mkdir
-{
- my $path = expand_macros(shift);
- # strip whitespaces from path name
- $path =~ s/\s$//;
- if (( ! $opt_delete ) && ( ! -d $path )) {
- if ( $opt_check ) {
- print "MKDIR: $path\n";
- } else {
- mkpath($path, 0, 0777-$umask);
- if ( ! -d $path ) {
- print_error("mkdir: could not create directory '$path'", 0);
- }
- }
- }
-}
-
-sub do_symlink
-{
- my $line = shift;
-
- $line = expand_macros($line);
- ($from, $to) = split(' ',$line);
- my $fullfrom = $from;
- if ( dirname($from) eq dirname($to) ) {
- $from = basename($from);
- }
- elsif ( dirname($from) eq '.' ) {
- # nothing to do
- }
- else {
- print_error("symlink: link must be in the same directory as file",0);
- return 0;
- }
-
- print "symlink: $from, to: $to\n" if $is_debug;
-
- return unless $has_symlinks;
-
- if ( $opt_check ) {
- if ( $opt_delete ) {
- print "REMOVE: $to\n";
- }
- else {
- print "SYMLINK $from -> $to\n";
- }
- }
- else {
- return unless -e $fullfrom;
- print "REMOVE: $to\n" if $opt_verbose;
- unlink $to;
- if ( $opt_delete ) {
- push_on_ziplist($to) if $opt_zip;
- return;
- }
- print "SYMLIB: $from -> $to\n" if $opt_verbose;
- if ( !symlink("$from", "$to") ) {
- print_error("can't symlink $from -> $to: $!",0);
- }
- else {
- push_on_ziplist($to) if $opt_zip;
- push_on_loglist("LINK", "$from", "$to") if $opt_log;
- }
- }
-}
-
-sub do_touch
-{
- my ($from, $to);
- my $line = shift;
- my $touch = 1;
-
- $line = expand_macros($line);
- ($from, $to) = split(' ', $line);
- print "touch: $from, to: $to\n" if $is_debug;
- glob_and_copy($from, $to, $touch);
-}
-
-#### subroutines #####
-
-sub parse_options
-{
- my $arg;
- my $dontdeletecommon = 0;
- $opt_silent = 1 if ( defined $ENV{VERBOSE} && $ENV{VERBOSE} eq 'FALSE');
- $opt_verbose = 1 if ( defined $ENV{VERBOSE} && $ENV{VERBOSE} eq 'TRUE');
- while ( $arg = shift @ARGV ) {
- $arg =~ /^-force$/ and $opt_force = 1 and next;
- $arg =~ /^-check$/ and $opt_check = 1 and $opt_verbose = 1 and next;
- $arg =~ /^-quiet$/ and $opt_silent = 1 and next;
- $arg =~ /^-verbose$/ and $opt_verbose = 1 and next;
- $arg =~ /^-zip$/ and $opt_zip = 1 and next;
- $arg =~ /^-delete$/ and $opt_delete = 1 and next;
- $arg =~ /^-dontdeletecommon$/ and $dontdeletecommon = 1 and next;
- $arg =~ /^-help$/ and $opt_help = 1 and $arg = '';
- $arg =~ /^-link$/ and $ENV{GUI} ne 'WNT' and $opt_link = 1 and next;
- $arg =~ /^-deloutput$/ and $opt_deloutput = 1 and next;
- $arg =~ /^-debug$/ and $is_debug = 1 and next;
- $arg =~ /^-checkdlst$/ and $opt_checkdlst = 1 and next;
- print_error("invalid option $arg") if ( $arg =~ /^-/ );
- if ( $arg =~ /^-/ || $opt_help || $#ARGV > -1 ) {
- usage(1);
- }
- $dest = $arg;
- }
- # $dest and $opt_zip or $opt_delete are mutually exclusive
- if ( $dest and ($opt_zip || $opt_delete) ) {
- usage(1);
- }
- # $opt_silent and $opt_check or $opt_verbose are mutually exclusive
- if ( ($opt_check or $opt_verbose) and $opt_silent ) {
- print STDERR "Error on command line: options '-check' and '-quiet' are mutually exclusive.\n";
- usage(1);
- }
- if ($dontdeletecommon) {
- if (!$opt_delete) {
- usage(1);
- }
- $delete_common = 0;
- };
- # $opt_delete implies $opt_force
- $opt_force = 1 if $opt_delete;
-}
-
-sub init_globals
-{
- ($module, $repository, $base_dir, $dlst_file) = get_base();
-
- # for CWS:
- $module =~ s/\.lnk$//;
-
- print "Module=$module, Base_Dir=$base_dir, d.lst=$dlst_file\n" if $is_debug;
-
- $umask = umask();
- if ( !defined($umask) ) {
- $umask = 22;
- }
-
- my $common_outdir = $ENV{'COMMON_OUTDIR'};
- my $inpath = $ENV{'INPATH'};
- my $solarversion = $ENV{'SOLARVERSION'};
- my $updater = $ENV{'UPDATER'};
- my $work_stamp = $ENV{'WORK_STAMP'};
-
- # do we have a valid environment?
- if ( !defined($inpath) ) {
- print_error("no environment", 0);
- exit(3);
- }
-
- # Do we have common trees?
- if ( defined($ENV{'common_build'}) && $ENV{'common_build'} eq 'TRUE' ) {
- $common_build = 1;
- if ((defined $common_outdir) && ($common_outdir ne "")) {
- $common_outdir = $common_outdir . ".pro" if $inpath =~ /\.pro$/;
- if ( $dest ) {
- $common_dest = $dest;
- } else {
- $common_dest = "$solarversion/$common_outdir";
- $dest = "$solarversion/$inpath";
- }
- } else {
- print_error("common_build defined without common_outdir", 0);
- exit(6);
- }
- } else {
- $common_outdir = $inpath;
- $dest = "$solarversion/$inpath" if ( !$dest );
- $common_dest = $dest;
- }
- $dest =~ s#\\#/#g;
- $common_dest =~ s#\\#/#g;
-
- # the following macros are obsolete, will be flagged as error
- # %__WORKSTAMP%
- # %GUIBASE%
- # %SDK%
- # %SOLARVER%
- # %__OFFENV%
- # %DLLSUFFIX%'
- # %OUTPATH%
- # %L10N_FRAMEWORK%
- # %UPD%
-
- # valid macros
- @macros = (
- [ '%__PRJROOT%', $base_dir ],
- [ '%__SRC%', $inpath ],
- [ '%_DEST%', $dest ],
- [ '%COMMON_OUTDIR%', $common_outdir ],
- [ '%COMMON_DEST%', $common_dest ],
- [ '%GUI%', $gui ]
- );
-
- # find out if the *HOST* system supports symlinks. They all do except Windows
- $has_symlinks = $ENV{GUI} ne 'WNT';
-}
-
-sub get_base
-{
- # a module base dir contains a subdir 'prj'
- # which in turn contains a file 'd.lst'
- my (@field, $repo, $base, $dlst);
- my $path = getcwd();
-
- @field = split(/\//, $path);
-
- while ( $#field != -1 ) {
- $base = join('/', @field);
- $dlst = $base . '/prj/d.lst';
- last if -e $dlst;
- pop @field;
- }
-
- if ( $#field == -1 ) {
- print_error("can't find d.lst");
- exit(2);
- }
- else {
- if ( defined $field[-2] ) {
- $repo = $field[-2];
- } else {
- print_error("Internal error: cannot determine module's parent directory");
- }
- return ($field[-1], $repo, $base, $dlst);
- }
-}
-
-sub parse_dlst
-{
- my $line_cnt = 0;
- open(DLST, "<$dlst_file") or die "can't open d.lst";
- while(<DLST>) {
- $line_cnt++;
- tr/\r\n//d;
- next if /^#/;
- next if /^\s*$/;
- if (!$delete_common && /%COMMON_DEST%/) {
- # Just ignore all lines with %COMMON_DEST%
- next;
- };
- if ( /^\s*(\w+?):\s+(.*)$/ ) {
- if ( !exists $action_hash{$1} ) {
- print_error("unknown action: \'$1\'", $line_cnt);
- exit(4);
- }
- push(@action_data, [$1, $2]);
- }
- else {
- if ( /^\s*%(COMMON)?_DEST%\\/ ) {
- # only copy from source dir to solver, not from solver to solver
- print_warning("illegal copy action, ignored: \'$_\'", $line_cnt);
- next;
- }
- push(@action_data, ['copy', $_]);
- # for each ressource file (.res) copy its image list (.ilst)
- if ( /\.res\s/ ) {
- my $imagelist = $_;
- $imagelist =~ s/\.res/\.$ilst_ext/g;
- $imagelist =~ s/DEST%\\bin\\/DEST%\\res\\img\\/;
- push(@action_data, ['copy', $imagelist]);
- }
- }
- # call expand_macros()just to find any undefined macros early
- # real expansion is done later
- expand_macros($_, $line_cnt);
- }
- close(DLST);
-}
-
-sub expand_macros
-{
- # expand all macros and change backslashes to slashes
- my $line = shift;
- my $line_cnt = shift;
- my $i;
-
- for ($i=0; $i<=$#macros; $i++) {
- $line =~ s/$macros[$i][0]/$macros[$i][1]/gi
- }
- if ( $line =~ /(%\w+%)/ ) {
- if ( $1 ne '%OS%' ) { # %OS% looks like a macro but is not ...
- print_error("unknown/obsolete macro: \'$1\'", $line_cnt);
- }
- }
- $line =~ s#\\#/#g;
- return $line;
-}
-
-sub walk_action_data
-{
- # all actions have to be excuted relative to the prj directory
- chdir("$base_dir/prj");
- # dispatch depending on action type
- for (my $i=0; $i <= $#action_data; $i++) {
- &{"do_".$action_data[$i][0]}($action_data[$i][1]);
- if ( $action_data[$i][0] eq 'mkdir' ) {
- # fill array with (possibly) created directories in
- # revers order for removal in 'cleanup'
- unshift @dirlist, $action_data[$i][1];
- }
- }
-}
-
-sub glob_line
-{
- my $from = shift;
- my $to = shift;
- my $to_dir = shift;
- my $replace = 0;
- my @globbed_files = ();
-
- if ( ! ( $from && $to ) ) {
- print_warning("Error in d.lst? source: '$from' destination: '$to'");
- return \@globbed_files;
- }
-
- if ( $to =~ /[\*\?\[\]]/ ) {
- my $to_fname;
- ($to_fname, $to_dir) = fileparse($to);
- $replace = 1;
- }
-
- if ( $from =~ /[\*\?\[\]]/ ) {
- # globbing necessary, no renaming possible
- my $file;
- my @file_list = glob($from);
-
- foreach $file ( @file_list ) {
- next if ( -d $file); # we only copy files, not directories
- my ($fname, $dir) = fileparse($file);
- my $copy = ($replace) ? $to_dir . $fname : $to . '/' . $fname;
- push(@globbed_files, [$file, $copy]);
- }
- }
- else {
- # no globbing but renaming possible
- # #i89066#
- if (-d $to && -f $from) {
- my $filename = File::Basename::basename($from);
- $to .= '/' if ($to !~ /[\\|\/]$/);
- $to .= $filename;
- };
- push(@globbed_files, [$from, $to]);
- }
- if ( $opt_checkdlst ) {
- my $outtree = expand_macros("%__SRC%");
- my $commonouttree = expand_macros("%COMMON_OUTDIR%");
- if (( $from !~ /\Q$outtree\E/ ) && ( $from !~ /\Q$commonouttree\E/ )) {
- print_warning("'$from' does not match any file") if ( $#globbed_files == -1 );
- }
- }
- return \@globbed_files;
-}
-
-
-sub glob_and_copy
-{
- my $from = shift;
- my $to = shift;
- my $touch = shift;
-
- my @copy_files = @{glob_line($from, $to)};
-
- for (my $i = 0; $i <= $#copy_files; $i++) {
- next if filter_out($copy_files[$i][0]); # apply copy filter
- copy_if_newer($copy_files[$i][0], $copy_files[$i][1], $touch)
- ? $files_copied++ : $files_unchanged++;
- }
-}
-
-sub is_unstripped {
- my $file_name = shift;
- my $nm_output;
-
- if (-f $file_name.$maybedot) {
- my $file_type = `file $file_name`;
- # OS X file command doesn't know if a file is stripped or not
- if (($file_type =~ /not stripped/o) || ($file_type =~ /Mach-O/o) ||
- (($file_type =~ /PE/o) && ($ENV{GUI} eq 'WNT') &&
- ($nm_output = `nm $file_name 2>&1`) && $nm_output &&
- !($nm_output =~ /no symbols/i) && !($nm_output =~ /not recognized/i))) {
- return '1' if ($file_name =~ /\.bin$/o);
- return '1' if ($file_name =~ /\.so\.*/o);
- return '1' if ($file_name =~ /\.dylib\.*/o);
- return '1' if ($file_name =~ /\.com\.*/o);
- return '1' if ($file_name =~ /\.dll\.*/o);
- return '1' if ($file_name =~ /\.exe\.*/o);
- return '1' if (basename($file_name) !~ /\./o);
- }
- };
- return '';
-}
-
-sub initialize_strip {
- if ((!defined $ENV{DISABLE_STRIP}) || ($ENV{DISABLE_STRIP} eq "")) {
- $strip .= 'guw ' if ($^O eq 'cygwin');
- $strip .= 'strip';
- $strip .= " -x" if ($ENV{OS} eq 'MACOSX');
- $strip .= " -R '.comment' -s" if ($ENV{OS} eq 'LINUX');
- };
-};
-
-sub is_jar {
- my $file_name = shift;
-
- if (-f $file_name && (( `file $file_name` ) =~ /Zip archive/o)) {
- return '1' if ($file_name =~ /\.jar\.*/o);
- };
- return '';
-}
-
-sub execute_system {
- my $command = shift;
- if (system($command)) {
- print_error("Failed to execute $command");
- exit($?);
- };
-};
-
-sub strip_target {
- my $file = shift;
- my $temp_file = shift;
- $temp_file =~ s/\/{2,}/\//g;
- my $rc = copy($file, $temp_file);
- execute_system("$strip $temp_file");
- return $rc;
-};
-
-sub copy_if_newer
-{
- # return 0 if file is unchanged ( for whatever reason )
- # return 1 if file has been copied
- my $from = shift;
- my $to = shift;
- my $touch = shift;
- my $from_stat_ref;
- my $rc = 0;
-
- print "testing $from, $to\n" if $is_debug;
- push_on_ziplist($to) if $opt_zip;
- push_on_loglist("COPY", "$from", "$to") if $opt_log;
- return 0 unless ($from_stat_ref = is_newer($from, $to, $touch));
-
- if ( $opt_delete ) {
- print "REMOVE: $to\n" if $opt_verbose;
- $rc = unlink($to) unless $opt_check;
- return 1 if $opt_check;
- return $rc;
- }
-
- if( !$opt_check && $opt_link ) {
- # hard link if possible
- if( link($from, $to) ){
- print "LINK: $from -> $to\n" if $opt_verbose;
- return 1;
- }
- }
-
- if( $touch ) {
- print "TOUCH: $from -> $to\n" if $opt_verbose;
- }
- else {
- print "COPY: $from -> $to\n" if $opt_verbose;
- }
-
- return 1 if( $opt_check );
-
- #
- # copy to temporary file first and rename later
- # to minimize the possibility for race conditions
- local $temp_file = sprintf('%s.%d-%d', $to, $$, time());
- $rc = '';
- if (($strip ne '') && (defined $ENV{PROEXT}) && (is_unstripped($from))) {
- $rc = strip_target($from, $temp_file);
- } else {
- $rc = copy($from, $temp_file);
- };
- if ( $rc) {
- if ( is_newer($temp_file, $from, 0) ) {
- $rc = utime($$from_stat_ref[9], $$from_stat_ref[9], $temp_file);
- if ( !$rc ) {
- print_warning("can't update temporary file modification time '$temp_file': $!\n
- Check file permissions of '$from'.",0);
- }
- }
- fix_file_permissions($$from_stat_ref[2], $temp_file);
- # Ugly hack: on windows file locking(?) sometimes prevents renaming.
- # Until we've found and fixed the real reason try it repeatedly :-(
- my $try = 0;
- my $maxtries = 1;
- $maxtries = 5 if ( $^O eq 'MSWin32' );
- my $success = 0;
- while ( $try < $maxtries && ! $success ) {
- sleep $try;
- $try ++;
- $success = rename($temp_file, $to);
- if ( $^O eq 'cygwin' && $to =~ /\.bin$/) {
- # hack to survive automatically added .exe for executables renamed to
- # *.bin - will break if there is intentionally a .bin _and_ .bin.exe file.
- $success = rename( "$to.exe", $to ) if -f "$to.exe";
- }
- }
- if ( $success ) {
- # handle special packaging of *.dylib files for Mac OS X
- if ( $^O eq 'darwin' )
- {
- system("macosx-create-bundle", "$to=$from.app") if ( -d "$from.app" );
- system("ranlib", "$to" ) if ( $to =~ /\.a/ );
- }
- if ( $try > 1 ) {
- print_warning("File '$to' temporarily locked. Dependency bug?");
- }
- return 1;
- }
- else {
- print_error("can't rename temporary file to $to: $!",0);
- }
- }
- else {
- print_error("can't copy $from: $!",0);
- my $destdir = dirname($to);
- if ( ! -d $destdir ) {
- print_error("directory '$destdir' does not exist", 0);
- }
- }
- unlink($temp_file);
- return 0;
-}
-
-sub is_newer
-{
- # returns whole stat buffer if newer
- my $from = shift;
- my $to = shift;
- my $touch = shift;
- my (@from_stat, @to_stat);
-
- @from_stat = stat($from.$maybedot);
- if ( $opt_checkdlst ) {
- my $outtree = expand_macros("%__SRC%");
- my $commonouttree = expand_macros("%COMMON_OUTDIR%");
- if ( $from !~ /$outtree/ ) {
- if ( $from !~ /$commonouttree/ ) {
- print_warning("'$from' does not exist") unless -e _;
- }
- }
- }
- return 0 unless -f _;
-
- if ( $touch ) {
- $from_stat[9] = time();
- }
- # adjust timestamps to even seconds
- # this is necessary since NT platforms have a
- # 2s modified time granularity while the timestamps
- # on Samba volumes have a 1s granularity
-
- $from_stat[9]-- if $from_stat[9] % 2;
-
- if ( $to =~ /^\Q$dest\E/ ) {
- if ( $from_stat[9] > $logfiledate ) {
- $logfiledate = $from_stat[9];
- }
- } elsif ( $common_build && ( $to =~ /^\Q$common_dest\E/ ) ) {
- if ( $from_stat[9] > $commonlogfiledate ) {
- $commonlogfiledate = $from_stat[9];
- }
- }
-
- @to_stat = stat($to.$maybedot);
- return \@from_stat unless -f _;
-
- if ( $opt_force ) {
- return \@from_stat;
- }
- else {
- return ($from_stat[9] > $to_stat[9]) ? \@from_stat : 0;
- }
-}
-
-sub filter_out
-{
- my $file = shift;
-
- foreach my $pattern ( @copy_filter_patterns ) {
- if ( $file =~ /$pattern/ ) {
- print "filter out: $file\n" if $is_debug;
- return 1;
- }
- }
-
- return 0;
-}
-
-sub fix_file_permissions
-{
- my $mode = shift;
- my $file = shift;
-
- if ( ($mode >> 6) % 2 == 1 ) {
- $mode = 0777 & ~$umask;
- }
- else {
- $mode = 0666 & ~$umask;
- }
- chmod($mode, $file);
-}
-
-sub get_latest_patchlevel
-{
- # note: feed only well formed library names to this function
- # of the form libfoo.so.x.y.z with x,y,z numbers
-
- my @sorted_files = sort by_rev @_;
- return $sorted_files[-1];
-
- sub by_rev {
- # comparison function for sorting
- my (@field_a, @field_b, $i);
-
- $a =~ /^(lib[\w-]+(\.so|\.dylib))\.(\d+)\.(\d+)\.(\d+)$/;
- @field_a = ($3, $4, $5);
- $b =~ /^(lib[\w-]+(\.so|\.dylib))\.(\d+)\.(\d+)\.(\d+)$/;
- @field_b = ($3, $4, $5);
-
- for ($i = 0; $i < 3; $i++)
- {
- if ( ($field_a[$i] < $field_b[$i]) ) {
- return -1;
- }
- if ( ($field_a[$i] > $field_b[$i]) ) {
- return 1;
- }
- }
-
- # can't happen
- return 0;
- }
-
-}
-
-sub push_default_actions
-{
- # any default action (that is an action which must be done even without
- # a corresponding d.lst entry) should be pushed here on the
- # @action_data list.
- my $subdir;
- my @subdirs = (
- 'bin',
- 'doc',
- 'inc',
- 'lib',
- 'par',
- 'pck',
- 'rdb',
- 'res',
- 'xml'
- );
- push(@subdirs, 'zip') if $opt_zip;
- push(@subdirs, 'idl') if ! $common_build;
- push(@subdirs, 'pus') if ! $common_build;
- my @common_subdirs = (
- 'bin',
- 'idl',
- 'inc',
- 'pck',
- 'pus',
- 'res'
- );
- push(@common_subdirs, 'zip') if $opt_zip;
-
- if ( ! $opt_delete ) {
- # create all the subdirectories on solver
- foreach $subdir (@subdirs) {
- push(@action_data, ['mkdir', "%_DEST%/$subdir"]);
- }
- if ( $common_build ) {
- foreach $subdir (@common_subdirs) {
- push(@action_data, ['mkdir', "%COMMON_DEST%/$subdir"]);
- }
- }
- }
- push(@action_data, ['mkdir', "%_DEST%/inc/$module"]);
- if ( $common_build ) {
- push(@action_data, ['mkdir', "%COMMON_DEST%/inc/$module"]);
- push(@action_data, ['mkdir', "%COMMON_DEST%/res/img"]);
- } else {
- push(@action_data, ['mkdir', "%_DEST%/res/img"]);
- }
-
- # deliver build.lst to $dest/inc/$module
- push(@action_data, ['copy', "build.lst %_DEST%/inc/$module/build.lst"]);
- if ( $common_build ) {
- # ... and to $common_dest/inc/$module
- push(@action_data, ['copy', "build.lst %COMMON_DEST%/inc/$module/build.lst"]);
- }
-
- # need to copy libstaticmxp.dylib for Mac OS X
- if ( $^O eq 'darwin' )
- {
- push(@action_data, ['copy', "../%__SRC%/lib/lib*static*.dylib %_DEST%/lib/lib*static*.dylib"]);
- }
-}
-
-sub walk_addincpath_list
-{
- my (@addincpath_headers);
- return if $#addincpath_list == -1;
-
- # create hash with all addincpath header names
- for (my $i = 0; $i <= $#addincpath_list; $i++) {
- my @field = split('/', $addincpath_list[$i][0]);
- push (@addincpath_headers, $field[-1]);
- }
-
- # now stream all addincpath headers through addincpath filter
- for (my $i = 0; $i <= $#addincpath_list; $i++) {
- add_incpath_if_newer($addincpath_list[$i][0], $addincpath_list[$i][1], \@addincpath_headers)
- ? $files_copied++ : $files_unchanged++;
- }
-}
-
-sub add_incpath_if_newer
-{
- my $from = shift;
- my $to = shift;
- my $modify_headers_ref = shift;
- my ($from_stat_ref, $header);
-
- push_on_ziplist($to) if $opt_zip;
- push_on_loglist("ADDINCPATH", "$from", "$to") if $opt_log;
-
- if ( $opt_delete ) {
- print "REMOVE: $to\n" if $opt_verbose;
- my $rc = unlink($to);
- return 1 if $rc;
- return 0;
- }
-
- if ( $from_stat_ref = is_newer($from, $to) ) {
- print "ADDINCPATH: $from -> $to\n" if $opt_verbose;
-
- return 1 if $opt_check;
-
- my $save = $/;
- undef $/;
- open(FROM, "<$from");
- # slurp whole file in one big string
- my $content = <FROM>;
- close(FROM);
- $/ = $save;
-
- foreach $header (@$modify_headers_ref) {
- $content =~ s/#include [<"]$header[>"]/#include <$module\/$header>/g;
- }
-
- open(TO, ">$to");
- print TO $content;
- close(TO);
-
- utime($$from_stat_ref[9], $$from_stat_ref[9], $to);
- fix_file_permissions($$from_stat_ref[2], $to);
- return 1;
- }
- return 0;
-}
-
-sub push_on_ziplist
-{
- my $file = shift;
- return if ( $opt_check );
- # strip $dest from path since we don't want to record it in zip file
- if ( $file =~ s#^\Q$dest\E/##o ) {
- push(@zip_list, $file);
- } elsif ( $file =~ s#^\Q$common_dest\E/##o ) {
- push(@common_zip_list, $file);
- }
-}
-
-sub push_on_loglist
-{
- my @entry = @_;
- return 0 if ( $opt_check );
- return -1 if ( $#entry != 2 );
- if (( $entry[0] eq "COPY" ) || ( $entry[0] eq "ADDINCPATH" )) {
- return 0 if ( ! -e $entry[1].$maybedot );
- # make 'from' relative to source root
- $entry[1] = $repository ."/" . $module . "/prj/" . $entry[1];
- $entry[1] =~ s/$module\/prj\/\.\./$module/;
- }
- # platform or common tree?
- my $common;
- if ( $entry[2] =~ /^\Q$dest\E/ ) {
- $common = 0;
- } elsif ( $common_build && ( $entry[2] =~ /^\Q$common_dest\E/ )) {
- $common = 1;
- } else {
- warn "Neither common nor platform tree?";
- return;
- }
- # make 'to' relative to SOLARVERSION
- my $solarversion = $ENV{'SOLARVERSION'};
- $solarversion =~ s#\\#/#g;
- $entry[2] =~ s/^\Q$solarversion\E\///;
-
- if ( $common ) {
- push @common_log_list, [@entry];
- } else {
- push @log_list, [@entry];
- }
- return 1;
-}
-
-sub zip_files
-{
- my $zipexe = 'zip';
- $zipexe .= ' -y' unless $^O eq 'MSWin32';
-
- my ($platform_zip_file, $common_zip_file);
- $platform_zip_file = "%_DEST%/zip/$module.zip";
- $platform_zip_file = expand_macros($platform_zip_file);
- my (%dest_dir, %list_ref);
- $dest_dir{$platform_zip_file} = $dest;
- $list_ref{$platform_zip_file} = \@zip_list;
- if ( $common_build ) {
- $common_zip_file = "%COMMON_DEST%/zip/$module.zip";
- $common_zip_file = expand_macros($common_zip_file);
- $dest_dir{$common_zip_file} = $common_dest;
- $list_ref{$common_zip_file} = \@common_zip_list;
- }
-
- my @zipfiles;
- $zipfiles[0] = $platform_zip_file;
- if ( $common_build ) {
- push @zipfiles, ($common_zip_file);
- }
- foreach my $zip_file ( @zipfiles ) {
- print "ZIP: updating $zip_file\n" if $opt_verbose;
- next if ( $opt_check );
-
- if ( $opt_delete ) {
- if ( -e $zip_file ) {
- unlink $zip_file or die "Error: can't remove file '$zip_file': $!";
- }
- next;
- }
-
- local $work_file = "";
- if ( $zip_file eq $common_zip_file) {
- # Zip file in common tree: work on uniq copy to avoid collisions
- $work_file = $zip_file;
- $work_file =~ s/\.zip$//;
- $work_file .= (sprintf('.%d-%d', $$, time())) . ".zip";
- die "Error: temp file $work_file already exists" if ( -e $work_file);
- if ( -e $zip_file ) {
- if ( -z $zip_file) {
- # sometimes there are files of 0 byte size - remove them
- unlink $zip_file or print_error("can't remove empty file '$zip_file': $!",0);
- } else {
- if ( ! copy($zip_file, $work_file)) {
- # give a warning, not an error:
- # we can zip from scratch instead of just updating the old zip file
- print_warning("can't copy'$zip_file' into '$work_file': $!", 0);
- unlink $work_file;
- }
- }
- }
- } else {
- # No pre processing necessary, working directly on solver.
- $work_file = $zip_file;
- }
-
- # zip content has to be relative to $dest_dir
- chdir($dest_dir{$zip_file}) or die "Error: cannot chdir into $dest_dir{$zip_file}";
- my $this_ref = $list_ref{$zip_file};
- open(ZIP, "| $zipexe -q -o -u -@ $work_file") or die "error opening zip file";
- foreach $file ( @$this_ref ) {
- print "ZIP: adding $file to $zip_file\n" if $is_debug;
- print ZIP "$file\n";
- }
- close(ZIP);
- fix_broken_cygwin_created_zips($work_file) if $^O eq "cygwin";
-
- if ( $zip_file eq $common_zip_file) {
- # rename work file back
- if ( -e $work_file ) {
- if ( -e $zip_file) {
- # do some tricks to be fast. otherwise we may disturb other platforms
- # by unlinking a file which just gets copied -> stale file handle.
- my $buffer_file=$work_file . '_rm';
- rename($zip_file, $buffer_file) or warn "Warning: can't rename old zip file '$zip_file': $!";
- if (! rename($work_file, $zip_file)) {
- print_error("can't rename temporary file to $zip_file: $!",0);
- unlink $work_file;
- }
- unlink $buffer_file;
- } else {
- if (! rename($work_file, $zip_file)) {
- print_error("can't rename temporary file to $zip_file: $!",0);
- unlink $work_file;
- }
- }
- }
- }
- }
-}
-
-sub fix_broken_cygwin_created_zips
-# add given extension to or strip it from stored path
-{
- require Archive::Zip; import Archive::Zip;
- my $zip_file = shift;
-
- $zip = Archive::Zip->new();
- unless ( $zip->read($work_file) == AZ_OK ) {
- die "Error: can't open zip file '$zip_file' to fix broken cygwin file permissions";
- }
- my $latest_member_mod_time = 0;
- foreach $member ( $zip->members() ) {
- my $attributes = $member->unixFileAttributes();
- $attributes &= ~0xFE00;
- print $member->fileName() . ": " . sprintf("%lo", $attributes) if $is_debug;
- $attributes |= 0x10; # add group write permission
- print "-> " . sprintf("%lo", $attributes) . "\n" if $is_debug;
- $member->unixFileAttributes($attributes);
- if ( $latest_member_mod_time < $member->lastModTime() ) {
- $latest_member_mod_time = $member->lastModTime();
- }
- }
- die "Error: can't overwrite zip file '$zip_file' for fixing permissions" unless $zip->overwrite() == AZ_OK;
- utime($latest_member_mod_time, $latest_member_mod_time, $zip_file);
-}
-
-sub get_tempfilename
-{
- my $temp_dir = shift;
- $temp_dir = ( -d '/tmp' ? '/tmp' : $ENV{TMPDIR} || $ENV{TEMP} || '.' )
- unless defined($temp_dir);
- if ( ! -d $temp_dir ) {
- die "no temp directory $temp_dir\n";
- }
- my $base_name = sprintf( "%d-%di-%d", $$, time(), $tempcounter++ );
- return "$temp_dir/$base_name";
-}
-
-sub write_log
-{
- my (%log_file, %file_date);
- $log_file{\@log_list} = "%_DEST%/inc/$module/deliver.log";
- $log_file{\@common_log_list} = "%COMMON_DEST%/inc/$module/deliver.log";
- $file_date{\@log_list} = $logfiledate;
- $file_date{\@common_log_list} = $commonlogfiledate;
-
- my @logs = ( \@log_list );
- push @logs, ( \@common_log_list ) if ( $common_build );
- foreach my $log ( @logs ) {
- $log_file{$log} = expand_macros( $log_file{$log} );
- if ( $opt_delete ) {
- print "LOG: removing $log_file{$log}\n" if $opt_verbose;
- next if ( $opt_check );
- unlink $log_file{$log};
- } else {
- print "LOG: writing $log_file{$log}\n" if $opt_verbose;
- next if ( $opt_check );
- open( LOGFILE, "> $log_file{$log}" ) or warn "Error: could not open log file.";
- foreach my $item ( @$log ) {
- print LOGFILE "@$item\n";
- }
- close( LOGFILE );
- utime($file_date{$log}, $file_date{$log}, $log_file{$log});
- }
- push_on_ziplist( $log_file{$log} ) if $opt_zip;
- }
- return;
-}
-
-sub check_dlst
-{
- my %createddir;
- my %destdir;
- my %destfile;
- # get all checkable actions to perform
- foreach my $action ( @action_data ) {
- my $path = expand_macros( $$action[1] );
- if ( $$action[0] eq 'mkdir' ) {
- $createddir{$path} ++;
- } elsif (( $$action[0] eq 'copy' ) || ( $$action[0] eq 'addincpath' )) {
- my ($from, $to) = split(' ', $path);
- my ($to_fname, $to_dir);
- my $withwildcard = 0;
- if ( $from =~ /[\*\?\[\]]/ ) {
- $withwildcard = 1;
- }
- ($to_fname, $to_dir) = fileparse($to);
- if ( $withwildcard ) {
- if ( $to !~ /[\*\?\[\]]/ ) {
- $to_dir = $to;
- $to_fname ='';
- }
- }
- $to_dir =~ s/[\\\/\s]$//;
- $destdir{$to_dir} ++;
- # Check: copy into non existing directory?
- if ( ! $createddir{$to_dir} ) {
- # unfortunately it is not so easy: it's OK if a subdirectory of $to_dir
- # gets created, because mkpath creates the whole tree
- foreach my $directory ( keys %createddir ) {
- if ( $directory =~ /^\Q$to_dir\E[\\\/]/ ) {
- $createddir{$to_dir} ++;
- last;
- }
- }
- print_warning("Possibly copying into directory without creating in before: '$to_dir'")
- unless $createddir{$to_dir};
- }
- # Check: overwrite file?
- if ( ! $to ) {
- if ( $destfile{$to} ) {
- print_warning("Multiple entries copying to '$to'");
- }
- $destfile{$to} ++;
- }
- }
- }
-}
-
-sub cleanup
-{
- # remove empty directories
- foreach my $path ( @dirlist ) {
- $path = expand_macros($path);
- if ( $opt_check ) {
- print "RMDIR: $path\n" if $opt_verbose;
- } else {
- rmdir $path;
- }
- }
-}
-
-sub delete_output
-{
- my $output_path = expand_macros("../%__SRC%");
- if ( "$output_path" ne "../" ) {
- if ( rmtree([$output_path], 0, 1) ) {
- print "Deleted output tree.\n" if $opt_verbose;
- }
- else {
- print_error("Error deleting output tree $output_path: $!",0);
- }
- }
- else {
- print_error("Output not deleted - INPATH is not set");
- }
-}
-
-sub print_warning
-{
- my $message = shift;
- my $line = shift;
-
- print STDERR "$script_name: ";
- if ( $dlst_file ) {
- print STDERR "$dlst_file: ";
- }
- if ( $line ) {
- print STDERR "line $line: ";
- }
- print STDERR "WARNING: $message\n";
-}
-
-sub print_error
-{
- my $message = shift;
- my $line = shift;
-
- print STDERR "$script_name: ";
- if ( $dlst_file ) {
- print STDERR "$dlst_file: ";
- }
- if ( $line ) {
- print STDERR "line $line: ";
- }
- print STDERR "ERROR: $message\n";
- $error ++;
-}
-
-sub print_stats
-{
- print "Module '$module' delivered ";
- if ( $error ) {
- print "with errors\n";
- } else {
- print "successfully.";
- if ( $opt_delete ) {
- print " $files_copied files removed,";
- }
- else {
- print " $files_copied files copied,";
- }
- print " $files_unchanged files unchanged\n";
- }
-}
-
-sub cleanup_and_die
-{
- # clean up on unexpected termination
- my $sig = shift;
- if ( defined($temp_file) && -e $temp_file ) {
- unlink($temp_file);
- }
- if ( defined($work_file) && -e $work_file ) {
- unlink($work_file);
- print STDERR "$work_file removed\n";
- }
-
- die "caught unexpected signal $sig, terminating ...";
-}
-
-sub usage
-{
- my $exit_code = shift;
- print STDERR "Usage:\ndeliver [OPTIONS] [DESTINATION-PATH]\n";
- print STDERR "Options:\n";
- print STDERR " -check just print what would happen, no actual copying of files\n";
- print STDERR " -checkdlst be verbose about (possible) d.lst bugs\n";
- print STDERR " -delete delete files (undeliver), use with care\n";
- print STDERR " -deloutput remove the output tree after copying\n";
- print STDERR " -dontdeletecommon do not delete common files (for -delete option)\n";
- print STDERR " -force copy even if not newer\n";
- print STDERR " -help print this message\n";
- if ( !defined($ENV{GUI}) || $ENV{GUI} ne 'WNT' ) {
- print STDERR " -link hard link files into the solver to save disk space\n";
- }
- print STDERR " -quiet be quiet, only report errors\n";
- print STDERR " -verbose be verbose\n";
- print STDERR " -zip additionally create zip files of delivered content\n";
- print STDERR "Options '-zip' and a destination-path are mutually exclusive.\n";
- print STDERR "Options '-check' and '-quiet' are mutually exclusive.\n";
- exit($exit_code);
-}
-
-# vim: set ts=4 shiftwidth=4 expandtab syntax=perl: