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