[libconfig-model-dpkg-perl] 23/33: Scanner: added __create_tree_leaf_from_paths function

dod at debian.org dod at debian.org
Mon Mar 30 17:41:43 UTC 2015


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 97330d4eff7a0e527ffa6c6712b0110574ab75f6
Author: Dominique Dumont <dod at debian.org>
Date:   Sat Mar 28 11:58:32 2015 +0100

    Scanner: added __create_tree_leaf_from_paths function
---
 lib/Config/Model/Dpkg/Copyright.pm |  8 ++------
 lib/Dpkg/Copyright/Scanner.pm      | 14 +++++++++-----
 2 files changed, 11 insertions(+), 11 deletions(-)

diff --git a/lib/Config/Model/Dpkg/Copyright.pm b/lib/Config/Model/Dpkg/Copyright.pm
index 41c3b4e..a769ac9 100644
--- a/lib/Config/Model/Dpkg/Copyright.pm
+++ b/lib/Config/Model/Dpkg/Copyright.pm
@@ -14,7 +14,7 @@ use Path::Tiny;
 use Data::Dumper;
 
 use Config::Model::DumpAsData;
-use Dpkg::Copyright::Scanner qw/scan_files __squash __pack_files/;
+use Dpkg::Copyright::Scanner qw/scan_files __squash __pack_files __create_tree_leaf_from_paths/;
 use Software::LicenseUtils;
 use Scalar::Util qw/weaken/;
 
@@ -82,11 +82,7 @@ sub update ($self, %args) {
             }
 
             # explode path in subpaths
-            my @subpaths = split '/', $path;
-            my $h = \%new_split_files;
-            my $last = pop @subpaths;
-            map { $h = $h->{$_} ||= {} } @subpaths ;
-            $h->{$last} = $d_key;
+            __create_tree_leaf_from_paths(\%new_split_files, $path, $d_key);
         }
     }
 
diff --git a/lib/Dpkg/Copyright/Scanner.pm b/lib/Dpkg/Copyright/Scanner.pm
index 986eb32..dc0f005 100644
--- a/lib/Dpkg/Copyright/Scanner.pm
+++ b/lib/Dpkg/Copyright/Scanner.pm
@@ -114,11 +114,7 @@ sub scan_files ( %args ) {
 
         my $a = $copyrights{$c}{$l} //= $id++;
         # split file path and fill recursive hash, leaf is id
-        my @path = split m!/!,$f;
-        my $file = pop @path;
-        my $tmp = $files ;
-        map { $tmp = $tmp->{$_} ||= {};  } @path;
-        $tmp->{$file} = $a;
+        __create_tree_leaf_from_paths ($files,$f,$a);
     }
 
     my @copyrights_by_id ;
@@ -160,6 +156,14 @@ sub __split_copyright ($c) {
     return ($owner, at data);
 }
 
+sub __create_tree_leaf_from_paths ($h,$path,$value) {
+    # explode path in subpaths
+    my @subpaths = split '/', $path;
+    my $last = pop @subpaths;
+    map { $h = $h->{$_} ||= {} } @subpaths ;
+    $h->{$last} = $value;
+}
+
 sub __pack_copyright ($r) {
 
     return $r if $r eq 'no-info-found';

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



More information about the Pkg-perl-cvs-commits mailing list