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

[dod]

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 <d...@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

_______________________________________________
Pkg-perl-cvs-commits mailing list
Pkg-perl-cvs-commits@lists.alioth.debian.org
http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits