From 8c6d296ac0463bc2ec5bd8b585c813953c45fa63 Mon Sep 17 00:00:00 2001 From: Silvan Calarco Date: Sat, 4 Jan 2025 11:28:02 +0100 Subject: [PATCH] openmamba/perl.*,fileattrs/perl*: restore perl auto provides/requires support removed since rpm 4.20 --- Makefile | 5 + fileattrs/perl.attr | 3 + fileattrs/perllib.attr | 5 + openmamba/perl.prov | 222 +++++++++++++++++++++++++++++ openmamba/perl.req | 317 +++++++++++++++++++++++++++++++++++++++++ 5 files changed, 552 insertions(+) create mode 100644 fileattrs/perl.attr create mode 100644 fileattrs/perllib.attr create mode 100755 openmamba/perl.prov create mode 100755 openmamba/perl.req diff --git a/Makefile b/Makefile index 1ea668d..c2a9315 100644 --- a/Makefile +++ b/Makefile @@ -25,13 +25,18 @@ all: install-dirs: @$(INSTALL_DIR) $(DESTDIR)$(rpmdir)/openmamba + @$(INSTALL_DIR) $(DESTDIR)$(rpmdir)/fileattrs install-data: @$(INSTALL_DATA) openmamba/macros $(DESTDIR)$(rpmdir)/openmamba/macros @$(INSTALL_DATA) openmamba/rpmrc $(DESTDIR)$(rpmdir)/openmamba/rpmrc + @$(INSTALL_DATA) fileattrs/perl.attr $(DESTDIR)$(rpmdir)/fileattrs/perl.attr + @$(INSTALL_DATA) fileattrs/perllib.attr $(DESTDIR)$(rpmdir)/fileattrs/perllib.attr install-programs: @$(INSTALL_SCRIPT) openmamba/brp-strip-lto $(DESTDIR)$(rpmdir)/openmamba/brp-strip-lto + @$(INSTALL_SCRIPT) openmamba/perl.prov $(DESTDIR)$(rpmdir)/openmamba/perl.prov + @$(INSTALL_SCRIPT) openmamba/perl.req $(DESTDIR)$(rpmdir)/openmamba/perl.req install: install-dirs install-data install-programs diff --git a/fileattrs/perl.attr b/fileattrs/perl.attr new file mode 100644 index 0000000..ffee2f2 --- /dev/null +++ b/fileattrs/perl.attr @@ -0,0 +1,3 @@ +%__perl_requires %{_rpmconfigdir}/openmamba/perl.req +%__perl_magic ^.*[Pp]erl .*$ +%__perl_flags exeonly diff --git a/fileattrs/perllib.attr b/fileattrs/perllib.attr new file mode 100644 index 0000000..ee4e43f --- /dev/null +++ b/fileattrs/perllib.attr @@ -0,0 +1,5 @@ +%__perllib_provides %{_rpmconfigdir}/openmamba/perl.prov +%__perllib_requires %{_rpmconfigdir}/openmamba/perl.req +%__perllib_magic ^Perl[[:digit:]] module source.* +%__perllib_path \\.pm$ +%__perllib_flags magic_and_path diff --git a/openmamba/perl.prov b/openmamba/perl.prov new file mode 100755 index 0000000..17f7dea --- /dev/null +++ b/openmamba/perl.prov @@ -0,0 +1,222 @@ +#!/usr/bin/perl + +# RPM (and it's source code) is covered under two separate licenses. + +# The entire code base may be distributed under the terms of the GNU +# General Public License (GPL), which appears immediately below. +# Alternatively, all of the source code in the lib subdirectory of the +# RPM source code distribution as well as any code derived from that +# code may instead be distributed under the GNU Library General Public +# License (LGPL), at the choice of the distributor. The complete text +# of the LGPL appears at the bottom of this file. + +# This alternative is allowed to enable applications to be linked +# against the RPM library (commonly called librpm) without forcing +# such applications to be distributed under the GPL. + +# Any questions regarding the licensing of RPM should be addressed to +# Erik Troan . + +# a simple script to print the proper name for perl libraries. + +# To save development time I do not parse the perl grammar but +# instead just lex it looking for what I want. I take special care to +# ignore comments and pod's. + +# it would be much better if perl could tell us the proper name of a +# given script. + +# The filenames to scan are either passed on the command line or if +# that is empty they are passed via stdin. + +# If there are lines in the file which match the pattern +# (m/^\s*\$VERSION\s*=\s+/) +# then these are taken to be the version numbers of the modules. +# Special care is taken with a few known idioms for specifying version +# numbers of files under rcs/cvs control. + +# If there are strings in the file which match the pattern +# m/^\s*\$RPM_Provides\s*=\s*["'](.*)['"]/i +# then these are treated as additional names which are provided by the +# file and are printed as well. + +# I plan to rewrite this in C so that perl is not required by RPM at +# build time. + +# by Ken Estes Mail.com kestes@staff.mail.com + +if ("@ARGV") { + foreach (@ARGV) { + next if !/\.pm$/; + process_file($_); + } +} else { + + # notice we are passed a list of filenames NOT as common in unix the + # contents of the file. + + foreach (<>) { + next if !/\.pm$/; + process_file($_); + } +} + + +foreach $module (sort keys %require) { + if (length($require{$module}) == 0) { + print "perl($module)\n"; + } else { + + # I am not using rpm3.0 so I do not want spaces around my + # operators. Also I will need to change the processing of the + # $RPM_* variable when I upgrade. + + print "perl($module) = $require{$module}\n"; + } +} + +exit 0; + + + +sub process_file { + + my ($file) = @_; + chomp $file; + + if (!open(FILE, $file)) { + warn("$0: Warning: Could not open file '$file' for reading: $!\n"); + return; + } + + my ($package, $version, $incomment, $inover, $inheredoc) = (); + + while () { + + # Skip contents of HEREDOCs + if (! defined $inheredoc) { + # skip the documentation + + # we should not need to have item in this if statement (it + # properly belongs in the over/back section) but people do not + # read the perldoc. + + if (m/^=(head[1-4]|pod|for|item)/) { + $incomment = 1; + } + + if (m/^=(cut)/) { + $incomment = 0; + $inover = 0; + } + + if (m/^=(over)/) { + $inover = 1; + } + + if (m/^=(back)/) { + $inover = 0; + } + + if ($incomment || $inover || m/^\s*#/) { + next; + } + + # skip the data section + if (m/^__(DATA|END)__$/) { + last; + } + + # Find the start of a HEREDOC + if (m/<<\s*[\"\'](\w+)[\"\']\s*;\s*$/) { + $inheredoc = $1; + } + } else { + # We're in a HEREDOC; continue until the end of it + if (m/^$inheredoc\s*$/) { + $inheredoc = undef; + } + next; + } + + # not everyone puts the package name of the file as the first + # package name so we report all namespaces except some common + # false positives as if they were provided packages (really ugly). + + if (m/^\s*package\s+([_:a-zA-Z0-9]+)\s*(?:v?([0-9_.]+)\s*)?[;{]/) { + $package = $1; + $version = $2; + if ($package eq 'main') { + undef $package; + } else { + # If $package already exists in the $require hash, it means + # the package definition is broken up over multiple blocks. + # In that case, don't stomp a previous $VERSION we might have + # found. (See BZ#214496.) + $require{$package} = $version unless (exists $require{$package}); + } + } + + # after we found the package name take the first assignment to + # $VERSION as the version number. Exporter requires that the + # variable be called VERSION so we are safe. + + # here are examples of VERSION lines from the perl distribution + + #FindBin.pm:$VERSION = $VERSION = sprintf("%d.%02d", q$Revision: 1.9 $ =~ /(\d+)\.(\d+)/); + #ExtUtils/Install.pm:$VERSION = substr q$Revision: 1.9 $, 10; + #CGI/Apache.pm:$VERSION = (qw$Revision: 1.9 $)[1]; + #DynaLoader.pm:$VERSION = $VERSION = "1.03"; # avoid typo warning + #General.pm:$Config::General::VERSION = 2.33; + # + # or with the new "our" pragma you could (read will) see: + # + # our $VERSION = '1.00' + if ($package && m/^\s*(our\s+)?\$(\Q$package\E::)?VERSION\s*=\s+/) { + + # first see if the version string contains the string + # '$Revision' this often causes bizarre strings and is the most + # common method of non static numbering. + + if (m/\$Revision: (\d+[.0-9]+)/) { + $version = $1; + } elsif (m/=\s*['"]?(\d+[._0-9]+)['"]?/) { + + # look for a static number hard coded in the script + + $version = $1; + } + $require{$package} = $version; + } + + # Allow someone to have a variable that defines virtual packages + # The variable is called $RPM_Provides. It must be scoped with + # "our", but not "local" or "my" (just would not make sense). + # + # For instance: + # + # $RPM_Provides = "blah bleah" + # + # Will generate provides for "blah" and "bleah". + # + # Each keyword can appear multiple times. Don't + # bother with datastructures to store these strings, + # if we need to print it print it now. + + if (m/^\s*(our\s+)?\$RPM_Provides\s*=\s*["'](.*)['"]/i) { + foreach $_ (split(/\s+/, $2)) { + print "$_\n"; + } + } + + } + + if (defined $inheredoc) { + die "Unclosed HEREDOC [$inheredoc] in file: '$file'\n"; + } + + close(FILE) || + die("$0: Could not close file: '$file' : $!\n"); + + return; +} diff --git a/openmamba/perl.req b/openmamba/perl.req new file mode 100755 index 0000000..1b50c50 --- /dev/null +++ b/openmamba/perl.req @@ -0,0 +1,317 @@ +#!/usr/bin/perl + +# RPM (and its source code) is covered under two separate licenses. + +# The entire code base may be distributed under the terms of the GNU +# General Public License (GPL), which appears immediately below. +# Alternatively, all of the source code in the lib subdirectory of the +# RPM source code distribution as well as any code derived from that +# code may instead be distributed under the GNU Library General Public +# License (LGPL), at the choice of the distributor. The complete text +# of the LGPL appears at the bottom of this file. + +# This alternatively is allowed to enable applications to be linked +# against the RPM library (commonly called librpm) without forcing +# such applications to be distributed under the GPL. + +# Any questions regarding the licensing of RPM should be addressed to +# Erik Troan . + +# a simple makedepend like script for perl. + +# To save development time I do not parse the perl grammar but +# instead just lex it looking for what I want. I take special care to +# ignore comments and pod's. + +# It would be much better if perl could tell us the dependencies of a +# given script. + +# The filenames to scan are either passed on the command line or if +# that is empty they are passed via stdin. + +# If there are strings in the file which match the pattern +# m/^\s*\$RPM_Requires\s*=\s*["'](.*)['"]/i +# then these are treated as additional names which are required by the +# file and are printed as well. + +# I plan to rewrite this in C so that perl is not required by RPM at +# build time. + +# by Ken Estes Mail.com kestes@staff.mail.com + +$HAVE_VERSION = 0; +eval { require version; $HAVE_VERSION = 1; }; + + +if ("@ARGV") { + foreach (@ARGV) { + process_file($_); + } +} else { + + # notice we are passed a list of filenames NOT as common in unix the + # contents of the file. + + foreach (<>) { + process_file($_); + } +} + + +foreach $perlver (sort keys %perlreq) { + print "perl >= $perlver\n"; +} +foreach $module (sort keys %require) { + if (length($require{$module}) == 0) { + print "perl($module)\n"; + } else { + + # I am not using rpm3.0 so I do not want spaces around my + # operators. Also I will need to change the processing of the + # $RPM_* variable when I upgrade. + + print "perl($module) >= $require{$module}\n"; + } +} + +exit 0; + + + +sub add_require { + my ($module, $newver) = @_; + my $oldver = $require{$module}; + if ($oldver) { + $require{$module} = $newver + if ($HAVE_VERSION && $newver && version->new($oldver) < $newver); + } + else { + $require{$module} = $newver; + } +} + +sub process_file { + + my ($file) = @_; + chomp $file; + + if (!open(FILE, $file)) { + warn("$0: Warning: Could not open file '$file' for reading: $!\n"); + return; + } + + while () { + + # skip the "= <<" block + + if (m/^\s*(?:my\s*)?\$(?:.*)\s*=\s*<<\s*(["'`])(.+?)\1/ || + m/^\s*(?:my\s*)?\$(.*)\s*=\s*<<(\w+)\s*;/) { + $tag = $2; + while () { + chomp; + ( $_ eq $tag ) && last; + } + $_ = ; + } + + # skip q{} quoted sections - just hope we don't have curly brackets + # within the quote, nor an escaped hash mark that isn't a comment + # marker, such as occurs right here. Draw the line somewhere. + if ( m/^.*\Wq[qxwr]?\s*([{([#|\/])[^})\]#|\/]*$/ && ! m/^\s*(require|use)\s/ ) { + $tag = $1; + $tag =~ tr/{\(\[\#|\//})]#|\//; + $tag = quotemeta($tag); + while () { + ( $_ =~ m/$tag/ ) && last; + } + } + + # skip the documentation + + # we should not need to have item in this if statement (it + # properly belongs in the over/back section) but people do not + # read the perldoc. + + if (/^=(head[1-4]|pod|for|item)/) { + /^=cut/ && next while ; + } + + if (/^=over/) { + /^=back/ && next while ; + } + + # skip the data section + if (m/^__(DATA|END)__$/) { + last; + } + + # Each keyword can appear multiple times. Don't + # bother with datastructures to store these strings, + # if we need to print it print it now. + # + # Again allow for "our". + if (m/^\s*(our\s+)?\$RPM_Requires\s*=\s*["'](.*)['"]/i) { + foreach $_ (split(/\s+/, $2)) { + print "$_\n"; + } + } + + my $modver_re = qr/[.0-9]+/; + + # + # The (require|use) match further down in this subroutine will match lines + # within a multi-line print or return statements. So, let's skip over such + # statements whose content should not be loading modules anyway. -BEF- + # + if (m/print(?:\s+|\s+\S+\s+)\<\<\s*(["'`])(.+?)\1/ || + m/print(\s+|\s+\S+\s+)\<\<(\w+)/ || + m/return(\s+)\<\<(\w+)/ ) { + + my $tag = $2; + while () { + chomp; + ( $_ eq $tag ) && last; + } + $_ = ; + } + + # Skip multiline print and assign statements + if ( m/\$\S+\s*=\s*(")([^"\\]|(\\.))*$/ || + m/\$\S+\s*=\s*(')([^'\\]|(\\.))*$/ || + m/print\s+(")([^"\\]|(\\.))*$/ || + m/print\s+(')([^'\\]|(\\.))*$/ ) { + + my $quote = $1; + while () { + m/^([^\\$quote]|(\\.))*$quote/ && last; + } + $_ = ; + } + + if ( + +# ouch could be in a eval, perhaps we do not want these since we catch +# an exception they must not be required + +# eval { require Term::ReadLine } or die $@; +# eval "require Term::Rendezvous;" or die $@; +# eval { require Carp } if defined $^S; # If error/warning during compilation, + + + (m/^(\s*) # we hope the inclusion starts the line + (require|use)\s+(?!\{) # do not want 'do {' loops + # quotes around name are always legal + ['"]?([\w:\.\/]+?)['"]?[\t; ] + # the syntax for 'use' allows version requirements + # the latter part is for "use base qw(Foo)" and friends special case + \s*($modver_re|(qw\s*[(\/'"]\s*|['"])[^)\/"'\$]*?\s*[)\/"'])? + /x) + ) { + my ($whitespace, $statement, $module, $version) = ($1, $2, $3, $4); + + # we only consider require statements that are flushed against + # the left edge. any other require statements give too many + # false positives, as they are usually inside of an if statement + # as a fallback module or a rarely used option + + ($whitespace ne "" && $statement eq "require") && next; + + # if there is some interpolation of variables just skip this + # dependency, we do not want + # do "$ENV{LOGDIR}/$rcfile"; + + ($module =~ m/\$/) && next; + + # skip if the phrase was "use of" -- shows up in gimp-perl, et al. + next if $module eq 'of'; + + # if the module ends in a comma we probably caught some + # documentation of the form 'check stuff,\n do stuff, clean + # stuff.' there are several of these in the perl distribution + + ($module =~ m/[,>]$/) && next; + + # if the module name starts in a dot it is not a module name. + # Is this necessary? Please give me an example if you turn this + # back on. + + # ($module =~ m/^\./) && next; + + # if the module starts with /, it is an absolute path to a file + if ($module =~ m(^/)) { + print "$module\n"; + next; + } + + # sometimes people do use POSIX qw(foo), or use POSIX(qw(foo)) etc. + # we can strip qw.*$, as well as (.*$: + $module =~ s/qw.*$//; + $module =~ s/\(.*$//; + + # if the module ends with .pm, strip it to leave only basename. + $module =~ s/\.pm$//; + + # some perl programmers write 'require URI/URL;' when + # they mean 'require URI::URL;' + + $module =~ s/\//::/; + + # trim off trailing parentheses if any. Sometimes people pass + # the module an empty list. + + $module =~ s/\(\s*\)$//; + + if ( $module =~ m/^v?([0-9._]+)$/ ) { + # if module is a number then both require and use interpret that + # to mean that a particular version of perl is specified + + my $ver = $1; + if ($ver =~ /5.00/) { + $perlreq{"0:$ver"} = 1; + next; + } + else { + $perlreq{"1:$ver"} = 1; + next; + } + + }; + + # ph files do not use the package name inside the file. + # perlmodlib documentation says: + + # the .ph files made by h2ph will probably end up as + # extension modules made by h2xs. + + # so do not expend much effort on these. + + + # there is no easy way to find out if a file named systeminfo.ph + # will be included with the name sys/systeminfo.ph so only use the + # basename of *.ph files + + ($module =~ m/\.ph$/) && next; + + # use base|parent qw(Foo) dependencies + if ($statement eq "use" && ($module eq "base" || $module eq "parent")) { + add_require($module, undef); + if ($version =~ /^qw\s*[(\/'"]\s*([^)\/"']+?)\s*[)\/"']/) { + add_require($_, undef) for split(' ', $1); + } + elsif ($version =~ /(["'])([^"']+)\1/) { + add_require($2, undef); + } + next; + } + $version = undef unless $version =~ /^$modver_re$/o; + + add_require($module, $version); + } + + } + + close(FILE) || + die("$0: Could not close file: '$file' : $!\n"); + + return; +}