[SCM] Debian package checker branch, lab-refactor, updated. 2.5.3-103-g7acebbb
The following commit has been merged in the lab-refactor branch:
commit 7acebbbbe7704c16d0ee2670b1f5ceb0399b1832
Author: Niels Thykier <niels@thykier.net>
Date: Sun Oct 9 11:41:47 2011 +0200
Fixed the diff method for Lintian::Lab::Manifest
Manifests can now be diff'ed, resulting in a ManifestDiff object.
This adds a (Build-)Depends on libclone-perl.
Signed-off-by: Niels Thykier <niels@thykier.net>
diff --git a/debian/control b/debian/control
index ec4af83..19a5b64 100644
--- a/debian/control
+++ b/debian/control
@@ -23,6 +23,7 @@ Build-Depends: binutils,
javahelper (>= 0.32~),
libapt-pkg-perl,
libclass-accessor-perl,
+ libclone-perl,
libdpkg-perl,
libdigest-sha-perl,
libemail-valid-perl,
@@ -62,6 +63,7 @@ Depends: binutils,
intltool-debian,
libapt-pkg-perl,
libclass-accessor-perl,
+ libclone-perl,
libdigest-sha-perl,
libdpkg-perl,
libemail-valid-perl,
diff --git a/lib/Lintian/Lab/Manifest.pm b/lib/Lintian/Lab/Manifest.pm
index 8e6891b..8610569 100644
--- a/lib/Lintian/Lab/Manifest.pm
+++ b/lib/Lintian/Lab/Manifest.pm
@@ -23,10 +23,12 @@ package Lintian::Lab::Manifest;
use strict;
use warnings;
-use base qw(Class::Accessor);
+use base qw(Class::Accessor Clone);
use Carp qw(croak);
+use Lintian::Lab::ManifestDiff;
+
=head1 NAME
Lintian::Lab::Manifest -- Lintian Lab manifest
@@ -352,6 +354,53 @@ sub delete {
return 1;
}
+=item $manifest->diff ($newlist)
+
+Returns a L<Lintian::Lab::ManifestDiff|diff> between $manifest and
+$newlist.
+
+$manifest is considered the "original" and "$newlist" is "new" version
+of the manifest. (See the olist and nlist methods of
+L<Lintian::Lab::ManifestDiff> for more information.
+
+=cut
+
+sub diff {
+ my ($self, $other) = @_;
+ my $copy;
+ my @changed;
+ my @added;
+ my @removed;
+ my $visitor;
+ croak "Diffing incompatible types" unless $self->{'type'} eq $other->{'type'};
+ $copy = $self->clone;
+
+ $visitor = sub {
+ my ($ov, @keys) = @_;
+ my $sv = $copy->get (@keys);
+ unless (defined $sv) {
+ push @added, \@keys;
+ return;
+ }
+ if ($sv->{'version'} ne $ov->{'version'} ||
+ $sv->{'timestamp'} ne $ov->{'timestamp'}) {
+ push @changed, \@keys;
+ }
+ # Remove the entry from $copy
+ $copy->delete (@keys);
+ }; # End of visitor sub
+
+ # Find all the added and changed entries - since $visitor removes
+ # all entries it finds from $copy, $copy will contiain the elements
+ # only in $self after this call.
+ $other->visit_all ($visitor);
+ # Thus we can just add all of these entries to @removed. :)
+ $copy->visit_all (sub { my (undef, @keys) = @_; push @removed, \@keys; });
+
+ return Lintian::Lab::ManifestDiff->_new ($self->{'type'}, $other, $self,
+ \@added, \@removed, \@changed);
+}
+
### Internal methods ###
# $plist->_mark_dirty($val)
diff --git a/lib/Lintian/Internal/PackageListDiff.pm b/lib/Lintian/Lab/ManifestDiff.pm
similarity index 57%
copy from lib/Lintian/Internal/PackageListDiff.pm
copy to lib/Lintian/Lab/ManifestDiff.pm
index 07cf530..d336b5f 100644
--- a/lib/Lintian/Internal/PackageListDiff.pm
+++ b/lib/Lintian/Lab/ManifestDiff.pm
@@ -18,7 +18,7 @@
# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
# MA 02110-1301, USA.
-package Lintian::Internal::PackageListDiff;
+package Lintian::Lab::ManifestDiff;
use strict;
use warnings;
@@ -27,28 +27,28 @@ use base qw(Class::Accessor);
=head1 NAME
-Lintian::Inernal::PackageListDiff -- Difference representation between two PackageLists
+Lintian::Lab::ManifestDiff -- Difference representation between two Manifests
=head1 SYNOPSIS
- use Lintian::Internal::PackageList;
+ use Lintian::Lab::Manifest;
- my $olist = Lintian::Internal::PackageList->new('binary');
- my $nlist = Lintian::Internal::PackageList->new('binary');
- $olist->read_list('old/binary-packages');
- $nlist->read_list('new/binary-packages');
- my $diff = $nlist->diff($olist);
+ my $olist = Lintian::Lab::Manifest->new ('binary');
+ my $nlist = Lintian::Lab::Manifest->new ('binary');
+ $olist->read_list ('old/binary-packages');
+ $nlist->read_list ('new/binary-packages');
+ my $diff = $olist->diff($nlist);
foreach my $added (@{ $diff->added }) {
- my $entry = $nlist->get($added);
+ my $entry = $nlist->get (@$added);
# do something
}
foreach my $removed (@{ $diff->removed }) {
- my $entry = $olist->get($removed);
+ my $entry = $olist->get (@$removed);
# do something
}
foreach my $changed (@{ $diff->changed }) {
- my $oentry = $olist->get($changed);
- my $nentry = $nlist->get($changed);
+ my $oentry = $olist->get (@$changed);
+ my $nentry = $nlist->get (@$changed);
# use/diff $oentry and $nentry as needed
}
@@ -63,7 +63,7 @@ the Lab as caches.
=cut
-# Private constructor (used by Lintian::Internal::PackageList
+# Private constructor (used by Lintian::Lab::Manifest::diff)
sub _new {
my ($class, $type, $nlist, $olist, $added, $removed, $changed) = @_;
my $self = {
@@ -80,29 +80,38 @@ sub _new {
=item $diff->added
-Returns a list ref containing the names of the elements that has been added.
+Returns a list ref containing the keys of the elements that has been added.
+
+Each element is a list of keys; this list (deref'ed) can be used with the
+manifest's get method to look up the item.
=item $diff->removed
-Returns a list ref containing the names of the elements that has been removed.
+Returns a list ref containing the keys of the elements that has been removed.
+
+Each element is a list of keys; this list (deref'ed) can be used with the
+manifest's get method to look up the item.
=item $diff->changed
-Returns a list ref containing the names of the elements that has been changed.
+Returns a list ref containing the keys of the elements that has been changed.
+
+Each element is a list of keys; this list (deref'ed) can be used with the
+manifest's get method to look up the item.
=item $diff->nlist
-Returns the "new" list used to create this diff. Note the list is not
+Returns the "new" manifest used to create this diff. Note the manifest is not
copied and may have been changed since the diff has been created.
=item $diff->olist
-Returns the "old" list used to create this diff. Note the list is not
+Returns the "orig" manifest used to create this diff. Note the manifest is not
copied and may have been changed since the diff has been created.
=cut
-Lintian::Internal::PackageListDiff->mk_ro_accessors (qw(added removed changed type nlist olist));
+Lintian::Lab::ManifestDiff->mk_ro_accessors (qw(added removed changed type nlist olist));
1;
diff --git a/t/scripts/Lintian/Lab/Manifest/03-diff.t b/t/scripts/Lintian/Lab/Manifest/03-diff.t
new file mode 100644
index 0000000..32e1f72
--- /dev/null
+++ b/t/scripts/Lintian/Lab/Manifest/03-diff.t
@@ -0,0 +1,65 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Lintian::Lab::Manifest;
+
+my $DATADIR = $0;
+$DATADIR =~ s,[^/]+$,,o;
+if ($DATADIR) {
+ # invokved in some other dir
+ $DATADIR = "$DATADIR/data";
+} else {
+ # current dir
+ $DATADIR = 'data';
+}
+
+plan skip_all => 'Data files not available'
+ unless -d $DATADIR;
+
+my $origm = Lintian::Lab::Manifest->new ('changes');
+my $newm = Lintian::Lab::Manifest->new ('changes');
+my $diff;
+
+my ($added, $changed, $removed);
+
+$origm->read_list ("$DATADIR/orig-list-info");
+$newm->read_list ("$DATADIR/new-list-info");
+
+$diff = $origm->diff ($newm);
+
+# We are good to go :)
+plan tests => 12;
+
+$added = $diff->added;
+$changed = $diff->changed;
+$removed = $diff->removed;
+
+# Do we get the expected amount of changes ?
+is (@{ $added }, 1, 'One new package');
+is (@{ $changed }, 1, 'One changed package');
+is (@{ $removed }, 1, 'One removed package');
+
+# Are the names of the packages involved in the changes correct?
+is ($added->[0][0] , 'newpkg', 'The new package is "newpkg"');
+is ($changed->[0][0], 'modpkg', 'The changed package is "modpkg"');
+is ($removed->[0][0], 'oldpkg', 'The removed package is "oldpkg"');
+
+# Do the change packages appear in the right lists?
+ok ($newm->get (@{ $added->[0] }), 'The new package can be looked up in new-list');
+is ($origm->get (@{ $added->[0] }), undef, 'The new package cannot be looked up in orig-list');
+
+ok ($newm->get (@{ $changed->[0] }), 'The changed package can be looked up in new-list');
+ok ($origm->get (@{ $changed->[0] }), 'The changed package can be looked up in orig-list');
+
+is ($newm->get (@{ $removed->[0] }), undef, 'The old package cannot be looked up in new-list');
+ok ($origm->get (@{ $removed->[0] }), 'The old package can be looked up in orig-list');
+
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
diff --git a/t/scripts/Lintian/Lab/Manifest/data/new-list-info b/t/scripts/Lintian/Lab/Manifest/data/new-list-info
new file mode 100644
index 0000000..a19ebdb
--- /dev/null
+++ b/t/scripts/Lintian/Lab/Manifest/data/new-list-info
@@ -0,0 +1,4 @@
+Lintian's list of changes packages in the archive--V1
+modpkg;1.0-1;i386;modpkg1_1.0-1.changes;1264626564
+newpkg;1.0;i386;oldpkg_1.0.changes;1264616563
+umodpkg;1.0;i386;umodpkg_1.0.changes;1264616567
diff --git a/t/scripts/Lintian/Lab/Manifest/data/orig-list-info b/t/scripts/Lintian/Lab/Manifest/data/orig-list-info
new file mode 100644
index 0000000..9ebcd49
--- /dev/null
+++ b/t/scripts/Lintian/Lab/Manifest/data/orig-list-info
@@ -0,0 +1,4 @@
+Lintian's list of changes packages in the archive--V1
+modpkg;1.0-1;i386;modpkg1_1.0-1.changes;1264616564
+oldpkg;1.0;i386;oldpkg_1.0.changes;1264616563
+umodpkg;1.0;i386;umodpkg_1.0.changes;1264616567
--
Debian package checker
Reply to: