Debian::Dependency - dependency relationship between Debian packages

DhMakePerl documentation Contained in the DhMakePerl distribution.

Index

Code Index:

NAME

Top

Debian::Dependency - dependency relationship between Debian packages

SYNOPSIS

Top

                                    # simple dependency
   my $d = Debian::Dependency->new( 'perl' );
                                    # also parses a single argument
   my $d = Debian::Dependency->new('perl (>= 5.10)');
                                    # dependency with a version
   my $d = Debian::Dependency->new( 'perl', '5.10' );
                                    # dependency with version and relation
   my $d = Debian::Dependency->new( 'perl', '>=', '5.10' );

   print $d->pkg;  # 'perl'
   print $d->ver;  # '5.10'

                                    # for people who like to type much
   my $d = Debian::Dependency->new( { pkg => 'perl', ver => '5.10' } );

   # stringification
   print "$d"      # 'perl (>= 5.10)'

   # 'adding'
   $deps = $dep1 + $dep2;
   $deps = $dep1 + 'foo (>= 1.23)'

CLASS_METHODS

new()

Construnct a new instance.

new( { pkg => 'package', rel => '>=', ver => '1.9' } )

If a hash reference is passed as an argument, its contents are used to initialize the object.

new( [ { pkg => 'foo' }, 'bar (<= 3)' ] );

In an array reference is passed as an argument, its elements are used for constructing a dependency with alternatives.

new('foo (= 42)')
new('foo (= 42) | bar')

If a single argument is given, the construction is passed to the parse constructor.

new( 'foo', '1.4' )

Two arguments are interpreted as package name and version. The relation is assumed to be '>='.

new( 'foo', '=', '42' )

Three arguments are interpreted as package name, relation and version.

set

Overrides the set method from Class::Accessor. Used to convert zero versions (for example 0 or 0.000) to void versions.

parse()

Takes a single string argument and parses it.

Examples:

perl
perl (>= 5.8)
libversion-perl (<< 3.4)

FIELDS

pkg

Contains the name of the package that is depended upon

rel

Contains the relation of the dependency. May be any of '<<', '<=', '=', '>=' or '>>'. Default is '>='.

ver

Contains the version of the package the dependency is about. The value is an instance of Dpkg::Version class. If you set it to a scalar value, that is given to Dpkg::Version->new().

rel and ver are either both present or both missing.

Examples

    print $dep->pkg;
    $dep->ver('3.4');

METHODS

Top

satisfies($dep)

Returns true if $dep states a dependency that is already covered by this instance. In other words, if this method returns true, any package satisfying the dependency of this instance will also satisfy $dep ($dep is redundant in dependency lists where this instance is already present).

$dep can be either an instance of the Debian::Dependency class, or a plain string.

    my $dep  = Debian::Dependency->new('foo (>= 2)');
    print $dep->satisfies('foo') ? 'yes' : 'no';             # no
    print $dep->satisfies('bar') ? 'yes' : 'no';             # no
    print $dep->satisfies('foo (>= 2.1)') ? 'yes' : 'no';    # yes

SEE ALSO

Top

Debian::Dependencies

AUTHOR

Top

Damyan Ivanov <dmn@debian.org>

COPYRIGHT & LICENSE

Top

This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License version 2 as published by the Free Software Foundation.

This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.

You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

DhMakePerl documentation Contained in the DhMakePerl distribution. 
package Debian::Dependency;

use strict;
use warnings;

use AptPkg::Config;
use Carp;
use Dpkg::Version ();
use List::MoreUtils qw(mesh);


use base qw(Class::Accessor);
__PACKAGE__->mk_accessors(qw( pkg ver rel alternatives ));

use Carp;

use overload '""' => \&_stringify,
             '+'  => \&_add,
             '<=>'  => \&_compare;


sub new {
    my $class = shift;
    $class = ref($class) if ref($class);

    my $self = $class->SUPER::new();
    my( $pkg, $rel, $ver );

    if( ref($_[0]) and ref($_[0]) eq 'HASH' ) {
        $pkg = delete $_[0]->{pkg};
        $rel = delete $_[0]->{rel};
        $ver = delete $_[0]->{ver};
        # pass-through the rest
        while( my($k,$v) = each %{$_[0]} ) {
            $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]);
    }
    elsif( @_ == 2 ) {
        $pkg = shift;
        $rel = '>=';
        $ver = shift;
    }
    elsif( @_ == 3 ) {
        ( $pkg, $rel, $ver ) = @_;
    }
    else {
        die "Unsupported number of arguments";
    }

    $self->ver($ver);

    unless( defined( $self->ver ) ) {
        undef($rel);
        delete $self->{ver};
    };

    if ($rel) {
        $rel = '<=' if $rel eq '<';
        $rel = '>=' if $rel eq '>';
        $self->rel($rel);
    }

    croak "pkg is mandatory" unless $pkg or $self->alternatives;

    $self->pkg($pkg);

    return $self;
}

