]>
Commit | Line | Data |
---|---|---|
235217d2 MT |
1 | #!/usr/bin/perl |
2 | ||
3 | # RPM (and its source code) is covered under two separate licenses. | |
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. | |
21 | ||
22 | # To save development time I do not parse the perl grammmar but | |
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 | ||
42 | if ("@ARGV") { | |
43 | foreach (@ARGV) { | |
44 | process_file($_); | |
45 | } | |
46 | } else { | |
47 | ||
48 | # notice we are passed a list of filenames NOT as common in unix the | |
49 | # contents of the file. | |
50 | ||
51 | foreach (<>) { | |
52 | process_file($_); | |
53 | } | |
54 | } | |
55 | ||
56 | ||
57 | foreach $module (sort keys %require) { | |
58 | if (length($require{$module}) == 0) { | |
59 | print "perl($module)\n"; | |
60 | } else { | |
61 | ||
62 | # I am not using rpm3.0 so I do not want spaces around my | |
63 | # operators. Also I will need to change the processing of the | |
64 | # $RPM_* variable when I upgrade. | |
65 | ||
66 | print "perl($module)>=$require{$module}\n"; | |
67 | } | |
68 | } | |
69 | ||
70 | exit 0; | |
71 | ||
72 | ||
73 | ||
74 | sub process_file { | |
75 | ||
76 | my ($file) = @_; | |
77 | chomp $file; | |
78 | ||
79 | open(FILE, "<$file") || return; | |
80 | ||
81 | while (<FILE>) { | |
82 | ||
83 | # skip the "= <<" block | |
84 | ||
85 | if ( ( m/^\s*\$(?:.*)\s*=\s*<<\s*(["'`])(.*)\1/) || | |
86 | ( m/^\s*\$(.*)\s*=\s*<<(\w*)\s*;/) ) { | |
87 | $tag = $2; | |
88 | while (<FILE>) { | |
89 | chomp; | |
90 | ( $_ eq $tag ) && last; | |
91 | } | |
92 | $_ = <FILE>; | |
93 | } | |
94 | ||
95 | # skip q{} quoted sections - just hope we don't have curly brackets | |
96 | # within the quote, nor an escaped hash mark that isn't a comment | |
97 | # marker, such as occurs right here. Draw the line somewhere. | |
98 | if ( m/^.*\Wq[qxwr]?\s*([\{\(\[#|\/])[^})\]#|\/]*$/ && ! m/^\s*(require|use)\s/ ) { | |
99 | $tag = $1; | |
100 | $tag =~ tr/{\(\[\#|\//})]#|\//; | |
101 | while (<FILE>) { | |
102 | ( $_ =~ m/\}/ ) && last; | |
103 | } | |
104 | } | |
105 | ||
106 | # skip the documentation | |
107 | ||
108 | # we should not need to have item in this if statement (it | |
109 | # properly belongs in the over/back section) but people do not | |
110 | # read the perldoc. | |
111 | ||
112 | if ( (m/^=(head[1-4]|pod|item)/) .. (m/^=(cut)/) ) { | |
113 | next; | |
114 | } | |
115 | ||
116 | if ( (m/^=(over)/) .. (m/^=(back)/) ) { | |
117 | next; | |
118 | } | |
119 | ||
120 | # skip the data section | |
121 | if (m/^__(DATA|END)__$/) { | |
122 | last; | |
123 | } | |
124 | ||
125 | # Each keyword can appear multiple times. Don't | |
126 | # bother with datastructures to store these strings, | |
127 | # if we need to print it print it now. | |
128 | # | |
129 | # Again allow for "our". | |
130 | if ( m/^\s*(our\s+)?\$RPM_Requires\s*=\s*["'](.*)['"]/i) { | |
131 | foreach $_ (split(/\s+/, $2)) { | |
132 | print "$_\n"; | |
133 | } | |
134 | } | |
135 | ||
136 | if ( | |
137 | ||
138 | # ouch could be in a eval, perhaps we do not want these since we catch | |
139 | # an exception they must not be required | |
140 | ||
141 | # eval { require Term::ReadLine } or die $@; | |
142 | # eval "require Term::Rendezvous;" or die $@; | |
143 | # eval { require Carp } if defined $^S; # If error/warning during compilation, | |
144 | ||
145 | ||
146 | (m/^(\s*) # we hope the inclusion starts the line | |
147 | (require|use)\s+(?!\{) # do not want 'do {' loops | |
148 | # quotes around name are always legal | |
149 | [\'\"]?([^\;\ \'\"\t]*)[\'\"]?[\t\;\ ] | |
150 | # the syntax for 'use' allows version requirements | |
151 | \s*([.0-9]*) | |
152 | /x) | |
153 | ) { | |
154 | my ($whitespace, $statement, $module, $version) = ($1, $2, $3,$4); | |
155 | ||
156 | # we only consider require statements that are flush against | |
157 | # the left edge. any other require statements give too many | |
158 | # false positives, as they are usually inside of an if statement | |
159 | # as a fallback module or a rarely used option | |
160 | ||
161 | ($whitespace ne "" && $statement eq "require") && next; | |
162 | ||
163 | # if there is some interpolation of variables just skip this | |
164 | # dependency, we do not want | |
165 | # do "$ENV{LOGDIR}/$rcfile"; | |
166 | ||
167 | ($module =~ m/\$/) && next; | |
168 | ||
169 | # skip if the phrase was "use of" -- shows up in gimp-perl, et al. | |
170 | next if $module eq 'of'; | |
171 | ||
172 | # if the module ends in a comma we probaly caught some | |
173 | # documentation of the form 'check stuff,\n do stuff, clean | |
174 | # stuff.' there are several of these in the perl distribution | |
175 | ||
176 | ($module =~ m/[,>]$/) && next; | |
177 | ||
178 | # if the module name starts in a dot it is not a module name. | |
179 | # Is this necessary? Please give me an example if you turn this | |
180 | # back on. | |
181 | ||
182 | # ($module =~ m/^\./) && next; | |
183 | ||
184 | # if the module ends with .pm strip it to leave only basename. | |
185 | # starts with /, which means its an absolute path to a file | |
186 | if ($module =~ m(^/)) { | |
187 | print "$module\n"; | |
188 | next; | |
189 | } | |
190 | ||
191 | # sometimes people do use POSIX qw(foo), or use POSIX(qw(foo)) etc. | |
192 | # we can strip qw.*$, as well as (.*$: | |
193 | $module =~ s/qw.*$//; | |
194 | $module =~ s/\(.*$//; | |
195 | ||
196 | $module =~ s/\.pm$//; | |
197 | ||
198 | # some perl programmers write 'require URI/URL;' when | |
199 | # they mean 'require URI::URL;' | |
200 | ||
201 | $module =~ s/\//::/; | |
202 | ||
203 | # trim off trailing parentheses if any. Sometimes people pass | |
204 | # the module an empty list. | |
205 | ||
206 | $module =~ s/\(\s*\)$//; | |
207 | ||
208 | if ( $module =~ m/^v?([0-9._]+)$/ ) { | |
209 | # if module is a number then both require and use interpret that | |
210 | # to mean that a particular version of perl is specified | |
211 | ||
212 | my $ver=$1; | |
213 | if ($ver =~ /5.00/) { | |
214 | print "perl>=0:$ver\n"; | |
215 | next; | |
216 | } | |
217 | else { | |
218 | print "perl>=1:$ver\n"; | |
219 | next; | |
220 | } | |
221 | ||
222 | }; | |
223 | ||
224 | # ph files do not use the package name inside the file. | |
225 | # perlmodlib documentation says: | |
226 | ||
227 | # the .ph files made by h2ph will probably end up as | |
228 | # extension modules made by h2xs. | |
229 | ||
230 | # so do not expend much effort on these. | |
231 | ||
232 | ||
233 | # there is no easy way to find out if a file named systeminfo.ph | |
234 | # will be included with the name sys/systeminfo.ph so only use the | |
235 | # basename of *.ph files | |
236 | ||
237 | ($module =~ m/\.ph$/) && next; | |
238 | ||
239 | $require{$module}=$version; | |
240 | $line{$module}=$_; | |
241 | } | |
242 | ||
243 | } | |
244 | ||
245 | close(FILE) || | |
246 | die("$0: Could not close file: '$file' : $!\n"); | |
247 | ||
248 | return ; | |
249 | } |