rpm-perl-req-perlfile.patch

   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 @@
  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
  69 @@ -90,6 +141,8 @@
  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
  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 @@
  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