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 2008 by Sun Microsystems, Inc.
   9 #
  10 # OpenOffice.org - a multi-platform office productivity suite
  11 #
  12 # $RCSfile: header.hxx,v $
  13 #
  14 # $Revision: 1.1 $
  15 #
  16 # This file is part of OpenOffice.org.
  17 #
  18 # OpenOffice.org is free software: you can redistribute it and/or modify
  19 # it under the terms of the GNU Lesser General Public License version 3
  20 # only, as published by the Free Software Foundation.
  21 #
  22 # OpenOffice.org is distributed in the hope that it will be useful,
  23 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  24 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  25 # GNU Lesser General Public License version 3 for more details
  26 # (a copy is included in the LICENSE file that accompanied this code).
  27 #
  28 # You should have received a copy of the GNU Lesser General Public License
  29 # version 3 along with OpenOffice.org.  If not, see
  30 # <http://www.openoffice.org/license.html>
  31 # for a copy of the LGPLv3 License.
  32 #
  33 #*************************************************************************
  34
  35 #
  36 # mapgen  - generate a dependencies file for zip commando
  37 #
  38 use Cwd;
  39
  40 #### script id #####
  41
  42 ( $script_name = $0 ) =~ s/^.*\b(\w+)\.pl$/$1/;
  43
  44 $id_str = ' $Revision: 1.12 $ ';
  45 $id_str =~ /Revision:\s+(\S+)\s+\$/
  46   ? ($script_rev = $1) : ($script_rev = "-");
  47
  48 print STDERR "$script_name -- version: $script_rev\n";
  49 print STDERR "Multi Platform Enabled Edition\n";
  50
  51 #########################
  52 #                       #
  53 #   Globale Variablen   #
  54 #                       #
  55 #########################
  56
  57 $zip_file = '';
  58 $R = '';
  59 $r = '';
  60 $exclude = '';
  61 $include = '';
  62 @given_patterns = ();   # patterns(files) list from command line
  63 %files_in_arch = ();
  64 @exc_patterns = ();     # array of all patterns for files to be excluded
  65 @inc_patterns = ();     # array of all patterns for files to be included
  66 %exc_files_hash = ();   # hash of files to be excluded (according to @exc_patterns)
  67 %inc_files_hash = ();   # hash of files to be included (according to @inc_patterns)
  68 $prefix = '';
  69
  70 #### main ####
  71
  72 &get_options;
  73 &get_zip_content;
  74 &write_zip_file;
  75
  76 #### end of main procedure ####
  77
  78 #########################
  79 #                       #
  80 #      Procedures       #
  81 #                       #
  82 #########################
  83
  84 #
  85 # procedure writes zipdep file
  86 #
  87 sub write_zip_file {
  88     my @dependencies = keys %files_in_arch;
  89     if ($#dependencies != -1) {
  90         print "\n". &convert_slashes($zip_file) . ' :';
  91         foreach (@dependencies) {
  92             next if (-d);
  93             print " \\\n\t" . $prefix . &convert_slashes($_);
  94         };
  95         print "\n\n";
  96     };
  97 };
  98
  99 #
 100 # convert slashes
 101 #
 102 sub convert_slashes {
 103     my $path = shift;
 104     $path =~ s/\//\$\//g;
 105     $path =~ s/\\/\$\//g;
 106     return $path;
 107 };
 108
 109 #
 110 # convert slashes to internal perl representation
 111 #
 112 sub perled_slashes {
 113     my $path = shift;
 114     $path =~ s/\\/\//g;
 115     $path =~ s/\/+/\//g;
 116     return $path;
 117 };
 118
 119 #
 120 # Collect all files to zip in @patterns_array array
 121 #
 122 sub get_zip_content {
 123     &get_zip_entries(\@given_patterns);
 124     my $file_name = '';
 125     foreach $file_name (keys %files_in_arch) {
 126         if (-d $file_name) {
 127             &get_dir_content($file_name, \%files_in_arch) if ($r || $R);
 128             undef $files_in_arch{$file_name};
 129         };
 130     };
 131     &remove_uncompliant(\@given_patterns) if ($R);
 132     &get_patterns_files(\@exc_patterns, \%exc_files_hash) if ($exclude);
 133     &get_patterns_files(\@inc_patterns, \%inc_files_hash) if ($include);
 134     foreach my $file_name (keys %exc_files_hash) {
 135         if (defined $files_in_arch{$file_name}) {
 136             delete $files_in_arch{$file_name};
 137             #print STDERR "excluded $file_name\n";
 138         };
 139     };
 140     if ($include) {
 141         foreach my $file_name (keys %files_in_arch) {
 142             if (!(defined $inc_files_hash{$file_name})) {
 143                 delete $files_in_arch{$file_name};
 144             };
 145         };
 146     }
 147 };
 148
 149 #
 150 # Procedure removes from %files_in_arch all files which
 151 # are not compliant to patterns in @given_patterns
 152 #
 153 sub remove_uncompliant {
 154     my $given_patterns = shift;
 155     my @reg_exps = ();
 156     my $pattern = '';
 157     foreach $pattern (@$given_patterns) {
 158         push(@reg_exps, &make_reg_exp($pattern));
 159     };
 160     # write file name as a value for the path(key)
 161     foreach my $file (keys %files_in_arch) {
 162         next if (-d $file);
 163         #print "$file\n";
 164         if ($file =~ /[\\ | \/](.+)$/) {
 165             $files_in_arch{$file} = $1;
 166         } else {
 167             $files_in_arch{$file} = $file;
 168         };
 169     };
 170     foreach $pattern (@reg_exps) {
 171         foreach my $file (keys %files_in_arch) {
 172             if (!($files_in_arch{$file} =~ /$pattern/)) {
 173                 delete $files_in_arch{$file};
 174             #} else {
 175             #   print "Complient: $file\n";
 176             };
 177         };
 178     };
 179 };
 180
 181 #
 182 # Procedure adds/removes to/from %files_in_arch all files, that are
 183 # compliant to the patterns in array passed
 184 #
 185 sub get_zip_entries {
 186     if ($R) {
 187         opendir DIR, '.';
 188         my @dir_content = readdir(DIR);
 189         close DIR;
 190         foreach my $file_name(@dir_content) {
 191             $file_name =~ /^\.$/ and next;
 192             $file_name =~ /^\.\.$/ and next;
 193             $files_in_arch{$file_name}++;
 194             #print "included $file_name\n";
 195         };
 196     } else {
 197         my $patterns_array = shift;
 198         my $pattern = '';
 199         foreach $pattern (@$patterns_array) {
 200             if ((-d $pattern) || (-f $pattern)) {
 201                 $files_in_arch{$pattern}++;
 202                 next;
 203             }
 204             my $file_name = '';
 205             foreach $file_name (glob $pattern) {
 206                 #next if (!(-d $file_name) || !(-f $file_name));
 207                 $files_in_arch{$file_name}++;
 208             };
 209         };
 210     }
 211 };
 212
 213 #
 214 # Procedure converts given parameter to a regular expression
 215 #
 216 sub make_reg_exp {
 217     my $arg = shift;
 218     $arg =~ s/\\/\\\\/g;
 219     $arg =~ s/\//\\\//g;
 220     $arg =~ s/\./\\\./g;
 221     $arg =~ s/\+/\\\+/g;
 222     $arg =~ s/\{/\\\{/g;
 223     $arg =~ s/\}/\\\}/g;
 224     $arg =~ s/\*/\.\*/g;
 225     $arg =~ s/\?/\./g;
 226     #$arg = '/'.$arg.'/';
 227     #print "Regular expression: $arg\n";
 228     return $arg;
 229 };
 230
 231 #
 232 # Procedure retrieves shell pattern and converts them into regular expressions
 233 #
 234 sub get_patterns {
 235     my $patterns = shift;
 236     my $arg = '';
 237     while ($arg = shift @ARGV) {
 238         $arg =~ /^-/    and unshift(@ARGV, $arg) and return;
 239         if (!$zip_file) {
 240             $zip_file = $arg;
 241             next;
 242         };
 243         $arg = &make_reg_exp($arg);
 244         push(@$patterns, $arg);
 245     };
 246 };
 247
 248 #
 249 # Get all options passed
 250 #
 251 sub get_options {
 252     my ($arg);
 253     &usage() && exit(0) if ($#ARGV == -1);
 254     while ($arg = shift @ARGV) {
 255         $arg = &perled_slashes($arg);
 256         #print STDERR "$arg\n";
 257         $arg =~ /^-R$/                  and $R = 1      and next;
 258         $arg =~ /^-r$/                  and $r = 1      and next;
 259         $arg =~ /^-x$/                  and $exclude = 1 and &get_patterns(\@exc_patterns) and next;
 260         $arg =~ /^-i$/                  and $include = 1 and &get_patterns(\@inc_patterns) and next;
 261         $arg =~ /^-prefix$/             and $prefix = shift @ARGV                                       and next;
 262         $arg =~ /^-b$/                  and shift @ARGV                                 and next;
 263         $arg =~ /^-n$/                  and shift @ARGV                                 and next;
 264         $arg =~ /^-t$/                  and shift @ARGV                                 and next;
 265         $arg =~ /^-tt$/                 and shift @ARGV                                 and next;
 266         $arg =~ /^-h$/                  and &usage                                              and exit(0);
 267         $arg =~ /^--help$/              and &usage                                              and exit(0);
 268         $arg =~ /^-?$/                  and &usage                                              and exit(0);
 269         if ($arg =~ /^-(\w)(\w+)$/) {
 270             unshift (@ARGV, '-'.$1);
 271             unshift (@ARGV, '-'.$2);
 272             next;
 273         };
 274 # just ignore other switches...
 275         $arg =~ /^-(\w+)$/              and     next;
 276         $arg =~ /^\/\?$/                        and &usage                                              and exit(0);
 277         $zip_file = $arg                and next if (!$zip_file);
 278         push(@given_patterns, $arg);
 279     };
 280     &print_error('error: Invalid command arguments (do not specify both -r and -R)') if ($r && $R);
 281     if ($r && ($#given_patterns == -1)) {
 282         &print_error('no list specified');
 283     };
 284 };
 285
 286 #
 287 # Procedure fills out passed hash with files from passed dir
 288 # compliant to the pattern from @$patterns
 289 #
 290 sub get_patterns_files {
 291     my $patterns_array = shift;
 292     my $files_hash = shift;
 293     my @zip_files = keys %files_in_arch;
 294     foreach my $pattern (@$patterns_array) {
 295         my @fit_pattern = grep /$pattern/, @zip_files;
 296         foreach my $entry (@fit_pattern) {
 297             $$files_hash{$entry}++;
 298             #print "$entry\n";
 299         };
 300     };
 301 };
 302
 303 #
 304 # Get dir stuff to pack
 305 #
 306 sub get_dir_content {
 307     my $dir = shift;
 308     my $dir_hash_ref = shift;
 309     my $entry = '';
 310     if (opendir(DIR, $dir)) {
 311         my @prj_dir_list = readdir(DIR);
 312         closedir (DIR);
 313         foreach $entry (@prj_dir_list) {
 314             $entry =~ /^\.$/ and next;
 315             $entry =~ /^\.\.$/ and next;
 316
 317             $entry = $dir . '/' . $entry;
 318             # if $enry is a dir - read all its files,
 319             # otherwise store $entry itself
 320             if (-d $entry) {
 321                 &get_dir_content($entry, $dir_hash_ref);
 322             } else {
 323                 $$dir_hash_ref{$entry}++;
 324             };
 325         };
 326     };
 327     return '1';
 328 };
 329
 330 sub print_error {
 331     my $message = shift;
 332     print STDERR "\nERROR: $message\n";
 333     exit (1);
 334 };
 335
 336 sub usage {
 337     print STDERR "      zipdep  [-aABcdDeEfFghjklLmoqrRSTuvVwXyz]     [-b path]\n";
 338     print STDERR "      [-n suffixes]  [-t mmddyyyy]  [-tt mmddyyyy]  [  zipfile [\n";
 339     print STDERR "      file1 file2 ...]] [-xi list]\n";
 340 }
 341