1#!/usr/local/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 grammar 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$HAVE_VERSION = 0; 43eval { require version; $HAVE_VERSION = 1; }; 44 45 46if ("@ARGV") { 47 foreach (@ARGV) { 48 process_file($_); 49 } 50} else { 51 52 # notice we are passed a list of filenames NOT as common in unix the 53 # contents of the file. 54 55 foreach (<>) { 56 process_file($_); 57 } 58} 59 60 61foreach $perlver (sort keys %perlreq) { 62 print "perl >= $perlver\n"; 63} 64foreach $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 73 print "perl($module) >= $require{$module}\n"; 74 } 75} 76 77exit 0; 78 79 80 81sub 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 93sub process_file { 94 95 my ($file) = @_; 96 chomp $file; 97 98 if (!open(FILE, $file)) { 99 warn("$0: Warning: Could not open file '$file' for reading: $!\n"); 100 return; 101 } 102 103 while (<FILE>) { 104 105 # skip the "= <<" block 106 107 if (m/^\s*(?:my\s*)?\$(?:.*)\s*=\s*<<\s*(["'`])(.+?)\1/ || 108 m/^\s*(?:my\s*)?\$(.*)\s*=\s*<<(\w+)\s*;/) { 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. 120 if ( m/^.*\Wq[qxwr]?\s*([{([#|\/])[^})\]#|\/]*$/ && ! m/^\s*(require|use)\s/ ) { 121 $tag = $1; 122 $tag =~ tr/{\(\[\#|\//})]#|\//; 123 $tag = quotemeta($tag); 124 while (<FILE>) { 125 ( $_ =~ m/$tag/ ) && last; 126 } 127 } 128 129 # skip the documentation 130 131 # we should not need to have item in this if statement (it 132 # properly belongs in the over/back section) but people do not 133 # read the perldoc. 134 135 if (/^=(head[1-4]|pod|for|item)/) { 136 /^=cut/ && next while <FILE>; 137 } 138 139 if (/^=over/) { 140 /^=back/ && next while <FILE>; 141 } 142 143 # skip the data section 144 if (m/^__(DATA|END)__$/) { 145 last; 146 } 147 148 # Each keyword can appear multiple times. Don't 149 # bother with datastructures to store these strings, 150 # if we need to print it print it now. 151 # 152 # Again allow for "our". 153 if (m/^\s*(our\s+)?\$RPM_Requires\s*=\s*["'](.*)['"]/i) { 154 foreach $_ (split(/\s+/, $2)) { 155 print "$_\n"; 156 } 157 } 158 159 my $modver_re = qr/[.0-9]+/; 160 161 # 162 # The (require|use) match further down in this subroutine will match lines 163 # within a multi-line print or return statements. So, let's skip over such 164 # statements whose content should not be loading modules anyway. -BEF- 165 # 166 if (m/print(?:\s+|\s+\S+\s+)\<\<\s*(["'`])(.+?)\1/ || 167 m/print(\s+|\s+\S+\s+)\<\<(\w+)/ || 168 m/return(\s+)\<\<(\w+)/ ) { 169 170 my $tag = $2; 171 while (<FILE>) { 172 chomp; 173 ( $_ eq $tag ) && last; 174 } 175 $_ = <FILE>; 176 } 177 178 # Skip multiline print and assign statements 179 if ( m/\$\S+\s*=\s*(")([^"\\]|(\\.))*$/ || 180 m/\$\S+\s*=\s*(')([^'\\]|(\\.))*$/ || 181 m/print\s+(")([^"\\]|(\\.))*$/ || 182 m/print\s+(')([^'\\]|(\\.))*$/ ) { 183 184 my $quote = $1; 185 while (<FILE>) { 186 m/^([^\\$quote]|(\\.))*$quote/ && last; 187 } 188 $_ = <FILE>; 189 } 190 191 if ( 192 193# ouch could be in a eval, perhaps we do not want these since we catch 194# an exception they must not be required 195 196# eval { require Term::ReadLine } or die $@; 197# eval "require Term::Rendezvous;" or die $@; 198# eval { require Carp } if defined $^S; # If error/warning during compilation, 199 200 201 (m/^(\s*) # we hope the inclusion starts the line 202 (require|use)\s+(?!\{) # do not want 'do {' loops 203 # quotes around name are always legal 204 ['"]?([\w:\.\/]+?)['"]?[\t; ] 205 # the syntax for 'use' allows version requirements 206 # the latter part is for "use base qw(Foo)" and friends special case 207 \s*($modver_re|(qw\s*[(\/'"]\s*|['"])[^)\/"'\$]*?\s*[)\/"'])? 208 /x) 209 ) { 210 my ($whitespace, $statement, $module, $version) = ($1, $2, $3, $4); 211 212 # we only consider require statements that are flushed against 213 # the left edge. any other require statements give too many 214 # false positives, as they are usually inside of an if statement 215 # as a fallback module or a rarely used option 216 217 ($whitespace ne "" && $statement eq "require") && next; 218 219 # if there is some interpolation of variables just skip this 220 # dependency, we do not want 221 # do "$ENV{LOGDIR}/$rcfile"; 222 223 ($module =~ m/\$/) && next; 224 225 # skip if the phrase was "use of" -- shows up in gimp-perl, et al. 226 next if $module eq 'of'; 227 228 # if the module ends in a comma we probably caught some 229 # documentation of the form 'check stuff,\n do stuff, clean 230 # stuff.' there are several of these in the perl distribution 231 232 ($module =~ m/[,>]$/) && next; 233 234 # if the module name starts in a dot it is not a module name. 235 # Is this necessary? Please give me an example if you turn this 236 # back on. 237 238 # ($module =~ m/^\./) && next; 239 240 # if the module starts with /, it is an absolute path to a file 241 if ($module =~ m(^/)) { 242 print "$module\n"; 243 next; 244 } 245 246 # sometimes people do use POSIX qw(foo), or use POSIX(qw(foo)) etc. 247 # we can strip qw.*$, as well as (.*$: 248 $module =~ s/qw.*$//; 249 $module =~ s/\(.*$//; 250 251 # if the module ends with .pm, strip it to leave only basename. 252 $module =~ s/\.pm$//; 253 254 # some perl programmers write 'require URI/URL;' when 255 # they mean 'require URI::URL;' 256 257 $module =~ s/\//::/; 258 259 # trim off trailing parentheses if any. Sometimes people pass 260 # the module an empty list. 261 262 $module =~ s/\(\s*\)$//; 263 264 if ( $module =~ m/^v?([0-9._]+)$/ ) { 265 # if module is a number then both require and use interpret that 266 # to mean that a particular version of perl is specified 267 268 my $ver = $1; 269 if ($ver =~ /5.00/) { 270 $perlreq{"0:$ver"} = 1; 271 next; 272 } 273 else { 274 $perlreq{"1:$ver"} = 1; 275 next; 276 } 277 278 }; 279 280 # ph files do not use the package name inside the file. 281 # perlmodlib documentation says: 282 283 # the .ph files made by h2ph will probably end up as 284 # extension modules made by h2xs. 285 286 # so do not expend much effort on these. 287 288 289 # there is no easy way to find out if a file named systeminfo.ph 290 # will be included with the name sys/systeminfo.ph so only use the 291 # basename of *.ph files 292 293 ($module =~ m/\.ph$/) && next; 294 295 # use base|parent qw(Foo) dependencies 296 if ($statement eq "use" && ($module eq "base" || $module eq "parent")) { 297 add_require($module, undef); 298 if ($version =~ /^qw\s*[(\/'"]\s*([^)\/"']+?)\s*[)\/"']/) { 299 add_require($_, undef) for split(' ', $1); 300 } 301 elsif ($version =~ /(["'])([^"']+)\1/) { 302 add_require($2, undef); 303 } 304 next; 305 } 306 $version = undef unless $version =~ /^$modver_re$/o; 307 308 add_require($module, $version); 309 } 310 311 } 312 313 close(FILE) || 314 die("$0: Could not close file: '$file' : $!\n"); 315 316 return; 317} 318