]>
Commit | Line | Data |
---|---|---|
7b138760 | 1 | --- rpm-4.0/scripts/perl.req Mon Dec 16 11:36:15 2000 |
2 | +++ rpm-4.0.mis/scripts/perl.req Mon Dec 16 11:46:28 2000 | |
3 | @@ -61,6 +61,11 @@ | |
4 | } | |
5 | } | |
6 | ||
7 | +foreach (sort keys %provide) { | |
8 | + delete $require{$_}; | |
9 | +} | |
10 | +delete $require{the}; # don't count "use the sth" as perl module | |
11 | + | |
12 | ||
13 | foreach $module (sort keys %require) { | |
14 | if (length($require{$module}) == 0) { | |
15 | @@ -82,6 +86,53 @@ | |
2699ff91 | 16 | exit 0; |
17 | ||
18 | ||
19 | +sub is_perlfile { | |
20 | + my $file = shift; | |
21 | + my $fh = shift; | |
22 | + | |
23 | + my $fl = <$fh>; | |
24 | + | |
25 | + my $is_perl = 0; | |
26 | + | |
27 | + my $nw = 0; | |
28 | + | |
29 | + if ($file =~ /\.(so|ph|h|html|pod|gz|bz2|png|gif|jpg|xpm|a|patch|o|mo)$/) { | |
30 | + $is_perl = 0; | |
31 | + | |
32 | + # .al, .pl, .pm and .plx (perl-Font-TTF contains *.plx files) | |
33 | + } elsif ($file =~ /\.p[lm]x?$/ || $file =~ /\.al$/) { | |
34 | + $is_perl = 1; | |
35 | + #print STDERR "$file PERL by ext\n"; | |
36 | + } elsif ($fl =~ m|bin/perl| or $fl =~ m|env\s+perl| or $fl =~ m|exec\s+perl|) { | |
37 | + $is_perl = 1; | |
38 | + #print STDERR "$file PERL by perl\n"; | |
39 | + } elsif ($fl =~ m|bin/sh|) { | |
40 | + while (<$fh>) { | |
41 | + if (/eval/ && /perl/) { | |
42 | + $is_perl = 1; | |
43 | + last; | |
44 | + } | |
45 | + $nw++ if (/^\s*BEGIN/); | |
46 | + $nw++ if (/^\s*sub\s+/); | |
47 | + $nw++ if (/^\s*package\s+/); | |
48 | + $nw++ if (/^\s*use\s+strict\s+;/); | |
49 | + $nw++ if (/^\s*use\s+vars\s*qw/); | |
50 | + last if ($. > 30); | |
51 | + } | |
52 | + } | |
53 | + | |
54 | + seek($fh, 0, 0); | |
55 | + | |
56 | + $is_perl = 1 if ($nw > 1); # propably perl file | |
57 | + | |
58 | + #if (!$is_perl) { | |
59 | + # print STDERR "NOPERL $file\n"; | |
60 | + # return 0; | |
61 | + #} | |
62 | + #print STDERR "PERL $file\n" if ($is_perl); | |
63 | + return $is_perl; | |
64 | +} | |
65 | + | |
66 | ||
67 | sub process_file { | |
68 | ||
7b138760 | 69 | @@ -90,6 +141,8 @@ |
2699ff91 | 70 | |
71 | open(FILE, "<$file")|| | |
72 | die("$0: Could not open file: '$file' : $!\n"); | |
73 | + | |
74 | + return if (!is_perlfile($file, \*FILE)); | |
75 | ||
76 | while (<FILE>) { | |
77 | ||
7b138760 | 78 | @@ -112,6 +165,10 @@ |
79 | last; | |
80 | } | |
81 | ||
82 | + if (m/^\s*package\s+([_:a-zA-Z0-9]+)\s*;/) { | |
83 | + $provide{$1} = 1; | |
84 | + } | |
85 | + | |
86 | # Each keyword can appear multiple times. Don't | |
87 | # bother with datastructures to store these strings, | |
88 | # if we need to print it print it now. | |
89 | @@ -209,6 +266,10 @@ | |
2699ff91 | 90 | # if the module name starts in a dot it is not a module name. |
91 | ||
92 | ($module =~ m/^\./) && next; | |
93 | + | |
94 | + # name starts in a non alphanumeric character it is not a module | |
95 | + # name. | |
96 | + ($module =~ m/^\W/) && next; | |
97 | ||
98 | # if the module ends with .pm strip it to leave only basename. | |
99 |