]>
Commit | Line | Data |
---|---|---|
6566e5f2 MT |
1 | #!/usr/bin/perl |
2 | ||
3 | # RPM (and it's 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 alternative 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 script to print the proper name for perl libraries. | |
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 proper name 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 lines in the file which match the pattern | |
33 | # (m/^\s*\$VERSION\s*=\s+/) | |
34 | # then these are taken to be the version numbers of the modules. | |
35 | # Special care is taken with a few known idioms for specifying version | |
36 | # numbers of files under rcs/cvs control. | |
37 | ||
38 | # If there are strings in the file which match the pattern | |
39 | # m/^\s*\$RPM_Provides\s*=\s*["'](.*)['"]/i | |
40 | # then these are treated as additional names which are provided by the | |
41 | # file and are printed as well. | |
42 | ||
43 | # I plan to rewrite this in C so that perl is not required by RPM at | |
44 | # build time. | |
45 | ||
46 | # by Ken Estes Mail.com kestes@staff.mail.com | |
47 | ||
48 | if ("@ARGV") { | |
49 | foreach (@ARGV) { | |
50 | process_file($_); | |
51 | } | |
52 | } else { | |
53 | ||
54 | # notice we are passed a list of filenames NOT as common in unix the | |
55 | # contents of the file. | |
56 | ||
57 | foreach (<>) { | |
58 | process_file($_); | |
59 | } | |
60 | } | |
61 | ||
62 | ||
63 | foreach $module (sort keys %require) { | |
64 | if (length($require{$module}) == 0) { | |
65 | print "perl($module)\n"; | |
66 | } else { | |
67 | ||
68 | # I am not using rpm3.0 so I do not want spaces arround my | |
69 | # operators. Also I will need to change the processing of the | |
70 | # $RPM_* variable when I upgrade. | |
71 | ||
a09bac73 | 72 | print "perl($module) = $require{$module}\n"; |
6566e5f2 MT |
73 | } |
74 | } | |
75 | ||
76 | exit 0; | |
77 | ||
78 | ||
79 | ||
80 | sub process_file { | |
81 | ||
82 | my ($file) = @_; | |
83 | chomp $file; | |
a09bac73 MT |
84 | |
85 | if (!open(FILE, $file)) { | |
86 | warn("$0: Warning: Could not open file '$file' for reading: $!\n"); | |
87 | return; | |
88 | } | |
6566e5f2 MT |
89 | |
90 | my ($package, $version, $incomment, $inover) = (); | |
91 | ||
92 | while (<FILE>) { | |
a09bac73 | 93 | |
6566e5f2 MT |
94 | # skip the documentation |
95 | ||
96 | # we should not need to have item in this if statement (it | |
97 | # properly belongs in the over/back section) but people do not | |
98 | # read the perldoc. | |
99 | ||
a09bac73 | 100 | if (m/^=(head[1-4]|pod|for|item)/) { |
6566e5f2 MT |
101 | $incomment = 1; |
102 | } | |
103 | ||
104 | if (m/^=(cut)/) { | |
105 | $incomment = 0; | |
106 | $inover = 0; | |
107 | } | |
a09bac73 | 108 | |
6566e5f2 MT |
109 | if (m/^=(over)/) { |
110 | $inover = 1; | |
111 | } | |
112 | ||
113 | if (m/^=(back)/) { | |
114 | $inover = 0; | |
115 | } | |
116 | ||
117 | if ($incomment || $inover) { | |
118 | next; | |
119 | } | |
a09bac73 | 120 | |
6566e5f2 MT |
121 | # skip the data section |
122 | if (m/^__(DATA|END)__$/) { | |
123 | last; | |
124 | } | |
125 | ||
126 | # not everyone puts the package name of the file as the first | |
127 | # package name so we report all namespaces except some common | |
128 | # false positives as if they were provided packages (really ugly). | |
129 | ||
130 | if (m/^\s*package\s+([_:a-zA-Z0-9]+)\s*;/) { | |
a09bac73 | 131 | $package = $1; |
6566e5f2 MT |
132 | undef $version; |
133 | if ($package eq 'main') { | |
134 | undef $package; | |
135 | } else { | |
136 | # If $package already exists in the $require hash, it means | |
137 | # the package definition is broken up over multiple blocks. | |
138 | # In that case, don't stomp a previous $VERSION we might have | |
139 | # found. (See BZ#214496.) | |
a09bac73 | 140 | $require{$package} = undef unless (exists $require{$package}); |
6566e5f2 MT |
141 | } |
142 | } | |
143 | ||
144 | # after we found the package name take the first assignment to | |
145 | # $VERSION as the version number. Exporter requires that the | |
146 | # variable be called VERSION so we are safe. | |
147 | ||
148 | # here are examples of VERSION lines from the perl distribution | |
149 | ||
150 | #FindBin.pm:$VERSION = $VERSION = sprintf("%d.%02d", q$Revision: 1.9 $ =~ /(\d+)\.(\d+)/); | |
151 | #ExtUtils/Install.pm:$VERSION = substr q$Revision: 1.9 $, 10; | |
152 | #CGI/Apache.pm:$VERSION = (qw$Revision: 1.9 $)[1]; | |
153 | #DynaLoader.pm:$VERSION = $VERSION = "1.03"; # avoid typo warning | |
154 | #General.pm:$Config::General::VERSION = 2.33; | |
a09bac73 | 155 | # |
6566e5f2 MT |
156 | # or with the new "our" pragma you could (read will) see: |
157 | # | |
158 | # our $VERSION = '1.00' | |
a09bac73 | 159 | if ($package && m/^\s*(our\s+)?\$(\Q$package\E::)?VERSION\s*=\s+/) { |
6566e5f2 MT |
160 | |
161 | # first see if the version string contains the string | |
162 | # '$Revision' this often causes bizzare strings and is the most | |
163 | # common method of non static numbering. | |
164 | ||
165 | if (m/(\$Revision: (\d+[.0-9]+))/) { | |
a09bac73 MT |
166 | $version = $2; |
167 | } elsif (m/['"]?(\d+[.0-9]+)['"]?/) { | |
168 | ||
169 | # look for a static number hard coded in the script | |
170 | ||
171 | $version = $1; | |
6566e5f2 | 172 | } |
a09bac73 | 173 | $require{$package} = $version; |
6566e5f2 | 174 | } |
a09bac73 | 175 | |
6566e5f2 | 176 | # Allow someone to have a variable that defines virtual packages |
a09bac73 MT |
177 | # The variable is called $RPM_Provides. It must be scoped with |
178 | # "our", but not "local" or "my" (just would not make sense). | |
179 | # | |
6566e5f2 | 180 | # For instance: |
a09bac73 | 181 | # |
6566e5f2 | 182 | # $RPM_Provides = "blah bleah" |
a09bac73 | 183 | # |
6566e5f2 MT |
184 | # Will generate provides for "blah" and "bleah". |
185 | # | |
186 | # Each keyword can appear multiple times. Don't | |
187 | # bother with datastructures to store these strings, | |
188 | # if we need to print it print it now. | |
a09bac73 MT |
189 | |
190 | if (m/^\s*(our\s+)?\$RPM_Provides\s*=\s*["'](.*)['"]/i) { | |
6566e5f2 | 191 | foreach $_ (split(/\s+/, $2)) { |
a09bac73 | 192 | print "$_\n"; |
6566e5f2 MT |
193 | } |
194 | } | |
195 | ||
196 | } | |
197 | ||
198 | close(FILE) || | |
199 | die("$0: Could not close file: '$file' : $!\n"); | |
200 | ||
a09bac73 | 201 | return; |
6566e5f2 | 202 | } |