[libconfig-model-dpkg-perl] 07/27: clarified code and added comments

[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 ebe9a3760ca850c4db87732774ed1ed454d6ca99
Author: Dominique Dumont <dod at debian.org>
Date:   Wed Dec 17 08:26:18 2014 +0100

    clarified code and added comments
---
 lib/Dpkg/Copyright/Scanner.pm | 44 +++++++++++++++++++++++++++----------------
 1 file changed, 28 insertions(+), 16 deletions(-)

diff --git a/lib/Dpkg/Copyright/Scanner.pm b/lib/Dpkg/Copyright/Scanner.pm
index 8a23dea..55c7b34 100644
--- a/lib/Dpkg/Copyright/Scanner.pm
+++ b/lib/Dpkg/Copyright/Scanner.pm
@@ -121,6 +121,7 @@ sub scan_files {
     return @copyright_data;
 }
 
+#in each directory, pack files that have the same copyright/license information
 sub __pack ($h, $pack, @path) {
     my $old_id ;
     foreach my $file (sort keys %$h) {
@@ -138,25 +139,30 @@ sub __pack ($h, $pack, @path) {
     }
 }
 
+# $h is a tree of hash matching the directory structure. Each leaf is a
+# copyright id.
 sub __squash ($h) {
     my %count ;
 
-    foreach my $file (sort keys %$h) {
-        my $id = $h->{$file};
-        if (ref($id)) {
-            # squash may return a plain id, or a hash with '*' => id , or a non squashable hash
-            $h->{$file} = __squash($id);
-        }
-        if (ref($id) and defined $id->{'*'}) {
-            $id = $id->{'*'};
+    # count the number of times each (c) info is used in this directory.
+    # (including the main (c) info of each subdirectory)
+    foreach my $name (sort keys %$h) {
+        my $item = $h->{$name};
+        if (ref($item)) {
+            # squash may return a plain id, or a hash with '*' => id ,
+            # or a non squashable hash
+            $h->{$name} = __squash($item);
         }
-        # do not count non squashable hashes
+        my $id = (ref($item) and defined $item->{'*'}) ? $item->{'*'} : $item ;
+
+        # do not count non squashable hashes (i.e. there's no main (c) info)
         if (not ref ($id)) {
             $count{$id}//=0;
             $count{$id} ++;
         }
     }
 
+    # find the most used (c) info in this directory
     my $max = 0;
     my $max_id;
     foreach my $id (sort keys %count) {
@@ -166,16 +172,22 @@ sub __squash ($h) {
         }
     }
 
-    foreach my $file (sort keys %$h) {
-        my $id = $h->{$file};
-        if (ref($id) and defined $id->{'*'} and $id->{'*'} == $max_id) {
-            delete $id->{'*'};
-            delete $h->{$file} unless keys $h->{$file}->%*;
+    # all files associated to the most used (c) info are deleted to
+    # be represented by '*' entry
+    foreach my $name (sort keys %$h) {
+        my $item = $h->{$name};
+        if (ref($item) and defined $item->{'*'} and $item->{'*'} == $max_id) {
+            # delete ./item/* which is covered by ./*
+            delete $item->{'*'};
+            # delete ./item if no files with different (c) info are there
+            delete $h->{$name} unless keys $h->{$name}->%*;
         }
-        if (not ref ($id)) {
-            delete $h->{$file} if $id == $max_id;
+        if (not ref ($item)) {
+            # delete file that is represented by '*' entry
+            delete $h->{$name} if $item == $max_id;
         }
     }
+    # here's the '*' file representing the most used (c) info
     $h->{'*'} = $max_id ;
 
     return $h;

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