Youri::Package::RPM::Test - Fake rpm package implementation

Youri-Package documentation Contained in the Youri-Package distribution.

Index

Code Index:

NAME

Top

Youri::Package::RPM::Test - Fake rpm package implementation

DESCRIPTION

Top

This is a fake Youri::Package implementation for rpm, intended for testing purposes.

CLASS METHODS

Top

new(%args)

Creates and returns a new Youri::Package::RPM::Test object.

Specific parameters:

file $file

Path of file to use for creating this package.

tags $tags

Hahref of tag values

requires $requires

Arraryef of package relationships.

provides $provides

Arraryef of package relationships.

obsoletes $obsoletes

Arraryef of package relationships.

conflicts $conflicts

Arraryef of package relationships.

files $files

Arraryef of package files.

changes $changes

Arraryef of package changes.

Youri-Package documentation Contained in the Youri-Package distribution. 
# $Id: Test.pm 2276 2011-01-22 10:21:48Z guillomovitch $
package Youri::Package::RPM::Test;


use strict;
use warnings;
use File::Basename;
use Carp;
use URPM;
use base 'Youri::Package::RPM';
use feature qw(switch);
use overload
    '""'     => 'as_string',
    '0+'     => '_to_number',
    fallback => 1;

our $AUTOLOAD;

my @tags = qw/
    name
    version
    release
    filename
    arch
    url
    summary
    description
    packager
    buildtime
    sourcerpm
    gpg_key
/;

my %tags = map { $_ => 1 } @tags;

sub check_ranges_compatibility {
    my ($class, $range1, $range2) = @_;

    return URPM::ranges_overlap($range1, $range2);
}


sub _init {
    my ($self, %options) = @_;

    if (exists $options{tags}) {
        $self->{_tags}->{$_} = $options{tags}->{$_}
            foreach keys %{$options{tags}};
    }

    if (exists $options{file}) {
        croak "undefined file"
            unless $options{file};
        croak "non-existing file $options{file}"
            unless -f $options{file};
        croak "non-readable file $options{file}"
            unless -r $options{file};
        my $filename = basename($options{file});
        given ($filename) {
            when (/^([\w-]+)-([^-]+)-([^-]+)\.(\w+)\.rpm$/) {
                # rpm4 style package, with combined dist suffix and release
                $self->{_tags}->{name} = $1;
                $self->{_tags}->{version} = $2;
                $self->{_tags}->{release} = $3;
                $self->{_tags}->{arch} = $4;
                $self->{_file} = $options{file};
            }
            when (/^([\w-]+)-([^-]+)-([^-]+)-([^-]+)\.(\w+)\.rpm$/) {
                # rpm5 style package, with distinct dist suffix and release
                $self->{_tags}->{name} = $1;
                $self->{_tags}->{version} = $2;
                $self->{_tags}->{release} = $3;
                $self->{_tags}->{arch} = $5;
                $self->{_file} = $options{file};
            }
            default {
                croak "non-compliant filename $filename";
            }
        }
    }

    $self->{_requires}  = $options{requires};
    $self->{_provides}  = $options{provides};
    $self->{_obsoletes} = $options{obsoletes};
    $self->{_conflicts} = $options{conflicts};
    $self->{_files}     = $options{files};
    $self->{_changes}   = $options{changes};

    # default values
    $self->{_tags}->{name}    ||= 'test';
    $self->{_tags}->{arch}    ||= 'noarch';
    $self->{_tags}->{version} ||= 1;
    $self->{_tags}->{release} ||= 1;
    $self->{_tags}->{filename} = sprintf(
        '%s-%s-%s.%s.rpm',
        $self->{_tags}->{name},
        $self->{_tags}->{version},
        $self->{_tags}->{release},
        $self->{_tags}->{arch}
    );
}

sub get_revision {
    my ($self) = @_;
    croak "Not a class method" unless ref $self;

    my $revision = 
        ($self->{_tags}->{version} || '') . 
        '-' .
        ($self->{_tags}->{release} || '');

    return $self->{_tags}->{epoch} ?
        ($self->{_tags}->{epoch} || '') . ':' . $revision : $revision;
}

sub get_tag {
    my ($self, $tag) = @_;
    croak "Not a class method" unless ref $self;
    croak "invalid tag $tag" unless $tags{$tag};
    return $self->{_tags}->{$tag};
}

