[packages/perl-rpm-packaging] - add perl.prov from rpm package, rel 2

[baggins]

commit a708cfb9b272c5e6ffa605c759a5f7736ecf1912
Author: Jan Rękorajski <baggins at pld-linux.org>
Date:   Sun Nov 24 22:23:26 2024 +0100

    - add perl.prov from rpm package, rel 2

 perl-rpm-packaging.spec |   5 +-
 perl.prov               | 142 ++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 146 insertions(+), 1 deletion(-)
---
diff --git a/perl-rpm-packaging.spec b/perl-rpm-packaging.spec
index 448b21e..a53fcd0 100644
--- a/perl-rpm-packaging.spec
+++ b/perl-rpm-packaging.spec
@@ -3,11 +3,12 @@ Summary(de.UTF-8):	Zusatzwerkzeuge fürs Nachsehen Perl-Abhängigkeiten in RPM-P
 Summary(pl.UTF-8):	Dodatkowe narzędzia do sprawdzenia zależności skryptów Perla w pakietach RPM
 Name:		perl-rpm-packaging
 Version:	1.1
-Release:	1
+Release:	2
 License:	GPL v2
 Group:		Base
 Source0:	https://github.com/rpm-software-management/perl-rpm-packaging/archive/v%{version}/%{name}-%{version}.tar.gz
 # Source0-md5:	7dfd1670fd1c3c002719b604bd2801e3
+Source1:	perl.prov
 Patch0:		rpm-perl-macros.patch
 Patch1:		rpm-perl-req-perlfile.patch
 Patch2:		rpm-perl_req-INC_dirs.patch
@@ -41,6 +42,8 @@ pakietach RPM.
 %patch1 -p1
 %patch2 -p0
 
+install %{SOURCE1} scripts/perl.prov
+
 %build
 
 %install
diff --git a/perl.prov b/perl.prov
new file mode 100644
index 0000000..6e98f9a
--- /dev/null
+++ b/perl.prov
@@ -0,0 +1,142 @@
+#!/usr/bin/perl
+use strict;
+
+# perl.prov - find information about perl modules for RPM
+# $Id$
+
+# 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 || !defined $version)
+			&& ( my ($pack, $ver) = m/^\s*(?:\{\s*)?package\s+([_:a-zA-Z0-9]+?)\s*(?:v?([0-9_.]+)\s*)?[;{]/)
+			&& $1 ne 'main'
+			&& match_the_path( $file, $1 )
+		  )
+		{
+			$package = $pack;
+			$version = $ver;
+		}
+
+		if ( !defined $version && /([\$*])(([\w\:\']*)\bVERSION)\b.*\=/ ) {
+			( $version = $self->{safe}->reval($_) ) =~ s/^\s+|alpha|beta|\s+$//g;
+			if ( defined $version
+				&& length $version
+				&& ($version =~ /[^\d\._abcdefgh]/
+					|| $version =~ /^[^\d]*$/ ))
+			{
+				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
================================================================

---- gitweb:

http://git.pld-linux.org/gitweb.cgi/packages/perl-rpm-packaging.git/commitdiff/a708cfb9b272c5e6ffa605c759a5f7736ecf1912