[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