solenv/bin/zipdep.pl

   1 :
   2 eval '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 # mapgen  - generate a dependencies file for zip commando
  33 #
  34 use Cwd;
  35
  36 #########################
  37 #                       #
  38 #   Globale Variablen   #
  39 #                       #
  40 #########################
  41
  42 $zip_file = '';
  43 $R = '';
  44 $r = '';
  45 $exclude = '';
  46 $include = '';
  47 @given_patterns = ();   # patterns(files) list from command line
  48 %files_in_arch = ();
  49 @exc_patterns = ();     # array of all patterns for files to be excluded
  50 @inc_patterns = ();     # array of all patterns for files to be included
  51 %exc_files_hash = ();   # hash of files to be excluded (according to @exc_patterns)
  52 %inc_files_hash = ();   # hash of files to be included (according to @inc_patterns)
  53 $prefix = '';
  54
  55 #### main ####
  56
  57 &get_options;
  58 &get_zip_content;
  59 &write_zip_file;
  60
  61 #### end of main procedure ####
  62
  63 #########################
  64 #                       #
  65 #      Procedures       #
  66 #                       #
  67 #########################
  68
  69 #
  70 # procedure writes zipdep file
  71 #
  72 sub write_zip_file {
  73     my @dependencies = keys %files_in_arch;
  74     if ($#dependencies != -1) {
  75         print "\n". &convert_slashes($zip_file) . ' :';
  76         foreach (@dependencies) {
  77             next if (-d);
  78             print " \\\n\t" . $prefix . &convert_slashes($_);
  79         };
  80         print "\n\n";
  81     };
  82 };
  83
  84 #
  85 # convert slashes
  86 #
  87 sub convert_slashes {
  88     my $path = shift;
  89     $path =~ s/\//\$\//g;
  90     $path =~ s/\\/\$\//g;
  91     return $path;
  92 };
  93
  94 #
  95 # convert slashes to internal perl representation
  96 #
  97 sub perled_slashes {
  98     my $path = shift;
  99     $path =~ s/\\/\//g;
 100     $path =~ s/\/+/\//g;
 101     return $path;
 102 };
 103
 104 #
 105 # Collect all files to zip in @patterns_array array
 106 #
 107 sub get_zip_content {
 108     &get_zip_entries(\@given_patterns);
 109     my $file_name = '';
 110     foreach $file_name (keys %files_in_arch) {
 111         if (-d $file_name) {
 112             &get_dir_content($file_name, \%files_in_arch) if ($r || $R);
 113             undef $files_in_arch{$file_name};
 114         };
 115     };
 116     &remove_uncompliant(\@given_patterns) if ($R);
 117     &get_patterns_files(\@exc_patterns, \%exc_files_hash) if ($exclude);
 118     &get_patterns_files(\@inc_patterns, \%inc_files_hash) if ($include);
 119     foreach my $file_name (keys %exc_files_hash) {
 120         if (defined $files_in_arch{$file_name}) {
 121             delete $files_in_arch{$file_name};
 122             #print STDERR "excluded $file_name\n";
 123         };
 124     };
 125     if ($include) {
 126         foreach my $file_name (keys %files_in_arch) {
 127             if (!(defined $inc_files_hash{$file_name})) {
 128                 delete $files_in_arch{$file_name};
 129             };
 130         };
 131     }
 132 };
 133
 134 #
 135 # Procedure removes from %files_in_arch all files which
 136 # are not compliant to patterns in @given_patterns
 137 #
 138 sub remove_uncompliant {
 139     my $given_patterns = shift;
 140     my @reg_exps = ();
 141     my $pattern = '';
 142     foreach $pattern (@$given_patterns) {
 143         push(@reg_exps, &make_reg_exp($pattern));
 144     };
 145     # write file name as a value for the path(key)
 146     foreach my $file (keys %files_in_arch) {
 147         next if (-d $file);
 148         #print "$file\n";
 149         if ($file =~ /[\\ | \/](.+)$/) {
 150             $files_in_arch{$file} = $1;
 151         } else {
 152             $files_in_arch{$file} = $file;
 153         };
 154     };
 155     foreach $pattern (@reg_exps) {
 156         foreach my $file (keys %files_in_arch) {
 157             if (!($files_in_arch{$file} =~ /$pattern/)) {
 158                 delete $files_in_arch{$file};
 159             #} else {
 160             #   print "Complient: $file\n";
 161             };
 162         };
 163     };
 164 };
 165
 166 #
 167 # Procedure adds/removes to/from %files_in_arch all files, that are
 168 # compliant to the patterns in array passed
 169 #
 170 sub get_zip_entries {
 171     if ($R) {
 172         opendir DIR, '.';
 173         my @dir_content = readdir(DIR);
 174         close DIR;
 175         foreach my $file_name(@dir_content) {
 176             $file_name =~ /^\.$/ and next;
 177             $file_name =~ /^\.\.$/ and next;
 178             $files_in_arch{$file_name}++;
 179             #print "included $file_name\n";
 180         };
 181     } else {
 182         my $patterns_array = shift;
 183         my $pattern = '';
 184         foreach $pattern (@$patterns_array) {
 185             if ((-d $pattern) || (-f $pattern)) {
 186                 $files_in_arch{$pattern}++;
 187                 next;
 188             }
 189             my $file_name = '';
 190             foreach $file_name (glob $pattern) {
 191                 #next if (!(-d $file_name) || !(-f $file_name));
 192                 $files_in_arch{$file_name}++;
 193             };
 194         };
 195     }
 196 };
 197
 198 #
 199 # Procedure converts given parameter to a regular expression
 200 #
 201 sub make_reg_exp {
 202     my $arg = shift;
 203     $arg =~ s/\\/\\\\/g;
 204     $arg =~ s/\//\\\//g;
 205     $arg =~ s/\./\\\./g;
 206     $arg =~ s/\+/\\\+/g;
 207     $arg =~ s/\{/\\\{/g;
 208     $arg =~ s/\}/\\\}/g;
 209     $arg =~ s/\*/\.\*/g;
 210     $arg =~ s/\?/\./g;
 211     #$arg = '/'.$arg.'/';
 212     #print "Regular expression: $arg\n";
 213     return $arg;
 214 };
 215
 216 #
 217 # Procedure retrieves shell pattern and converts them into regular expressions
 218 #
 219 sub get_patterns {
 220     my $patterns = shift;
 221     my $arg = '';
 222     while ($arg = shift @ARGV) {
 223         $arg =~ /^-/    and unshift(@ARGV, $arg) and return;
 224         if (!$zip_file) {
 225             $zip_file = $arg;
 226             next;
 227         };
 228         $arg = &make_reg_exp($arg);
 229         push(@$patterns, $arg);
 230     };
 231 };
 232
 233 #
 234 # Get all options passed
 235 #
 236 sub get_options {
 237     my ($arg);
 238     &usage() && exit(0) if ($#ARGV == -1);
 239     while ($arg = shift @ARGV) {
 240         $arg = &perled_slashes($arg);
 241         #print STDERR "$arg\n";
 242         $arg =~ /^-R$/          and $R = 1  and next;
 243         $arg =~ /^-r$/          and $r = 1  and next;
 244         $arg =~ /^-x$/          and $exclude = 1 and &get_patterns(\@exc_patterns) and next;
 245         $arg =~ /^-i$/          and $include = 1 and &get_patterns(\@inc_patterns) and next;
 246         $arg =~ /^-prefix$/     and $prefix = shift @ARGV                   and next;
 247         $arg =~ /^-b$/          and shift @ARGV                 and next;
 248         $arg =~ /^-n$/          and shift @ARGV                 and next;
 249         $arg =~ /^-t$/          and shift @ARGV                 and next;
 250         $arg =~ /^-tt$/         and shift @ARGV                 and next;
 251         $arg =~ /^-h$/          and &usage                      and exit(0);
 252         $arg =~ /^--help$/      and &usage                      and exit(0);
 253         $arg =~ /^-?$/          and &usage                      and exit(0);
 254         if ($arg =~ /^-(\w)(\w+)$/) {
 255             unshift (@ARGV, '-'.$1);
 256             unshift (@ARGV, '-'.$2);
 257             next;
 258         };
 259 # just ignore other switches...
 260         $arg =~ /^-(\w+)$/      and next;
 261         $arg =~ /^\/\?$/            and &usage                      and exit(0);
 262         $zip_file = $arg        and next if (!$zip_file);
 263         push(@given_patterns, $arg);
 264     };
 265     &print_error('error: Invalid command arguments (do not specify both -r and -R)') if ($r && $R);
 266     if ($r && ($#given_patterns == -1)) {
 267         &print_error('no list specified');
 268     };
 269 };
 270
 271 #
 272 # Procedure fills out passed hash with files from passed dir
 273 # compliant to the pattern from @$patterns
 274 #
 275 sub get_patterns_files {
 276     my $patterns_array = shift;
 277     my $files_hash = shift;
 278     my @zip_files = keys %files_in_arch;
 279     foreach my $pattern (@$patterns_array) {
 280         my @fit_pattern = grep /$pattern/, @zip_files;
 281         foreach my $entry (@fit_pattern) {
 282             $$files_hash{$entry}++;
 283             #print "$entry\n";
 284         };
 285     };
 286 };
 287
 288 #
 289 # Get dir stuff to pack
 290 #
 291 sub get_dir_content {
 292     my $dir = shift;
 293     my $dir_hash_ref = shift;
 294     my $entry = '';
 295     if (opendir(DIR, $dir)) {
 296         my @prj_dir_list = readdir(DIR);
 297         closedir (DIR);
 298         foreach $entry (@prj_dir_list) {
 299             $entry =~ /^\.$/ and next;
 300             $entry =~ /^\.\.$/ and next;
 301
 302             $entry = $dir . '/' . $entry;
 303             # if $enry is a dir - read all its files,
 304             # otherwise store $entry itself
 305             if (-d $entry) {
 306                 &get_dir_content($entry, $dir_hash_ref);
 307             } else {
 308                 $$dir_hash_ref{$entry}++;
 309             };
 310         };
 311     };
 312     return '1';
 313 };
 314
 315 sub print_error {
 316     my $message = shift;
 317     print STDERR "\nERROR: $message\n";
 318     exit (1);
 319 };
 320
 321 sub usage {
 322     print STDERR "      zipdep  [-aABcdDeEfFghjklLmoqrRSTuvVwXyz]     [-b path]\n";
 323     print STDERR "      [-n suffixes]  [-t mmddyyyy]  [-tt mmddyyyy]  [  zipfile [\n";
 324     print STDERR "      file1 file2 ...]] [-xi list]\n";
 325 }
 326