[libconfig-model-dpkg-perl] 02/02: C::M::Dpkg::Dependency: do not use regexp to find Perl module in CoreList...

[dod at debian.org]

This is an automated email from the git hooks/post-receive script.

dod pushed a commit to branch master
in repository libconfig-model-dpkg-perl.

commit e79061c7c46c4a2436919563ba886fbe0422ee55
Author: Dominique Dumont <dod at debian.org>
Date:   Tue Feb 17 13:42:57 2015 +0100

    C::M::Dpkg::Dependency: do not use regexp to find Perl module in CoreList...
    
    ... instead create a hash table once to map debian package names with
    Perl module name and use this hash. This is much faster than applying a
    regexp on all core module names
---
 lib/Config/Model/Dpkg/Dependency.pm | 40 +++++++++++++++++++++++++------------
 1 file changed, 27 insertions(+), 13 deletions(-)

diff --git a/lib/Config/Model/Dpkg/Dependency.pm b/lib/Config/Model/Dpkg/Dependency.pm
index 56d187e..1d79ad8 100644
--- a/lib/Config/Model/Dpkg/Dependency.pm
+++ b/lib/Config/Model/Dpkg/Dependency.pm
@@ -123,6 +123,18 @@ my %virtual_hash = map {( $_ => 1); } @virtual_list;
 use vars qw/$test_filter/ ;
 $test_filter = ''; # reserved for tests
 
+my %debian_map;
+my $version = \%Module::CoreList::version;
+
+foreach my $v (values %$version) {
+    foreach my $pm ( keys %$v ) {
+        next unless defined $pm;
+        my $k = lc($pm);
+        $k =~ s/::/-/g;
+        $debian_map{"lib$k-perl"} = $pm;
+    }
+}
+
 my $logger = get_logger("Tree::Element::Value::Dependency") ;
 
 # initialise the global config object with the default values
@@ -414,9 +426,8 @@ sub check_depend_chain {
             my ($dep_name, $oper, $dep_v) = @$depend ;
             $logger->debug("scanning dependency $dep_name"
                 .(defined $dep_v ? " $dep_v" : ''));
-            if ($dep_name =~ /lib([\w+\-]+)-perl/) {
-                my $pname = $1 ;
-                $ret &&= $self->check_perl_lib_dep ($apply_fix, $pname, $actual_dep, $depend,$input);
+            if ($dep_name =~ /lib[\w+\-]+-perl/) {
+                $ret &&= $self->check_perl_lib_dep ($apply_fix, $actual_dep, $depend,$input);
                 last;
             }
         }
@@ -441,12 +452,11 @@ sub extract_cpan_version {
 # called through check_depend_chain
 # does modify $input when applying fix
 sub check_perl_lib_dep {
-    my ($self, $apply_fix, $pname, $actual_dep, $depend, $input) = @_;
-    $logger->debug("called for $pname with $actual_dep with apply_fix $apply_fix");
-
+    my ($self, $apply_fix, $actual_dep, $depend, $input) = @_;
     my ( $dep_name, $oper, $dep_v ) = @$depend;
 
-    $pname =~ s/-/::/g;
+    $logger->debug("called for $dep_name with $actual_dep with apply_fix $apply_fix");
+
 
     # The dependency should be in the form perl (>= 5.10.1) | libtest-simple-perl (>= 0.88)".
     # cf http://pkg-perl.alioth.debian.org/policy.html#debian_control_handling
@@ -455,12 +465,15 @@ sub check_perl_lib_dep {
     # because buildd will use the first available alternative
 
     # check for dual life module, module name follows debian convention...
-    my @dep_name_as_perl = Module::CoreList->find_modules(qr/^$pname$/i) ;
-    return 1 unless @dep_name_as_perl;
+    my $cpan_name = $debian_map{$dep_name};
+    return 1 unless $cpan_name ;
+
+    my $first_perl =  Module::CoreList->first_release($cpan_name) ;
+    return 1 unless $first_perl;
 
-    my $deprecated = Module::CoreList->deprecated_in($dep_name_as_perl[0]) ;
+    my $deprecated = Module::CoreList->deprecated_in($cpan_name) ;
     $logger->debug("dual life $dep_name is deprecated with perl $deprecated") if $deprecated;
-    my $removed    = Module::CoreList->removed_from($dep_name_as_perl[0]) ;
+    my $removed    = Module::CoreList->removed_from($cpan_name) ;
     $logger->debug("dual life $dep_name is removed from perl $removed") if $removed;
 
     return 1 if (defined $dep_v && $dep_v =~ m/^\$/) ;
@@ -497,7 +510,7 @@ sub check_perl_lib_dep {
 	my $cpan_dep_v = $self->extract_cpan_version($check_v);
 
 	my $v_decimal = Module::CoreList->first_release(
-		$dep_name_as_perl[0],
+		$cpan_name,
 		version->parse( $cpan_dep_v )
 	);
 
@@ -507,7 +520,7 @@ sub check_perl_lib_dep {
 	$v_normal =~ s/^v//;    # loose the v prefix
 	if ( $logger->is_debug ) {
 		my $dep_str = $dep_name . ( defined $check_v ? ' ' . $check_v : '' );
-		$logger->debug("dual life $dep_str aka $dep_name_as_perl[0] found in Perl core $v_normal");
+		$logger->debug("dual life $dep_str found in Perl core $v_normal");
 	}
 
 	my ($has_older_perl) = $self->check_versioned_dep(  ['perl', '>=', $v_normal] );
@@ -828,6 +841,7 @@ sub cache_info_from_madison {
 	}
 }
 
+
 __PACKAGE__->meta->make_immutable;
 
 1;

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libconfig-model-dpkg-perl.git