- merged 4.20.1 from PLD

[packages/rpm.git] / perl.prov

diff --git a/perl.prov b/perl.prov
deleted file mode 100644 (file)
index 8f1a79d..0000000
--- a/perl.prov
+++ /dev/null
@@ -1,140 +0,0 @@
-#!/usr/bin/perl
-use strict;
-
-# perl.prov - find information about perl modules for RPM
-# $Id: perl.prov,v 1.10 2004/05/05 17:13:54 radek Exp $
-
-# It's questionable if we should provide perl(Foo::Bar) for modules
-# from outside @INC (possibly shipped with some applications).
-# I think we should not, and provide them only for the perl.req script,
-# while it scans files in that particular application.
-
-
-# check if we are called directly
-if ($0 =~ m#(?:^|/)perl.prov$#) {
-       my $prov = new RPM::PerlReq;
-       # process @ARGV or STDIN
-       foreach ( @ARGV ? @ARGV : <> ) {
-               chomp;
-               next if -l || !-f _;                # skip non-files and symlinks
-               next if m#/usr/(?:share/doc|src)/#; # lot of false alarms; warning: we omit ^ here
-               next if !m#\.p[ml]$#;               # we only care about *.pm and *.pl files
-               $prov->process_file($_);
-       }
-       $prov->print_result;
-}
-
-
-package RPM::PerlReq;
-use Safe;
-
-sub new {
-       my $class = shift;
-       my $self = {
-               inc => [
-                       sort { length $b cmp length $a } grep m#^/#,
-                       map { y#/#/#s; s#/$##; $_ } @INC
-               ],
-               provide => {},
-               safe    => Safe->new,
-               @_,
-       };
-       bless $self, $class;
-}
-
-# print out what we found
-sub print_result {
-       my $self = shift;
-       for (sort keys %{ $self->{provide} }) {
-               print "perl($_)"
-                 . (length $self->{provide}->{$_} ? " = $self->{provide}->{$_}" : '')
-                 . "\n";
-       }
-}
-
-sub process_file {
-       my $self = shift;
-       my $file = shift;
-       my ( $package, $version );
-
-       # if the file lives under @INC, we can
-       # obtain the package name from it's path
-       for (@{ $self->{inc} }) {
-               if ($file =~ m#\Q$_\E/(.+)$#) {    # we can't use ^ here
-                       $package = $1;
-
-                       if ($package !~ s/\.pm$//) {    # it's a *.pl
-                       #       $package =~ m#([^/]+)$#;
-                       #       $provide{$1} = '';
-                               return 1;
-                       }
-
-                       $package =~ s#/#::#g;
-                       last;
-               }
-       }
-
-       # it can be a *.pl oustide @INC
-       return if /\.pl$/;
-
-       local *FILE;
-       open FILE, $file or die "$0: cannot open file `$file': $!";
-
-       while (<FILE>) {
-
-               # skip the documentation
-               next
-                 if m/^=(?:head1|head2|pod|item|begin|for|over)\b/
-                    ... ( m/^=(?:cut|end)\b/ || $. == 1 );
-
-               # skip the data section
-               last if m/^__(?:DATA|END)__$/;
-
-               # search for the package name
-               if (
-                       !defined $package
-                       && ( my ($pack) = m/^\s*(?:\{\s*)?package\s+([_:a-zA-Z0-9]+?):*\s*;/ )
-                       && $1 ne 'main'
-                       && match_the_path( $file, $1 )
-                 )
-               {
-                       $package = $pack;
-               }
-
-               if ( !defined $version && /([\$*])(([\w\:\']*)\bVERSION)\b.*\=/ ) {
-                       ( $version = $self->{safe}->reval($_) ) =~ s/^\s+|alpha|beta|\s+$//g;
-                       if ( defined $version
-                               && length $version
-                               && $version =~ /[^\d\._abcdefgh]/ )
-                       {
-                               warn "$0: weird version number in $file: [$version]\n";
-                               $version = '';
-                       }
-               }
-       }
-
-       unless ( defined $package ) {
-               warn "$0: weird, cannot determine the package name for `$file'\n";
-               return 0;
-       }
-
-       $self->{provide}->{$package} = $version;
-
-       close FILE or die "$0: cannot close file `$file': $!";
-
-       1;
-}
-
-
-# Returns C<true> if the package name matches the path,
-# so you can use() it.  C<false> otherwise.
-sub match_the_path {
-       my ( $file, $pack ) = @_;
-       $pack =~ s#::#/#g;
-       $file =~ /\Q$pack\E(?:\.pm)?$/;
-}
-
-
-1;
-
-# vim: ts=4 sw=4 noet noai nosi cin