#!/usr/bin/perl # RPM (and it's source code) is covered under two separate licenses. # The entire code base may be distributed under the terms of the GNU # General Public License (GPL), which appears immediately below. # Alternatively, all of the source code in the lib subdirectory of the # RPM source code distribution as well as any code derived from that # code may instead be distributed under the GNU Library General Public # License (LGPL), at the choice of the distributor. The complete text # of the LGPL appears at the bottom of this file. # This alternative is allowed to enable applications to be linked # against the RPM library (commonly called librpm) without forcing # such applications to be distributed under the GPL. # Any questions regarding the licensing of RPM should be addressed to # Erik Troan . # a simple script to print the proper name for perl libraries. # To save development time I do not parse the perl grammmar but # instead just lex it looking for what I want. I take special care to # ignore comments and pod's. # it would be much better if perl could tell us the proper name of a # given script. # The filenames to scan are either passed on the command line or if # that is empty they are passed via stdin. # If there are lines in the file which match the pattern # (m/^\s*\$VERSION\s*=\s+/) # then these are taken to be the version numbers of the modules. # Special care is taken with a few known idioms for specifying version # numbers of files under rcs/cvs control. # If there are strings in the file which match the pattern # m/^\s*\$RPM_Provides\s*=\s*["'](.*)['"]/i # then these are treated as additional names which are provided by the # file and are printed as well. # I plan to rewrite this in C so that perl is not required by RPM at # build time. # by Ken Estes Mail.com kestes@staff.mail.com if ("@ARGV") { foreach (@ARGV) { process_file($_); } } else { # notice we are passed a list of filenames NOT as common in unix the # contents of the file. foreach (<>) { process_file($_); } } foreach $module (sort keys %require) { if (length($require{$module}) == 0) { print "perl($module)\n"; } else { # I am not using rpm3.0 so I do not want spaces arround my # operators. Also I will need to change the processing of the # $RPM_* variable when I upgrade. print "perl($module) = $require{$module}\n"; } } exit 0; sub process_file { my ($file) = @_; chomp $file; open(FILE, "<$file") || return; my ($package, $version, $incomment, $inover) = (); while () { # skip the documentation # we should not need to have item in this if statement (it # properly belongs in the over/back section) but people do not # read the perldoc. if (m/^=(head1|head2|pod|item)/) { $incomment = 1; } if (m/^=(cut)/) { $incomment = 0; $inover = 0; } if (m/^=(over)/) { $inover = 1; } if (m/^=(back)/) { $inover = 0; } if ($incomment || $inover) { next; } # skip the data section if (m/^__(DATA|END)__$/) { last; } # not everyone puts the package name of the file as the first # package name so we report all namespaces as if they were # provided packages (really ugly). if (m/^\s*package\s+([_:a-zA-Z0-9]+)\s*;/) { $package=$1; undef $version; $require{$package}=undef; } # after we found the package name take the first assignment to # $VERSION as the version number. Exporter requires that the # variable be called VERSION so we are safe. # here are examples of VERSION lines from the perl distribution #FindBin.pm:$VERSION = $VERSION = sprintf("%d.%02d", q$Revision: 1.7 $ =~ /(\d+)\.(\d+)/); #ExtUtils/Install.pm:$VERSION = substr q$Revision: 1.7 $, 10; #CGI/Apache.pm:$VERSION = (qw$Revision: 1.7 $)[1]; #DynaLoader.pm:$VERSION = $VERSION = "1.03"; # avoid typo warning if ( ($package) && (m/^\s*\$VERSION\s*=\s+/) ) { # first see if the version string contains the string # '$Revision' this often causes bizzare strings and is the most # common method of non static numbering. if (m/(\$Revision: (\d+[.0-9]+))/) { $version= $2; } elsif (m/[\'\"]?(\d+[.0-9]+)[\'\"]?/) { # look for a static number hard coded in the script $version= $1; } $require{$package}=$version; } # Each keyword can appear multiple times. Don't # bother with datastructures to store these strings, # if we need to print it print it now. if ( m/^\s*\$RPM_Provides\s*=\s*["'](.*)['"]/i) { foreach $_ (spit(/\s+/, $1)) { print "$_\n"; } } } close(FILE) || die("$0: Could not close file: '$file' : $!\n"); return ; }