]> git.pld-linux.org Git - packages/rpm.git/blob - rpm-perl-req-perlfile.patch
5fe81f943d0387afcdfdde5a50fa899c9df02d94
[packages/rpm.git] / rpm-perl-req-perlfile.patch
1 --- rpm-4.2/scripts/perl.req.wigperl    Tue Apr  1 13:33:52 2003
2 +++ rpm-4.2/scripts/perl.req    Tue Apr  1 13:39:47 2003
3 @@ -39,28 +39,20 @@
4  
5  # by Ken Estes Mail.com kestes@staff.mail.com
6  
7 -if ("@ARGV") {
8 -  foreach (@ARGV) {
9 +foreach ( @ARGV ? @ARGV : <> ) {
10 +       chomp;
11      if (m=/usr/(sbin|bin|lib|share|X11R6/(lib|bin))/=) {
12        if (! m=(/(doc|man|info|usr/src)/|\.(so|ph|h|html|pod)$)=) {
13 -        process_file($_);
14 +        process_file($_) if -f;
15        }
16      }
17 -  }
18 -} else {
19 -  
20 -  # notice we are passed a list of filenames NOT as common in unix the
21 -  # contents of the file.
22 -  
23 -  foreach (<>) {
24 -     if (m=/usr/(sbin|bin|lib|share|X11R6/(lib|bin))/=) {
25 -       if (! m=(/(doc|man|info|usr/src)/|\.(so|ph|h|html|pod)$)=) {
26 -         process_file($_);
27 -       }
28 -     }
29 -  }
30  }
31  
32 +foreach (sort keys %provide) {
33 +    delete $require{$_};
34 +}
35 +delete $require{the}; # don't count "use the sth" as perl module  
36 +
37  
38  foreach $module (sort keys %require) {
39    if (length($require{$module}) == 0) {
40 @@ -82,6 +74,53 @@
41  exit 0;
42  
43  
44 +sub is_perlfile {
45 +    my $file = shift;
46 +    my $fh = shift;
47 +    
48 +    my $fl = <$fh>;
49 +
50 +    my $is_perl = 0;
51 +  
52 +    my $nw = 0;
53 +
54 +    if ($file =~ /\.(so|ph|h|html|pod|gz|bz2|png|gif|jpg|xpm|a|patch|o|mo)$/) {
55 +       $is_perl = 0;
56 +       
57 +       # .al, .pl, .pm and .plx (perl-Font-TTF contains *.plx files)
58 +    } elsif ($file =~ /\.p[lm]x?$/ || $file =~ /\.al$/) {      
59 +       $is_perl = 1;
60 +       #print STDERR "$file PERL by ext\n";
61 +    } elsif ($fl =~ m|bin/perl| or $fl =~ m|env\s+perl| or $fl =~ m|exec\s+perl|) {
62 +       $is_perl = 1;
63 +       #print STDERR "$file PERL by perl\n";
64 +    } elsif ($fl =~ m|bin/sh|) {
65 +       while (<$fh>) {
66 +           if (/eval/ && /perl/) {
67 +               $is_perl = 1;
68 +               last;
69 +           }
70 +           $nw++ if (/^\s*BEGIN/); 
71 +           $nw++ if (/^\s*sub\s+/);
72 +           $nw++ if (/^\s*package\s+/);
73 +           $nw++ if (/^\s*use\s+strict\s+;/);
74 +           $nw++ if (/^\s*use\s+vars\s*qw/);
75 +           last if ($. > 30);
76 +       }
77 +    }
78 +    
79 +    seek($fh, 0, 0);
80 +    
81 +    $is_perl = 1 if ($nw > 1);  # propably perl file
82 +    
83 +    #if (!$is_perl) {
84 +    #   print STDERR "NOPERL $file\n";
85 +    #   return 0;
86 +    #} 
87 +    #print STDERR "PERL $file\n" if ($is_perl);
88 +    return $is_perl;
89 +}
90 +
91  
92  sub process_file {
93    
94 @@ -90,6 +129,8 @@
95    
96    open(FILE, "<$file") || return;
97    
98 +  return if (!is_perlfile($file, \*FILE));
99 +
100    while (<FILE>) {
101      
102      # skip the documentation
103 @@ -111,6 +152,10 @@
104        last;
105      }
106  
107 +    if (m/^\s*package\s+([_:a-zA-Z0-9]+)\s*;/) {
108 +       $provide{$1} = 1;
109 +    }
110 +
111      # Each keyword can appear multiple times.  Don't
112      #  bother with datastructures to store these strings,
113      #  if we need to print it print it now.
114 @@ -236,6 +281,10 @@
115  
116        ($module =~ m/^\./) && next;
117  
118 +      # name starts in a non alphanumeric character it is not a module 
119 +      # name.
120 +      ($module =~ m/^\W/) && next;
121 +
122        # if the module ends with .pm strip it to leave only basename.
123  
124        $module =~ s/\.pm$//;
This page took 0.025998 seconds and 2 git commands to generate.