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 return $path; 114}; 115 116# 117# Collect all files to zip in @patterns_array array 118# 119sub get_zip_content { 120 &get_zip_entries(\@given_patterns); 121 my $file_name = ''; 122 foreach $file_name (keys %files_in_arch) { 123 if (-d $file_name) { 124 &get_dir_content($file_name, \%files_in_arch) if ($r || $R); 125 undef $files_in_arch{$file_name}; 126 }; 127 }; 128 &remove_uncompliant(\@given_patterns) if ($R); 129 &get_patterns_files(\@exc_patterns, \%exc_files_hash) if ($exclude); 130 &get_patterns_files(\@inc_patterns, \%inc_files_hash) if ($include); 131 foreach my $file_name (keys %exc_files_hash) { 132 if (defined $files_in_arch{$file_name}) { 133 delete $files_in_arch{$file_name}; 134 #print STDERR "excluded $file_name\n"; 135 }; 136 }; 137 if ($include) { 138 foreach my $file_name (keys %files_in_arch) { 139 if (!(defined $inc_files_hash{$file_name})) { 140 delete $files_in_arch{$file_name}; 141 }; 142 }; 143 } 144}; 145 146# 147# Procedure removes from %files_in_arch all files which 148# are not compliant to patterns in @given_patterns 149# 150sub remove_uncompliant { 151 my $given_patterns = shift; 152 my @reg_exps = (); 153 my $pattern = ''; 154 foreach $pattern (@$given_patterns) { 155 push(@reg_exps, &make_reg_exp($pattern)); 156 }; 157 # write file name as a value for the path(key) 158 foreach my $file (keys %files_in_arch) { 159 next if (-d $file); 160 #print "$file\n"; 161 if ($file =~ /[\\ | \/](.+)$/) { 162 $files_in_arch{$file} = $1; 163 } else { 164 $files_in_arch{$file} = $file; 165 }; 166 }; 167 foreach $pattern (@reg_exps) { 168 foreach my $file (keys %files_in_arch) { 169 if (!($files_in_arch{$file} =~ /$pattern/)) { 170 delete $files_in_arch{$file}; 171 #} else { 172 # print "Complient: $file\n"; 173 }; 174 }; 175 }; 176}; 177 178# 179# Procedure adds/removes to/from %files_in_arch all files, that are 180# compliant to the patterns in array passed 181# 182sub get_zip_entries { 183 if ($R) { 184 opendir DIR, '.'; 185 my @dir_content = readdir(DIR); 186 close DIR; 187 foreach my $file_name(@dir_content) { 188 $file_name =~ /^\.$/ and next; 189 $file_name =~ /^\.\.$/ and next; 190 $files_in_arch{$file_name}++; 191 #print "included $file_name\n"; 192 }; 193 } else { 194 my $patterns_array = shift; 195 my $pattern = ''; 196 foreach $pattern (@$patterns_array) { 197 if ((-d $pattern) || (-f $pattern)) { 198 $files_in_arch{$pattern}++; 199 next; 200 } 201 my $file_name = ''; 202 foreach $file_name (glob $pattern) { 203 #next if (!(-d $file_name) || !(-f $file_name)); 204 $files_in_arch{$file_name}++; 205 }; 206 }; 207 } 208}; 209 210# 211# Procedure converts given parameter to a regular expression 212# 213sub make_reg_exp { 214 my $arg = shift; 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 =~ s/\?/\./g; 223 #$arg = '/'.$arg.'/'; 224 #print "Regular expression: $arg\n"; 225 return $arg; 226}; 227 228# 229# Procedure retrieves shell pattern and converts them into regular expressions 230# 231sub get_patterns { 232 my $patterns = shift; 233 my $arg = ''; 234 while ($arg = shift @ARGV) { 235 $arg =~ /^-/ and unshift(@ARGV, $arg) and return; 236 if (!$zip_file) { 237 $zip_file = $arg; 238 next; 239 }; 240 $arg = &make_reg_exp($arg); 241 push(@$patterns, $arg); 242 }; 243}; 244 245# 246# Get all options passed 247# 248sub get_options { 249 my ($arg); 250 &usage() && exit(0) if ($#ARGV == -1); 251 while ($arg = shift @ARGV) { 252 $arg = &perled_slashes($arg); 253 #print STDERR "$arg\n"; 254 $arg =~ /^-R$/ and $R = 1 and next; 255 $arg =~ /^-r$/ and $r = 1 and next; 256 $arg =~ /^-x$/ and $exclude = 1 and &get_patterns(\@exc_patterns) and next; 257 $arg =~ /^-i$/ and $include = 1 and &get_patterns(\@inc_patterns) and next; 258 $arg =~ /^-prefix$/ and $prefix = shift @ARGV and next; 259 $arg =~ /^-b$/ and shift @ARGV and next; 260 $arg =~ /^-n$/ and shift @ARGV and next; 261 $arg =~ /^-t$/ and shift @ARGV and next; 262 $arg =~ /^-tt$/ and shift @ARGV and next; 263 $arg =~ /^-h$/ and &usage and exit(0); 264 $arg =~ /^--help$/ and &usage and exit(0); 265 $arg =~ /^-?$/ and &usage and exit(0); 266 if ($arg =~ /^-(\w)(\w+)$/) { 267 unshift (@ARGV, '-'.$1); 268 unshift (@ARGV, '-'.$2); 269 next; 270 }; 271# just ignore other switches... 272 $arg =~ /^-(\w+)$/ and next; 273 $arg =~ /^\/\?$/ and &usage and exit(0); 274 $zip_file = $arg and next if (!$zip_file); 275 push(@given_patterns, $arg); 276 }; 277 &print_error('error: Invalid command arguments (do not specify both -r and -R)') if ($r && $R); 278 if ($r && ($#given_patterns == -1)) { 279 &print_error('no list specified'); 280 }; 281}; 282 283# 284# Procedure fills out passed hash with files from passed dir 285# compliant to the pattern from @$patterns 286# 287sub get_patterns_files { 288 my $patterns_array = shift; 289 my $files_hash = shift; 290 my @zip_files = keys %files_in_arch; 291 foreach my $pattern (@$patterns_array) { 292 my @fit_pattern = grep /$pattern/, @zip_files; 293 foreach my $entry (@fit_pattern) { 294 $$files_hash{$entry}++; 295 #print "$entry\n"; 296 }; 297 }; 298}; 299 300# 301# Get dir stuff to pack 302# 303sub get_dir_content { 304 my $dir = shift; 305 my $dir_hash_ref = shift; 306 my $entry = ''; 307 if (opendir(DIR, $dir)) { 308 my @prj_dir_list = readdir(DIR); 309 closedir (DIR); 310 foreach $entry (@prj_dir_list) { 311 $entry =~ /^\.$/ and next; 312 $entry =~ /^\.\.$/ and next; 313 314 $entry = $dir . '/' . $entry; 315 # if $enry is a dir - read all its files, 316 # otherwise store $entry itself 317 if (-d $entry) { 318 &get_dir_content($entry, $dir_hash_ref); 319 } else { 320 $$dir_hash_ref{$entry}++; 321 }; 322 }; 323 }; 324 return '1'; 325}; 326 327sub print_error { 328 my $message = shift; 329 print STDERR "\nERROR: $message\n"; 330 exit (1); 331}; 332 333sub usage { 334 print STDERR " zipdep [-aABcdDeEfFghjklLmoqrRSTuvVwXyz] [-b path]\n"; 335 print STDERR " [-n suffixes] [-t mmddyyyy] [-tt mmddyyyy] [ zipfile [\n"; 336 print STDERR " file1 file2 ...]] [-xi list]\n"; 337} 338 339