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