sub is_source {
    my ($self) = @_;
    croak "Not a class method" unless ref $self;

    return $self->{_tags}->{arch} eq 'src';
}

sub is_binary {
    my ($self) = @_;
    croak "Not a class method" unless ref $self;

    return $self->{_tags}->{arch} ne 'src';
}

sub get_type {
    my ($self) = @_;
    croak "Not a class method" unless ref $self;

    return
        $self->{_tags}->{arch} eq 'src' ?
        "source" :
        "binary";
}

sub get_canonical_name {
    my ($self) = @_;
    croak "Not a class method" unless ref $self;

    # return name if arch is not defined
    return $self->{_tags}->{name}
        if ! $self->{_tags}->{arch};

    # otherwise return name if arch is source
    return $self->{_tags}->{name}
        if $self->{_tags}->{arch} eq 'src';

    # otherwise return name if sourcerpm is not defined
    return $self->{_tags}->{name}
       if ! $self->{_tags}->{sourcerpm};

    # otherwise source package name
    $self->{_tags}->{sourcerpm} =~ /^(\S+)-[^-]+-[^-]+\.src\.rpm$/;
    return $1;
}

sub get_file_name {
    my ($self) = @_;
    croak "Not a class method" unless ref $self;

    return 
        $self->as_string() . '.rpm';
}

sub as_string {
    my ($self) = @_;
    croak "Not a class method" unless ref $self;

    return 
        ($self->{_tags}->{name} || '') .
        '-' .
        ($self->{_tags}->{version} || '') . 
        '-' .
        ($self->{_tags}->{release} || '') .
        '.' .
        ($self->{_tags}->{arch} || '');
}

sub as_formated_string {
    my ($self, $format) = @_;
    croak "Not a class method" unless ref $self;

    $format =~ s/%{([^}]+)}/$self->{_tags}->{$1}/eg;
    return $format;
}

sub _to_number {
    return refaddr($_[0]);
}

sub get_requires {
    my ($self, $format) = @_;
    croak "Not a class method" unless ref $self;

    return $self->{_requires} ? @{$self->{_requires}} : ();
}

sub get_provides {
    my ($self, $format) = @_;
    croak "Not a class method" unless ref $self;

    return $self->{_provides} ? @{$self->{_provides}} : ();
}

sub get_obsoletes {
    my ($self, $format) = @_;
    croak "Not a class method" unless ref $self;

    return $self->{_obsoletes} ? @{$self->{_obsoletes}} : ();
}

sub get_conflicts {
    my ($self) = @_;
    croak "Not a class method" unless ref $self;

    return $self->{_conflicts} ? @{$self->{_conflicts}} : ();
}

sub get_files {
    my ($self) = @_;
    croak "Not a class method" unless ref $self;

    return $self->{_files} ? @{$self->{_files}} : ();
}

sub get_changes {
    my ($self) = @_;
    croak "Not a class method" unless ref $self;

    return $self->{_changes} ?
        map {
            Youri::Package::Change->new($_->[0], $_->[1], $_->[2])
        } @{$self->{_changes}} :
        ();
}

sub get_last_change {
    my ($self) = @_;
    croak "Not a class method" unless ref $self;

    return $self->{_changes} ?
        Youri::Package::Change->new(
            $self->{_changes}->[0]->[0],
            $self->{_changes}->[0]->[1],
            $self->{_changes}->[0]->[2]
        ) :
        undef;
}

sub compare {
    my ($self, $package) = @_;
    croak "Not a class method" unless ref $self;

    return URPM::rpmvercmp($self->get_revision(), $package->get_revision());
}

sub satisfy_range {
    my ($self, $range) = @_;
    croak "Not a class method" unless ref $self;

    return $self->check_ranges_compatibility(
        '== ' . $self->get_revision(),
        $range
    );
}

sub AUTOLOAD {
    my ($self) = @_;
    croak "Not a class method" unless ref $self;

    my $method = $AUTOLOAD;
    $method =~ s/.*:://;
    return if $method eq 'DESTROY';
    croak "invalid method" unless $method =~ /^get_(\w+)$/;

    my $tag = $1;
    return $self->get_tag($1);
}

1;