[SCM] Debian package checker branch, lab-refactor, updated. 2.5.3-77-g7da1441
The following commit has been merged in the lab-refactor branch:
commit 7da144180c21c8e8ceb3bea65984da0508ac12af
Author: Niels Thykier <niels@thykier.net>
Date: Wed Sep 28 10:39:27 2011 +0200
Implemened L::Lab::Manifest::visit_all
The visit_all replaces the get_all, which would be difficult to do
right for the Manifest.
Signed-off-by: Niels Thykier <niels@thykier.net>
diff --git a/lib/Lintian/Lab/Manifest.pm b/lib/Lintian/Lab/Manifest.pm
index 6b5498b..cd973ae 100644
--- a/lib/Lintian/Lab/Manifest.pm
+++ b/lib/Lintian/Lab/Manifest.pm
@@ -126,7 +126,7 @@ my @BIN_QUERY = (
'architecture',
);
-my @SRC_QUERY = (
+my @CHG_QUERY = (
'source',
'version',
'architecture',
@@ -183,7 +183,7 @@ will croak.
sub read_list {
my ($self, $file) = @_;
- my $ehd;
+ my $header;
my $fields;
my $qf;
@@ -195,20 +195,9 @@ sub read_list {
return unless -s $file;
}
- if ($self->{'type'} eq 'source') {
- $ehd = SRCLIST_FORMAT;
- $fields = \@SRC_FILE_FIELDS;
- $qf = \@SRC_QUERY;
- } elsif ($self->{'type'} eq 'binary' || $self->{'type'} eq 'udeb') {
- $ehd = BINLIST_FORMAT;
- $fields = \@BIN_FILE_FIELDS;
- $qf = \@BIN_QUERY;
- } elsif ($self->{'type'} eq 'changes') {
- $ehd = CHGLIST_FORMAT;
- $fields = \@CHG_FILE_FIELDS;
- $qf = \@CHG_QUERY;
- }
- $self->{'state'} = $self->_do_read_file($file, $ehd, $fields, $qf);
+ ($header, $fields, $qf) = $self->_type_to_fields;
+
+ $self->{'state'} = $self->_do_read_file($file, $header, $fields, $qf);
$self->_mark_dirty(0);
return 1;
}
@@ -226,41 +215,57 @@ On error, the contents of $file is undefined.
sub write_list {
my ($self, $file) = @_;
- my $header;
my $state = $self->{'state'};
- my $fields;
+ my ($header, $fields, undef) = $self->_type_to_fields;
+ my $visitor;
+
- if ($self->{'type'} eq 'source') {
- $header = SRCLIST_FORMAT;
- $fields = \@SRC_FILE_FIELDS;
- } elsif ($self->{'type'} eq 'binary' || $self->{'type'} eq 'udeb') {
- $header = BINLIST_FORMAT;
- $fields = \@BIN_FILE_FIELDS;
- } elsif ($self->{'type'} eq 'changes') {
- $header = CHGLIST_FORMAT;
- $fields = \@CHG_FILE_FIELDS;
- }
open my $fd, '>', $file or croak "open $file: $!";
print $fd "$header\n";
- foreach my $entry (sort $self->get_all) {
- my %values = %{ $state->{$entry} };
+
+ $visitor = sub {
+ my ($entry) = @_;
+ my %values = %$entry;
print $fd join(';', @values{@$fields}) . "\n";
- }
+ };
+
+ $self->visit_all ($visitor);
+
close $fd or croak "close $file: $!";
$self->_mark_dirty(0);
return 1;
}
+=item $manifest->visit_all ($visitor[, $key1, ..., $keyN])
-=item $manifest->get_all
+Visits entries and passes them to $visitor. If any keys are passed they
+are used to reduce the search. See get for a list of (common) keys.
-Returns the all the entry names in the manifest
+The $visitor is called as:
+
+ $visitor->($entry, @keys)
+
+Where $entry is the entry and @keys are the keys to be used to look up
+this entry via get method. So for the lintian 2.5.2 binary the keys
+would be something like:
+ ('lintian', '2.5.2', 'all')
=cut
-sub get_all {
- my ($self) = @_;
- croak "Not implemented";
+sub visit_all {
+ my ($self, $visitor, @keys) = @_;
+ my $root;
+ my $type = $self->type;
+ my (undef, undef, $qf) = $self->_type_to_fields;
+
+ if (@keys) {
+ $root = $self->_do_get ($self->{'state'}, @keys);
+ return unless $root;
+ } else {
+ $root = $self->{'state'};
+ }
+
+ $self->_recurse_visit ($root, $visitor, scalar @$qf - 1, @keys);
}
=item $manifest->get (@keys)
@@ -292,29 +297,16 @@ to $entry will not affect the data in $manifest.
sub set {
my ($self, $entry) = @_;
- my $fields;
- my $qf;
my %pdata;
- my $pkg_type = $self->{'type'};
- if ($pkg_type eq 'source') {
- $fields = \@SRC_FILE_FIELDS;
- $qf = \@SRC_QUERY;
- } elsif ($pkg_type eq 'binary' || $pkg_type eq 'udeb') {
- $fields = \@BIN_FILE_FIELDS;
- $qf = \@BIN_QUERY;
- } else {
- $fields = \@CHG_FILE_FIELDS;
- $qf = \@CHG_QUERY;
- }
+ my (undef, $fields, $qf) = $self->_type_to_fields;
# Copy the relevant fields - ensuring all fields are defined.
- %pdata = map { $_ => $data->{$_}//'' } @$fields;
+ %pdata = map { $_ => $entry->{$_}//'' } @$fields;
$self->_do_set ($self->{'state'}, $qf, \%pdata);
$self->_mark_dirty(1);
return 1;
}
-
=item $manifest->delete (@keys)
Removes the entry/entries found by @keys (if any). @keys must contain
@@ -430,7 +422,7 @@ sub _do_set {
for ( my $i = 0 ; $i < $qfl ; $i++) {
# Current key
my $curk = $entry->{$qf->[$i]};
- my $element = $n->{$curk};
+ my $element = $cur->{$curk};
unless (defined $element) {
$element = {};
$cur->{$curk} = $element;
@@ -442,6 +434,50 @@ sub _do_set {
return 1;
}
+
+# Returns ($header, $fields, $qf) - their value is based on $self->type.
+# - $header is XXXLIST_FORMAT
+# - $fields is \@XXX_FILE_FIELDS
+# - $qf is \@XXX_QUERY
+sub _type_to_fields {
+ my ($self) = @_;
+ my $header;
+ my $fields;
+ my $qf;
+ my $type = $self->{'type'};
+
+ if ($type eq 'source') {
+ $fields = \@SRC_FILE_FIELDS;
+ $qf = \@SRC_QUERY;
+ $header = SRCLIST_FORMAT;
+ } elsif ($type eq 'binary' || $type eq 'udeb') {
+ $fields = \@BIN_FILE_FIELDS;
+ $qf = \@BIN_QUERY;
+ $header = BINLIST_FORMAT;
+ } elsif ($type eq 'changes') {
+ $fields = \@CHG_FILE_FIELDS;
+ $qf = \@CHG_QUERY;
+ $header = CHGLIST_FORMAT;
+ } else {
+ croak "Unknown type $type";
+ }
+ return ($header, $fields, $qf);
+}
+
+# Self-recursing method powering visit_all
+sub _recurse_visit {
+ my ($self, $hash, $visitor, $vdep, @keys) = @_;
+ # if false, we recurse, if true we pass it to $visitor
+ my $visit = $vdep == scalar @keys;
+ foreach my $k (sort keys %$hash) {
+ my $v = $hash->{$k};
+ # Should we recurse into $v?
+ $self->_recurse_visit ($v, $visitor, $vdep, @keys, $k) unless $visit;
+ # ... or is it the value to be visited?
+ $visitor->($v, @keys, $k) if $visit;
+ }
+}
+
=back
=head1 AUTHOR
diff --git a/t/scripts/Lintian/Internal/PackageList/01-basic.t b/t/scripts/Lintian/Lab/Manifest/01-basic.t
similarity index 62%
copy from t/scripts/Lintian/Internal/PackageList/01-basic.t
copy to t/scripts/Lintian/Lab/Manifest/01-basic.t
index 0072324..7015b21 100644
--- a/t/scripts/Lintian/Internal/PackageList/01-basic.t
+++ b/t/scripts/Lintian/Lab/Manifest/01-basic.t
@@ -5,30 +5,33 @@ use warnings;
use Test::More tests => 7;
-BEGIN { use_ok('Lintian::Internal::PackageList'); }
+BEGIN { use_ok('Lintian::Lab::Manifest'); }
-my $plist = Lintian::Internal::PackageList->new('changes');
+my $plist = Lintian::Lab::Manifest->new ('changes');
my $input = {
'source' => 'src',
'version' => '0.10',
'file' => 'src_0.10.changes',
+ 'architecture' => 'i386',
'timestamp' => '1264616563', # Release date of S-V 3.8.4 (according to our data files)
'random-field' => 'hallo world',
};
my $output;
my @contents;
-my $orig_file = $input->{'file'}; # safe for later
+my @keys;
+my $orig_file = $input->{'file'}; # save for later
-$plist->set($input->{'source'}, $input);
-@contents = $plist->get_all;
+$plist->set ($input);
+# Collect all entries and their keys
+$plist->visit_all (sub { my ($v, @k) = @_; push @contents, $v; push @keys, \@k} );
is(@contents, 1, "Contents one element");
-is($contents[0], $input->{'source'}, "Element has the right name");
+is($contents[0]->{'source'}, $input->{'source'}, "Element has the right name");
# Change input, output should be unaffected
$input->{'file'} = "lalalala";
-$output = $plist->get($input->{'source'});
+$output = $plist->get (@{ $keys[0] });
ok($output, "get returns a defined object");
is($output->{'source'}, $input->{'source'}, "Input{source} eq Output{source}");
diff --git a/t/scripts/Lintian/Internal/PackageList/02-io.t b/t/scripts/Lintian/Lab/Manifest/02-io.t
similarity index 56%
copy from t/scripts/Lintian/Internal/PackageList/02-io.t
copy to t/scripts/Lintian/Lab/Manifest/02-io.t
index cd1304b..50939fb 100644
--- a/t/scripts/Lintian/Internal/PackageList/02-io.t
+++ b/t/scripts/Lintian/Lab/Manifest/02-io.t
@@ -4,7 +4,7 @@ use strict;
use warnings;
use Test::More;
-use Lintian::Internal::PackageList;
+use Lintian::Lab::Manifest;
my $DATADIR = $0;
$DATADIR =~ s,[^/]+$,,o;
@@ -21,17 +21,18 @@ plan skip_all => 'Data files not available'
plan tests => 9;
-my $plist = Lintian::Internal::PackageList->new('changes');
-my $olist = Lintian::Internal::PackageList->new('changes');
+my $plist = Lintian::Lab::Manifest->new ('changes');
+my $olist = Lintian::Lab::Manifest->new ('changes');
$plist->read_list("$DATADIR/changes1-info");
-my @all = sort $plist->get_all;
-my @oall;
+my @all;
my $inmemdata;
+$plist->visit_all (sub { push @all, $_[1] });
+
is( @all, 3, "Read 3 elements from the data file");
for ( my $i = 0; $i < scalar @all; $i++) {
my $no = $i + 1;
- is($all[$i], "pkg$no", "The first element is pkg$no");
+ is($all[$i], "pkg$no", "Element $no is pkg$no");
}
ok( eval {
@@ -41,16 +42,22 @@ ok( eval {
}, "Wrote and read the data");
SKIP: {
+ my @pkeys;
+ my @pval;
+ my @oval;
+ my $pv = sub { my ($v, @k) = @_; push @pval, $v; push @pkeys, \@k };
+ my $ov = sub { push @oval, $_[0] };
if ($@) {
diag("Write/Read issue: $@");
skip 'Write test failed; the rest of the tests will not work', 4;
}
- @oall = sort $olist->get_all;
- is_deeply(\@all, \@oall, "The lists contents the same elements");
- for ( my $i = 0 ; $i < scalar @all ; $i++) {
+ $plist->visit_all ($pv);
+ $olist->visit_all ($ov);
+ is_deeply(\@pval, \@oval, "The lists contents the same elements");
+ for ( my $i = 0 ; $i < scalar @pkeys ; $i++) {
my $no = $i + 1;
- my $e = $plist->get($all[$i]);
- my $oe = $olist->get($all[$i]);
+ my $e = $plist->get (@{ $pkeys[$i] });
+ my $oe = $olist->get (@{ $pkeys[$i] });
is_deeply($e, $oe, "Element no. $no are identical");
}
}
diff --git a/t/scripts/Lintian/Internal/PackageList/data/changes1-info b/t/scripts/Lintian/Lab/Manifest/data/changes1-info
similarity index 100%
copy from t/scripts/Lintian/Internal/PackageList/data/changes1-info
copy to t/scripts/Lintian/Lab/Manifest/data/changes1-info
--
Debian package checker
Reply to: