xref: /aoo41x/main/solenv/bin/zipdep.pl (revision 810a4bfd)
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