[devel] perl.{req,prov} improvements

[mookid@sigent.ru (Mikhail Zabaluev)]

[-- Attachment #1: Type: text/plain, Size: 757 bytes --]

Доброе время суток.

Предлагаются новые доработки скриптов автоматического поиска зависимостей
для rpm. Теперь perl.req записывает в зависимости только те файлы,
которые существуют в системе или устанавливаются текущей сборкой.
Не знаю, насколько это хорошо идеологически, но позволяет избавиться от
некоторых совсем фантомных зависимостей.

Дмитрию: c find-{provides,requires} была проблема, они дают
начальную пустую строку на вход этих скриптов. Я от этого защитился, но
все же лучше формировать списки так (поскольку порядок неважен):

LIST_PERL="$f
$LIST_PERL"

-- 
Stay tuned,
  MhZ                                    mailto:mookid@sigent.ru
-----------
Neurotics build castles in the sky,
Psychotics live in them,
And psychiatrists collect the rent.

[-- Attachment #2: reqprov.patch --]
[-- Type: text/plain, Size: 2255 bytes --]

--- perl.req.orig	Thu Nov 30 12:32:34 2000
+++ perl.req	Thu Nov 30 13:01:51 2000
@@ -58,15 +58,37 @@
 }
 
 
+# obtain the list of library directories. If not provided, use @INC
+
+if (exists $ENV{RPM_PERL_LIB_PATH}) {
+  @perl_inc = split(/[:,\s]+/, $ENV{RPM_PERL_LIB_PATH});
+}
+else {
+  @perl_inc = grep { m|^/| } @INC;
+}
+
+# add installation mirrors to the library search list
+
+my $buildroot = $ENV{RPM_BUILD_ROOT};
+push @perl_inc, map { "${buildroot}$_" } @perl_inc;
+
+
 foreach $module (sort keys %require) {
+
+  # search for the file to be installed in the system or in this same package
+
+  my $found = 0;
+  for (@perl_inc) {
+    if (-e "$_/$module") {
+      $found = 1;
+      last;
+    }
+  }
+  next unless $found;
+
   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_* vairable when I upgrage.
-
     print "perl($module) >= $require{$module}\n";
   }
 }
@@ -80,6 +102,8 @@
   my ($file) = @_;
   chomp($file);
 
+  return if $file eq '';
+
   open(FILE, "<$file")||
     die("$0: Could not open file: '$file' : $!\n");
   
@@ -147,11 +171,6 @@
 
       next if $2 eq '"' && $module =~ /\$/;
 
-      # ignore files with non-perl suffixes because they will not be detected
-      # by find-provides
-
-      next unless $module =~ /\.p[lmh]/;
-
       $module = File::Spec->canonpath($module);
 
       if (File::Spec->file_name_is_absolute) {
@@ -164,7 +183,7 @@
 
       # unsure what to do with paths that lead to parent directories
 
-      next if $module =~ /\.\.\//;
+      next if $module =~ /(^|\/)\.\.\//;
 
       # otherwise, continue with $module set
 
@@ -210,7 +229,7 @@
 
 sub package_version {
   my $version = shift;
-  if ($version =~ s/^v// || $version =~ /\.\d+\./) {
+  if ($version =~ s/^v// || $version =~ /\.[\d_]+\./) {
     return "1:$version";
   }
   else {
--- perl.prov.orig	Thu Nov 30 13:00:32 2000
+++ perl.prov	Thu Nov 30 13:00:39 2000
@@ -124,6 +124,8 @@
   my ($file) = @_;
   chomp $file;
 
+  return if $file eq '';
+
   # find the longest matching prefix among Perl library search directories
 
   my $prefix = '';