sub _stringify {
    my $self = shift;

    if( $self->alternatives ) {
        return join( ' | ', @{ $self->alternatives } );
    }

    return (
          $self->ver
        ? $self->pkg . ' (' . $self->rel . ' ' . $self->ver . ')'
        : $self->pkg
    );
}

sub _add {
    my $left = shift;
    my $right = shift;
    my $mode = shift;

    confess "cannot += Dependency. put Dependencies instance on the left instead" unless defined($mode);

    return bless( [ $left ], 'Debian::Dependencies' ) + $right;
}

our %rel_order = (
    '<<'    => -2,
    '<='    => -1,
    '='     => 0,
    '>='    => +1,
    '>>'    => +2,
);

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;

    return -1 if not defined( $left->ver ) and defined( $right->ver );
    return +1 if defined( $left->ver ) and not defined( $right->ver );

    return 0 unless $left->ver; # both have no version

    $res = $left->ver <=> $right->ver;

    return $res if $res != 0;

    # same versions, compare relations
    return $rel_order{ $left->rel } <=> $rel_order{ $right->rel };
}


sub set {
    my( $self, $field, $value ) = @_;

    undef($value)
    if $field eq 'ver'
        and defined($value)
        and $value =~ /^0[0.]*$/;

    $value = Dpkg::Version->new( $value, check => 1 )
        if $field eq 'ver' and defined($value);

    $self->SUPER::set( $field, $value );
}


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
                        \s*             # stray space
                        ([^\(\s]+)      # package name - no paren, no space
                        \s*             # optional space
                        (?:             # version is optional
                                \(          # opening paren
                                        (       # various relations 
                                                <<
                                            | <=
                                            | =
                                            | >=
                                            | >>
                                            | <
                                            | >
                                        )
                                        \s*     # optional space
                                        (.+)    # version
                                \)          # closing paren
                        )?
                        \s*             # optional space
                        (?:             # architecture is optional
                                \[
                                        (?:
                                                !?             # negation is optional
                                                [^\s\]]+       # architecture name
                                                (?:\s+|(?=\])) # whitespace or end
                                        )+
                                \]
                        )?
                        $}x    # done
        )
    {
        return $class->new(
            {   pkg => $1,
                (     ( defined($2) and defined($3) )
                    ? ( rel => $2, ver => $3 )
                    : ()
                )
            }
        );
    }
    else {
        die "Unable to parse '$str'";
    }
}

1;


sub satisfies {
    my( $self, $dep ) = @_;

    $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;

    # $dep has no relation?
    return 1 unless $dep->rel;

    # $dep has relation, but we don't?
    return 0 if not $self->rel;

    # from this point below both $dep and we have relation (and version)
    my $cmpver = ( $self->ver <=> $dep->ver );

    if( $self->rel eq '>>' ) {
        # >> 4 satisfies also >> 3
        return 1 if $dep->rel eq '>>'
            and $cmpver >= 0;

        # >> 4 satisfies >= 3 and >= 4
        return 1 if $dep->rel eq '>='
            and $cmpver >= 0;

        # >> 4 can't satisfy =, <= and << relations
        return 0;
    }
    elsif( $self->rel eq '>=' ) {
        # >= 4 satisfies >= 3
        return 1 if $dep->rel eq '>='
            and $cmpver >= 0;

        # >= 4 satisvies >> 3, but not >> 4
        return 1 if $dep->rel eq '>>'
            and $cmpver > 0;

        # >= 4 can't satosfy =, <= and << relations
    }
    elsif( $self->rel eq '=' ) {
        return 1 if $dep->rel eq '='
            and $cmpver == 0;

        # = 4 also satisfies >= 3 and >= 4
        return 1 if $dep->rel eq '>='
            and $cmpver >= 0;

        # = 4 satisfies >> 3, but not >> 4
        return 1 if $dep->rel eq '>>'
            and $cmpver > 0;

        # = 4 satisfies <= 4 and <= 5
        return 1 if $dep->rel eq '<='
            and $cmpver <= 0;

        # = 4 satisfies << 5, but not << 4
        return 1 if $dep->rel eq '<<'
            and $cmpver < 0;

        # other cases mean 'no'
        return 0;
    }
    elsif( $self->rel eq '<=' ) {
        # <= 4 satisfies <= 5
        return 1 if $dep->rel eq '<='
            and $cmpver <= 0;

        # <= 4 satisfies << 5, but not << 4
        return 1 if $dep->rel eq '<<'
            and $cmpver < 0;

        # <= 4 can't satisfy =, >= and >>
        return 0;
    }
    elsif( $self->rel eq '<<' ) {
        # << 4 satisfies << 5
        return 1 if $dep->rel eq '<<'
            and $cmpver <= 0;

        # << 4 satisfies <= 5 and <= 4
        return 1 if $dep->rel eq '<='
            and $cmpver <= 0;

        # << 4 can't satisfy =, >= and >>
        return 0;
    }
    else {
        croak "Should not happen: $self satisfies $dep?";
    }
}