r36190 - in /trunk/dh-make-perl: TODO debian/control lib/Debian/Dependency.pm t/Dep.t
dmn at users.alioth.debian.org
dmn at users.alioth.debian.org
Sat May 23 05:59:59 UTC 2009
Author: dmn
Date: Sat May 23 05:59:51 2009
New Revision: 36190
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=36190
Log:
Dependency: add support for alternative dependencies (foo | bar)
Modified:
trunk/dh-make-perl/TODO
trunk/dh-make-perl/debian/control
trunk/dh-make-perl/lib/Debian/Dependency.pm
trunk/dh-make-perl/t/Dep.t
Modified: trunk/dh-make-perl/TODO
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/dh-make-perl/TODO?rev=36190&op=diff
==============================================================================
--- trunk/dh-make-perl/TODO (original)
+++ trunk/dh-make-perl/TODO Sat May 23 05:59:51 2009
@@ -1,5 +1,3 @@
-* Dependency: add support vor alternatiives: foo (>= 1.2) | bar
-
* --refresh failures:
02:12 gregoa dam: --refresh again: in libnet-imap-client-perl suddenly some
build dependencies, which were already in B-D-I, were added to
Modified: trunk/dh-make-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/dh-make-perl/debian/control?rev=36190&op=diff
==============================================================================
--- trunk/dh-make-perl/debian/control (original)
+++ trunk/dh-make-perl/debian/control Sat May 23 05:59:51 2009
@@ -9,6 +9,7 @@
libemail-date-format-perl,
libfile-find-rule-perl,
libfile-touch-perl,
+ liblist-moreutils-perl,
libmodule-corelist-perl,
libmodule-depends-perl,
libparse-debcontrol-perl,
@@ -39,6 +40,7 @@
libapt-pkg-perl,
libclass-accessor-perl,
libemail-date-format-perl,
+ liblist-moreutils-perl,
libmodule-corelist-perl,
libmodule-depends-perl,
libparse-debcontrol-perl,
Modified: trunk/dh-make-perl/lib/Debian/Dependency.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/dh-make-perl/lib/Debian/Dependency.pm?rev=36190&op=diff
==============================================================================
--- trunk/dh-make-perl/lib/Debian/Dependency.pm (original)
+++ trunk/dh-make-perl/lib/Debian/Dependency.pm Sat May 23 05:59:51 2009
@@ -5,6 +5,7 @@
use AptPkg::Config;
use Carp;
+use List::MoreUtils qw(mesh);
=head1 NAME
@@ -37,7 +38,7 @@
=cut
use base qw(Class::Accessor);
-__PACKAGE__->mk_accessors(qw( pkg ver rel ));
+__PACKAGE__->mk_accessors(qw( pkg ver rel alternatives ));
use Carp;
@@ -51,16 +52,31 @@
=item new()
+Construnct a new instance.
+
=item new( { pkg => 'package', rel => '>=', ver => '1.9' } )
-Construct new instance. If a reference is passed as an argument, it must be a
-hashref and is passed to L<Class::Accessor>.
+If a hash reference is passed as an argument, its contents are used to
+initialize the object.
+
+=item new( [ { pkg => 'foo' }, 'bar (<= 3)' ] );
+
+In an array reference is passed as an argument, its elements are used for
+constructing a dependency with alternatives.
+
+=item new('foo (= 42)')
+
+=item new('foo (= 42) | bar')
If a single argument is given, the construction is passed to the C<parse>
constructor.
+=item new( 'foo', '1.4' )
+
Two arguments are interpreted as package name and version. The relation is
assumed to be '>='.
+
+=item new( 'foo', '=', '42' )
Three arguments are interpreted as package name, relation and version.
@@ -73,7 +89,7 @@
my $self = $class->SUPER::new();
my( $pkg, $rel, $ver );
- if( ref($_[0]) ) {
+ if( ref($_[0]) and ref($_[0]) eq 'HASH' ) {
$pkg = delete $_[0]->{pkg};
$rel = delete $_[0]->{rel};
$ver = delete $_[0]->{ver};
@@ -82,6 +98,18 @@
$self->$k($v);
}
}
+ elsif( ref($_[0]) and ref($_[0]) eq 'ARRAY' ) {
+ $self->alternatives(
+ [ map { $self->new($_) } @{ $_[0] } ],
+ );
+
+ for( @{ $self->alternatives } ) {
+ croak "Alternatives can't be nested"
+ if $_->alternatives;
+ }
+
+ return $self;
+ }
elsif( @_ == 1 ) {
return $class->parse($_[0]);
}
@@ -106,7 +134,7 @@
$self->rel($rel) if $rel;
- croak "pkg is mandatory" unless $pkg;
+ croak "pkg is mandatory" unless $pkg or $self->alternatives;
$self->pkg($pkg);
@@ -115,6 +143,10 @@
sub _stringify {
my $self = shift;
+
+ if( $self->alternatives ) {
+ return join( ' | ', @{ $self->alternatives } );
+ }
return (
$self->ver
@@ -144,6 +176,40 @@
sub _compare {
my( $left, $right ) = @_;
+ if( $left->alternatives ) {
+ if( $right->alternatives ) {
+ my @pairs = mesh(
+ @{ $left->alternatives }, @{ $right->alternatives },
+ );
+
+ while(@pairs) {
+ my( $l, $r ) = splice @pairs, 0, 2;
+
+ return -1 unless $l;
+ return 1 unless $r;
+ my $res = _compare( $l, $r );
+ return $res if $res;
+ }
+
+ return 0;
+ }
+ else {
+ my $res = _compare( $left->alternatives->[0], $right );
+ return $res if $res;
+ return 1;
+ }
+ }
+ else {
+ if( $right->alternatives ) {
+ my $res = _compare( $left, $right->alternatives->[0] );
+ return $res if $res;
+ return -1;
+ }
+ else {
+ # nothing, the code below compares two plain dependencies
+ }
+ }
+
my $res = $left->pkg cmp $right->pkg;
return $res if $res != 0;
@@ -201,6 +267,15 @@
sub parse {
my ( $class, $str ) = @_;
+
+ if( $str =~ /\|/ ) {
+ # alternative dependencies
+ return $class->new( {
+ alternatives => [
+ map { $class->new($_) } split( /\s*\|\s*/, $str )
+ ],
+ } );
+ }
if ($str =~ m{
^ # start from the beginning
@@ -293,6 +368,25 @@
$dep = Debian::Dependency->new($dep)
unless ref($dep);
+ # we have alternatives? then we satisfy the dependency only if
+ # all of the alternatives satisfy it
+ if( $self->alternatives ) {
+ for( @{ $self->alternatives } ) {
+ return 0 unless $_->satisfies($dep);
+ }
+
+ return 1;
+ }
+
+ # $dep has alternatives? then we satisfy it if we satisfy any of them
+ if( $dep->alternatives ) {
+ for( @{ $dep->alternatives } ) {
+ return 1 if $self->satisfies($_);
+ }
+
+ return 0;
+ }
+
# different package?
return 0 unless $self->pkg eq $dep->pkg;
Modified: trunk/dh-make-perl/t/Dep.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/dh-make-perl/t/Dep.t?rev=36190&op=diff
==============================================================================
--- trunk/dh-make-perl/t/Dep.t (original)
+++ trunk/dh-make-perl/t/Dep.t Sat May 23 05:59:51 2009
@@ -3,7 +3,7 @@
use strict;
use warnings;
-use Test::More tests => 145;
+use Test::More tests => 163;
BEGIN {
use_ok('Debian::Dependency');
@@ -46,6 +46,14 @@
$d = Debian::Dependency->new('libfoo (>= 0.000)');
is( "$d", 'libfoo', 'zero version is ignored when parsing' );
+$d = new_ok( 'Debian::Dependency', [ [ 'foo', 'bar' ] ] );
+isa_ok( $d->alternatives, 'ARRAY' );
+is( $d->alternatives->[0] . "", 'foo', "first alternative is foo" );
+is( $d->alternatives->[1] . "", 'bar', "second alternative is bar" );
+$d = new_ok( 'Debian::Dependency', [ 'foo | bar' ] );
+isa_ok( $d->alternatives, 'ARRAY' );
+is( "$d", "foo | bar", "alternative dependency stringifies" );
+
sub sat( $ $ $ ) {
my( $dep, $test, $expected ) = @_;
@@ -170,6 +178,15 @@
sat( $dep, 'foo (= 5)', 0 );
sat( $dep, 'foo (<= 5)', 1 );
sat( $dep, 'foo (<< 5)', 1 );
+
+$dep = Debian::Dependency->new('foo (<< 4) | bar ');
+sat( $dep, 'foo', 0 );
+sat( $dep, 'bar', 0 );
+
+$dep = Debian::Dependency->new('foo (<< 4)');
+sat( $dep, 'foo | bar', 1 );
+sat( $dep, 'foo (<= 5) | zoo', 1 );
+sat( $dep, 'zoo', 0 );
sub comp {
my( $one, $two, $expected ) = @_;
@@ -225,3 +242,10 @@
comp( 'foo (>> 2)', 'foo (= 2)', 1 );
comp( 'foo (>> 2)', 'foo (>= 2)', 1 );
comp( 'foo (>> 2)', 'foo (>> 2)', 0 );
+
+comp( 'foo|bar', 'bar|foo', 1 );
+comp( 'bar|foo', 'foo|bar', -1 );
+comp( 'bar|foo', 'bar|baz', 1 );
+comp( 'foo|bar', 'foo|bar', 0 );
+comp( 'foo|bar', 'foo', 1 );
+comp( 'foo', 'foo|bar', -1 );
More information about the Pkg-perl-cvs-commits
mailing list