X-Git-Url: https://git.tld-linux.org/?a=blobdiff_plain;f=perl.prov;h=6e98f9a4ae03d8f6d931ad221c3a90974a4cfb87;hb=HEAD;hp=8f1a79d599aacdeb249789ebe93504ebc62aa106;hpb=685372ccad422be5593dabe2ed2d89f19037e7ca;p=packages%2Frpm.git

diff --git a/perl.prov b/perl.prov
deleted file mode 100644
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