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$//;