]>
Commit | Line | Data |
---|---|---|
6566e5f2 MT |
1 | #!/usr/bin/perl |
2 | ||
a09bac73 | 3 | # RPM (and its source code) is covered under two separate licenses. |
6566e5f2 MT |
4 | |
5 | # The entire code base may be distributed under the terms of the GNU | |
6 | # General Public License (GPL), which appears immediately below. | |
7 | # Alternatively, all of the source code in the lib subdirectory of the | |
8 | # RPM source code distribution as well as any code derived from that | |
9 | # code may instead be distributed under the GNU Library General Public | |
10 | # License (LGPL), at the choice of the distributor. The complete text | |
11 | # of the LGPL appears at the bottom of this file. | |
12 | ||
13 | # This alternatively is allowed to enable applications to be linked | |
14 | # against the RPM library (commonly called librpm) without forcing | |
15 | # such applications to be distributed under the GPL. | |
16 | ||
17 | # Any questions regarding the licensing of RPM should be addressed to | |
18 | # Erik Troan <ewt@redhat.com>. | |
19 | ||
20 | # a simple makedepend like script for perl. | |
a09bac73 MT |
21 | |
22 | # To save development time I do not parse the perl grammar but | |
6566e5f2 MT |
23 | # instead just lex it looking for what I want. I take special care to |
24 | # ignore comments and pod's. | |
25 | ||
26 | # It would be much better if perl could tell us the dependencies of a | |
27 | # given script. | |
28 | ||
29 | # The filenames to scan are either passed on the command line or if | |
30 | # that is empty they are passed via stdin. | |
31 | ||
32 | # If there are strings in the file which match the pattern | |
33 | # m/^\s*\$RPM_Requires\s*=\s*["'](.*)['"]/i | |
34 | # then these are treated as additional names which are required by the | |
35 | # file and are printed as well. | |
36 | ||
37 | # I plan to rewrite this in C so that perl is not required by RPM at | |
38 | # build time. | |
39 | ||
40 | # by Ken Estes Mail.com kestes@staff.mail.com | |
41 | ||
a09bac73 MT |
42 | $HAVE_VERSION = 0; |
43 | eval { require version; $HAVE_VERSION = 1; }; | |
44 | ||
45 | ||
6566e5f2 MT |
46 | if ("@ARGV") { |
47 | foreach (@ARGV) { | |
48 | process_file($_); | |
49 | } | |
50 | } else { | |
a09bac73 | 51 | |
6566e5f2 MT |
52 | # notice we are passed a list of filenames NOT as common in unix the |
53 | # contents of the file. | |
a09bac73 | 54 | |
6566e5f2 MT |
55 | foreach (<>) { |
56 | process_file($_); | |
57 | } | |
58 | } | |
59 | ||
60 | ||
a09bac73 MT |
61 | foreach $perlver (sort keys %perlreq) { |
62 | print "perl >= $perlver\n"; | |
63 | } | |
6566e5f2 MT |
64 | foreach $module (sort keys %require) { |
65 | if (length($require{$module}) == 0) { | |
66 | print "perl($module)\n"; | |
67 | } else { | |
68 | ||
69 | # I am not using rpm3.0 so I do not want spaces around my | |
70 | # operators. Also I will need to change the processing of the | |
71 | # $RPM_* variable when I upgrade. | |
72 | ||
a09bac73 | 73 | print "perl($module) >= $require{$module}\n"; |
6566e5f2 MT |
74 | } |
75 | } | |
76 | ||
77 | exit 0; | |
78 | ||
79 | ||
80 | ||
a09bac73 MT |
81 | sub add_require { |
82 | my ($module, $newver) = @_; | |
83 | my $oldver = $require{$module}; | |
84 | if ($oldver) { | |
85 | $require{$module} = $newver | |
86 | if ($HAVE_VERSION && $newver && version->new($oldver) < $newver); | |
87 | } | |
88 | else { | |
89 | $require{$module} = $newver; | |
90 | } | |
91 | } | |
92 | ||
6566e5f2 | 93 | sub process_file { |
a09bac73 | 94 | |
6566e5f2 MT |
95 | my ($file) = @_; |
96 | chomp $file; | |
a09bac73 MT |
97 | |
98 | if (!open(FILE, $file)) { | |
99 | warn("$0: Warning: Could not open file '$file' for reading: $!\n"); | |
100 | return; | |
101 | } | |
102 | ||
6566e5f2 | 103 | while (<FILE>) { |
a09bac73 | 104 | |
6566e5f2 MT |
105 | # skip the "= <<" block |
106 | ||
a09bac73 MT |
107 | if (m/^\s*\$(?:.*)\s*=\s*<<\s*(["'`])(.+?)\1/ || |
108 | m/^\s*\$(.*)\s*=\s*<<(\w+)\s*;/) { | |
6566e5f2 MT |
109 | $tag = $2; |
110 | while (<FILE>) { | |
111 | chomp; | |
112 | ( $_ eq $tag ) && last; | |
113 | } | |
114 | $_ = <FILE>; | |
115 | } | |
116 | ||
117 | # skip q{} quoted sections - just hope we don't have curly brackets | |
118 | # within the quote, nor an escaped hash mark that isn't a comment | |
119 | # marker, such as occurs right here. Draw the line somewhere. | |
a09bac73 | 120 | if ( m/^.*\Wq[qxwr]?\s*([{([#|\/])[^})\]#|\/]*$/ && ! m/^\s*(require|use)\s/ ) { |
6566e5f2 MT |
121 | $tag = $1; |
122 | $tag =~ tr/{\(\[\#|\//})]#|\//; | |
123 | while (<FILE>) { | |
124 | ( $_ =~ m/\}/ ) && last; | |
125 | } | |
126 | } | |
127 | ||
128 | # skip the documentation | |
129 | ||
130 | # we should not need to have item in this if statement (it | |
131 | # properly belongs in the over/back section) but people do not | |
132 | # read the perldoc. | |
133 | ||
a09bac73 MT |
134 | if (/^=(head[1-4]|pod|for|item)/) { |
135 | /^=cut/ && next while <FILE>; | |
6566e5f2 MT |
136 | } |
137 | ||
a09bac73 MT |
138 | if (/^=over/) { |
139 | /^=back/ && next while <FILE>; | |
6566e5f2 | 140 | } |
a09bac73 | 141 | |
6566e5f2 MT |
142 | # skip the data section |
143 | if (m/^__(DATA|END)__$/) { | |
144 | last; | |
145 | } | |
146 | ||
147 | # Each keyword can appear multiple times. Don't | |
148 | # bother with datastructures to store these strings, | |
149 | # if we need to print it print it now. | |
150 | # | |
a09bac73 MT |
151 | # Again allow for "our". |
152 | if (m/^\s*(our\s+)?\$RPM_Requires\s*=\s*["'](.*)['"]/i) { | |
6566e5f2 | 153 | foreach $_ (split(/\s+/, $2)) { |
a09bac73 | 154 | print "$_\n"; |
6566e5f2 MT |
155 | } |
156 | } | |
157 | ||
a09bac73 MT |
158 | my $modver_re = qr/[.0-9]+/; |
159 | ||
160 | if ( | |
6566e5f2 MT |
161 | |
162 | # ouch could be in a eval, perhaps we do not want these since we catch | |
163 | # an exception they must not be required | |
164 | ||
165 | # eval { require Term::ReadLine } or die $@; | |
166 | # eval "require Term::Rendezvous;" or die $@; | |
167 | # eval { require Carp } if defined $^S; # If error/warning during compilation, | |
168 | ||
169 | ||
a09bac73 MT |
170 | (m/^(\s*) # we hope the inclusion starts the line |
171 | (require|use)\s+(?!\{) # do not want 'do {' loops | |
172 | # quotes around name are always legal | |
173 | ['"]?([^; '"\t#]+)['"]?[\t; ] | |
174 | # the syntax for 'use' allows version requirements | |
175 | # the latter part is for "use base qw(Foo)" and friends special case | |
176 | \s*($modver_re|(qw\s*[(\/'"]\s*|['"])[^)\/"'\$]*?\s*[)\/"'])? | |
177 | /x) | |
6566e5f2 | 178 | ) { |
a09bac73 | 179 | my ($whitespace, $statement, $module, $version) = ($1, $2, $3, $4); |
6566e5f2 | 180 | |
a09bac73 | 181 | # we only consider require statements that are flushed against |
6566e5f2 MT |
182 | # the left edge. any other require statements give too many |
183 | # false positives, as they are usually inside of an if statement | |
184 | # as a fallback module or a rarely used option | |
185 | ||
186 | ($whitespace ne "" && $statement eq "require") && next; | |
187 | ||
188 | # if there is some interpolation of variables just skip this | |
189 | # dependency, we do not want | |
190 | # do "$ENV{LOGDIR}/$rcfile"; | |
a09bac73 | 191 | |
6566e5f2 MT |
192 | ($module =~ m/\$/) && next; |
193 | ||
194 | # skip if the phrase was "use of" -- shows up in gimp-perl, et al. | |
195 | next if $module eq 'of'; | |
196 | ||
a09bac73 | 197 | # if the module ends in a comma we probably caught some |
6566e5f2 MT |
198 | # documentation of the form 'check stuff,\n do stuff, clean |
199 | # stuff.' there are several of these in the perl distribution | |
200 | ||
201 | ($module =~ m/[,>]$/) && next; | |
202 | ||
203 | # if the module name starts in a dot it is not a module name. | |
204 | # Is this necessary? Please give me an example if you turn this | |
205 | # back on. | |
206 | ||
207 | # ($module =~ m/^\./) && next; | |
208 | ||
a09bac73 | 209 | # if the module starts with /, it is an absolute path to a file |
6566e5f2 MT |
210 | if ($module =~ m(^/)) { |
211 | print "$module\n"; | |
212 | next; | |
213 | } | |
214 | ||
215 | # sometimes people do use POSIX qw(foo), or use POSIX(qw(foo)) etc. | |
216 | # we can strip qw.*$, as well as (.*$: | |
217 | $module =~ s/qw.*$//; | |
218 | $module =~ s/\(.*$//; | |
219 | ||
a09bac73 | 220 | # if the module ends with .pm, strip it to leave only basename. |
6566e5f2 MT |
221 | $module =~ s/\.pm$//; |
222 | ||
a09bac73 | 223 | # some perl programmers write 'require URI/URL;' when |
6566e5f2 MT |
224 | # they mean 'require URI::URL;' |
225 | ||
226 | $module =~ s/\//::/; | |
227 | ||
228 | # trim off trailing parentheses if any. Sometimes people pass | |
229 | # the module an empty list. | |
230 | ||
231 | $module =~ s/\(\s*\)$//; | |
232 | ||
233 | if ( $module =~ m/^v?([0-9._]+)$/ ) { | |
234 | # if module is a number then both require and use interpret that | |
235 | # to mean that a particular version of perl is specified | |
236 | ||
a09bac73 | 237 | my $ver = $1; |
6566e5f2 | 238 | if ($ver =~ /5.00/) { |
a09bac73 | 239 | $perlreq{"0:$ver"} = 1; |
6566e5f2 MT |
240 | next; |
241 | } | |
242 | else { | |
a09bac73 | 243 | $perlreq{"1:$ver"} = 1; |
6566e5f2 MT |
244 | next; |
245 | } | |
246 | ||
247 | }; | |
248 | ||
249 | # ph files do not use the package name inside the file. | |
250 | # perlmodlib documentation says: | |
a09bac73 | 251 | |
6566e5f2 MT |
252 | # the .ph files made by h2ph will probably end up as |
253 | # extension modules made by h2xs. | |
a09bac73 | 254 | |
6566e5f2 MT |
255 | # so do not expend much effort on these. |
256 | ||
257 | ||
258 | # there is no easy way to find out if a file named systeminfo.ph | |
259 | # will be included with the name sys/systeminfo.ph so only use the | |
260 | # basename of *.ph files | |
261 | ||
a09bac73 MT |
262 | ($module =~ m/\.ph$/) && next; |
263 | ||
264 | # use base qw(Foo) dependencies | |
265 | if ($statement eq "use" && $module eq "base") { | |
266 | add_require($module, undef); | |
267 | if ($version =~ /^qw\s*[(\/'"]\s*([^)\/"']+?)\s*[)\/"']/) { | |
268 | add_require($_, undef) for split(' ', $1); | |
269 | } | |
270 | elsif ($version =~ /(["'])([^"']+)\1/) { | |
271 | add_require($2, undef); | |
272 | } | |
273 | next; | |
274 | } | |
275 | $version = undef unless $version =~ /^$modver_re$/o; | |
6566e5f2 | 276 | |
a09bac73 | 277 | add_require($module, $version); |
6566e5f2 | 278 | } |
a09bac73 | 279 | |
6566e5f2 MT |
280 | } |
281 | ||
282 | close(FILE) || | |
283 | die("$0: Could not close file: '$file' : $!\n"); | |
a09bac73 MT |
284 | |
285 | return; | |
6566e5f2 | 286 | } |