perl.prov (rpm-perlprov) i perl-* do poprawki

[Robert Grabowski]

Witam!

    Zwalona jest spora część pakietów perl-*, a to za sprawą walniętego 
perl.prov z rpm-perlprov. Nie wyszukuje on poprawnie provides, a 
dokładnie nie zawsze określa ich wersję. Jest to błąd rpm, bo nawet 
najnowszy z cvs.rpm.org jest też walnięty. Udało mi się zlokalizować 
następujące przypadki, gdy rpm-perlprov nie znajdował wersji pakietu:

1. np. Tie::Handle
package PACKAGE;
[...]
our $VERSION = '1.2';

2. np. RPC::PlClient
package PACKAGE;
[...]
$PACKAGE::VERSION = '0.2016';

3. np. Getopt::Long
package PACKAGE;
[...]
$VERSION = '11.00';
[...]
package PACKAGE;

Z powodu błędnie określonych provides w pakietach perl-modules 
(przypadek nr. 3) oraz perl-PlRPC (przypadek nr. 2) nie chce się 
instalować perl-DBI. Może takich kwiatków jest więcej, ale ja ich nie 
zauważyłem.

Nie mam prawa zpisu do CVS'a, a zgłosić się nie ma jak (link na 
www.pld.org.pl nie działa) podsyłam poprawiony
perl.prov tutaj. Powinien on trafić do rpm-perlprov ... Patch, które 
modyfikował perl.prov nie jest już potrzebny... Nowy perl.prov bazuje na 
tym, który jest w rpm-4.0.4...

Ktoś mógłby to przetestować zanim trafi to do CVS'a :) U mnie działa :)

pozdrawiam

-- 
Robert Grabowski   7bulls.com S.A.

email: Robert.Grabowski at 7bulls.com
office: +48 56 655 79 65
mobile: +48 604 181 907
-------------- next part --------------
#!/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 <ewt at redhat.com>.

# a simple script to print the proper name for perl libraries.

# To save development time I do not parse the perl grammmar 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 at staff.mail.com

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 $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 arround 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;
  
  open(FILE, "<$file") || return;

  my ($package, $version, $incomment, $inover) = ();

  while (<FILE>) {
    
    # 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/^=(head1|head2|pod|item)/) {
      $incomment = 1;
    }

    if (m/^=(cut)/) {
      $incomment = 0;
      $inover = 0;
    }
    
    if (m/^=(over)/) {
      $inover = 1;
    }

    if (m/^=(back)/) {
      $inover = 0;
    }

    if ($incomment || $inover) {
       next;
    }
    
    # skip the data section
    if (m/^__(DATA|END)__$/) {
      last;
    }

    # not everyone puts the package name of the file as the first
    # package name so we report all namespaces as if they were
    # provided packages (really ugly).

	if (m/^\s*package\s+([_:a-zA-Z0-9]+)\s*;/ && !$require{$1}) {
		$package = $1;
		$version = undef;
	}

    # 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.7 $ =~ /(\d+)\.(\d+)/);
    #ExtUtils/Install.pm:$VERSION = substr q$Revision: 1.7 $, 10;
    #CGI/Apache.pm:$VERSION = (qw$Revision: 1.7 $)[1];
    #DynaLoader.pm:$VERSION = $VERSION = "1.03";     # avoid typo warning

	if ($package) {
		if (m/^\s*(our)?\s*\$(${package}::)?VERSION\s*=/) {

			# first see if the version string contains the string
			# '$Revision' this often causes bizzare strings and is the most
			# common method of non static numbering.

			if (m/(\$Revision: (\d+[.0-9]+))/) {
				$version = $2; 
			} elsif (m/[\'\"]?(\d+[.0-9]+)[\'\"]?/) {
	      
				# look for a static number hard coded in the script
	
				$version = $1; 
			}
		}
		$require{$package} = $version;
	}
    
    # 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*\$RPM_Provides\s*=\s*["'](.*)['"]/i) {
      foreach $_ (spit(/\s+/, $1)) {
	print "$_\n";
      }
    }

  }

  close(FILE) ||
    die("$0: Could not close file: '$file' : $!\n");

  return ;
}