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