[SCM] Debian package checker branch, master, updated. 2.5.8-24-gff44271

["Niels Thykier" <niels@thykier.net>]

The following commit has been merged in the master branch:
commit ff44271bcd86131c3fd1c195302dd48366f576d2
Author: Niels Thykier <niels@thykier.net>
Date:   Fri Jun 8 12:03:04 2012 +0200

    L::Path: Add children method for dir entries
    
    Signed-off-by: Niels Thykier <niels@thykier.net>

diff --git a/checks/files b/checks/files
index 295684d..34043f3 100644
--- a/checks/files
+++ b/checks/files
@@ -1431,9 +1431,7 @@ sub dir_counts {
     my ($info, $dir) = @_;
 
     if (defined $info->index->{$dir}) {
-        # internal access to undocumented field
-        # - stinks, but "count" is hardly API worthy.
-        return $info->index->{$dir}->{count} || 0;
+        return scalar $info->index->{$dir}->children;
     } else {
         return 0;
     }
diff --git a/lib/Lintian/Collect/Package.pm b/lib/Lintian/Collect/Package.pm
index 45fcaa4..83fdaec 100644
--- a/lib/Lintian/Collect/Package.pm
+++ b/lib/Lintian/Collect/Package.pm
@@ -74,18 +74,12 @@ sub index {
 #  sub sorted_index Needs-Info index
 sub sorted_index {
     my ($self) = @_;
-    my $index;
-    my @result;
-    return @{ $self->{sorted_index} } if exists $self->{sorted_index};
-    $index = $self->index();
-    @result = sort keys %{$index};
-    shift @result if scalar @result && $result[0] eq '';
-    $self->{sorted_index} = \@result;
-    return @result;
+    # index does all our work for us, so call it if sorted_index has
+    # not been created yet.
+    $self->index unless exists $self->{sorted_index};
+    return @{ $self->{sorted_index} };
 }
 
-
-
 # Backing method for unpacked, debfiles and others; this is not a part of the
 # API.
 # sub _fetch_extracted_dir Needs-Info <>
@@ -125,9 +119,10 @@ sub _fetch_index_data {
     my ($self, $field, $index, $indexown) = @_;
     return $self->{$field} if exists $self->{$index};
     my $base_dir = $self->base_dir();
-    my (%idxh, %dir_counts);
+    my (%idxh, %children);
     my $num_idx;
     my %rhlinks;
+    my @sorted;
     local $_;
     open my $idx, '-|', 'gzip', '-dc', "$base_dir/${index}.gz"
         or croak "cannot open index file $base_dir/${index}.gz: $!";
@@ -172,18 +167,18 @@ sub _fetch_index_data {
         }
         $file{name} = $name = _dequote_name ($name);
 
-        # count directory contents:
-        $dir_counts{$name} ||= 0 if $file{type} eq 'd';
-        $dir_counts{$1} = ($dir_counts{$1} || 0) + 1
-            if $name =~ m,^(.+/)[^/]+/?$,;
+        # Record children
+        $children{$name} ||= [] if $file{type} eq 'd';
+        my ($parent) = ($name =~ m,^(.+/)?[^/]+/?$,);
+        $parent = '' unless defined $parent;
+        $children{$parent} = [] unless exists $children{$parent};
+        push @{ $children{$parent} }, $name;
 
         $idxh{$name} = \%file;
     }
-    foreach my $file (keys %idxh) {
+    @sorted = sort keys %idxh;
+    foreach my $file (@sorted) {
         my $e = $idxh{$file};
-        if ($dir_counts{$e->{name}}) {
-            $e->{count} = $dir_counts{$e->{name}};
-        }
         if ($rhlinks{$e->{name}}) {
             # There is hard link pointing to this file (or hardlink).
             my %candidates = ();
@@ -224,10 +219,18 @@ sub _fetch_index_data {
             }
         }
     }
-    foreach my $file (keys %idxh) {
+    foreach my $file (reverse @sorted) {
+        # Add them in reverse order - entries in a dir are made
+        # objects before the dir itself.
+        if ($idxh{$file}->{type} eq 'd') {
+            $idxh{$file}->{children} = [ map { $idxh{$_} } sort @{ $children{$file} } ];
+        }
         $idxh{$file} = Lintian::Path->new ($idxh{$file});
     }
     $self->{$field} = \%idxh;
+    # Remove the "top" dir in the sorted_index as it is hardly ever used.
+    shift @sorted if scalar @sorted && $sorted[0] eq '';
+    $self->{"sorted_$field"} = \@sorted;
     close $idx;
     close $num_idx if $num_idx;
     return $self->{$field};
diff --git a/lib/Lintian/Path.pm b/lib/Lintian/Path.pm
index d395b45..d28202c 100644
--- a/lib/Lintian/Path.pm
+++ b/lib/Lintian/Path.pm
@@ -145,6 +145,20 @@ for symlinks.
 
 Lintian::Path->mk_ro_accessors (qw(name owner group link type uid gid size date operm));
 
+=item children
+
+Returns a list of children (as Lintian::Path objects) of this entry.
+The list and its contents should not be modified.
+
+NB: Returns the empty list for non-dir entries.
+
+=cut
+
+sub children {
+    my ($self) = @_;
+    return @{ $self->{'children'} };
+}
+
 # Backing method implementing the is_X tests
 sub _is_type {
     my ($self, $t) = @_;

-- 
Debian package checker