Youri::Repository - Abstract repository

# $Id: /mirror/youri/soft/Repository/trunk/lib/Youri/Repository.pm 2230 2007-03-05T21:32:43.256766Z guillomovitch  $
package Youri::Repository;

use warnings;
use strict;
use Carp;
use File::Basename;
use Youri::Package;
use version; our $VERSION = qv('0.1.0');

sub new {
    my $class = shift;
    croak "Abstract class" if $class eq __PACKAGE__;

    my %options = (
        install_root  => '', # path to top-level directory
        archive_root  => '', # path to top-level directory
        version_root  => '', # path to top-level directory
        test          => 0,  # test mode
        verbose       => 0,  # verbose mode
        @_
    );


    croak "no install root" unless $options{install_root};
    croak "invalid install root" unless -d $options{install_root};

    my $self = bless {
        _install_root  => $options{install_root},
        _archive_root  => $options{archive_root},
        _version_root  => $options{version_root},
        _test          => $options{test},
        _verbose       => $options{verbose},
    }, $class;

    $self->_init(%options);

    return $self;
}

sub _init {
    # do nothing
}

sub get_package_class {
    my ($self) = @_;
    croak "Not a class method" unless ref $self;
    return $self->{_package_class};
}

sub get_package_charset {
    my ($self) = @_;
    croak "Not a class method" unless ref $self;
    return $self->{_package_charset};
}

sub get_extra_arches {
    my ($self) = @_;
    croak "Not a class method" unless ref $self;
    return @{$self->{_extra_arches}};
}

sub get_older_revisions {
    my ($self, $package, $target, $user_context, $app_context) = @_;
    croak "Not a class method" unless ref $self;
    print "Looking for package $package older revisions for $target\n"
        if $self->{_verbose} > 0;

    return $self->get_revisions(
        $package,
        $target,
        $user_context,
        $app_context,
        sub { return $package->compare($_[0]) > 0 }
    );
}

sub get_last_older_revision {
    my ($self, $package, $target, $user_context, $app_context) = @_;
    croak "Not a class method" unless ref $self;
    print "Looking for package $package last older revision for $target\n"
        if $self->{_verbose} > 0;

    return (
        $self->get_older_revisions(
            $package,
            $target,
            $user_context,
            $app_context
        )
    )[0];
}

sub get_newer_revisions {
    my ($self, $package, $target, $user_context, $app_context) = @_;
    croak "Not a class method" unless ref $self;
    print "Looking for package $package newer revisions for $target\n"
        if $self->{_verbose} > 0;

    return $self->get_revisions(
        $package,
        $target,
        $user_context,
        $app_context,
        sub { return $_[0]->compare($package) > 0 }
    );
}

sub get_revisions {
    my ($self, $package, $target, $user_context, $app_context, $filter) = @_;
    croak "Not a class method" unless ref $self;
    print "Looking for package $package revisions for $target\n"
        if $self->{_verbose} > 0;

    my @packages = 
        map { $self->get_package_class()->new(file => $_) }
        $self->get_files(
            $self->{_install_root},
            $self->get_install_path(
                $package,
                $target,
                $user_context,
                $app_context
            ),
            $self->get_package_class()->get_pattern(
                $package->get_name(),
                undef,
                undef,
                $package->get_arch(),
            )
        );

    @packages = grep { $filter->($_) } @packages if $filter;

    return
        sort { $b->compare($a) } # sort by revision order
        @packages;
}

sub get_obsoleted_packages {
    my ($self, $package, $target, $user_context, $app_context) = @_;
    croak "Not a class method" unless ref $self;
    print "Looking for packages obsoleted by $package for $target\n"
        if $self->{_verbose} > 0;

    my @packages;
    foreach my $obsolete ($package->get_obsoletes()) {
        my $pattern = $self->get_package_class()->get_pattern(
            $obsolete->get_name()
        );
        my $range = $obsolete->get_range();
        push(@packages,
            grep { $range ? $_->satisfy_range($range) : 1 } 
            map { $self->get_package_class()->new(file => $_) }
            $self->get_files(
                $self->{_install_root},
                $self->get_install_path(
                    $package, $target,
                    $user_context,
                    $app_context
                ),
                $pattern
            )
        );
    }

    return @packages;
}

sub get_replaced_packages {
    my ($self, $package, $target, $user_context, $app_context) = @_;
    croak "Not a class method" unless ref $self;
    print "Looking for packages replaced by $package for $target\n"
        if $self->{_verbose} > 0;

    my @list;

    # collect all older revisions
    push(@list, $self->get_older_revisions(
        $package,
        $target,
        $user_context,
        $app_context
    ));

    # noarch packages are potentially linked from other directories
    if ($package->get_arch() eq 'noarch') {
        foreach my $arch ($self->get_extra_arches()) {
            push(@list, $self->get_older_revisions(
                $package,
                $target,
                $user_context,
                { arch => $arch }
            ));
        }
    }

    # collect all obsoleted packages
    push(@list, $self->get_obsoleted_packages(
        $package,
        $target,
        $user_context,
        $app_context
    ));

    return @list;
}

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

    my @files;
    my $dir = "$root/$path";
    $pattern = '.*' unless defined $pattern;
    my $comp_pattern = qr/^$pattern$/;

    print "Looking for files matching $pattern in $root/$path\n"
        if $self->{_verbose} > 1;

    opendir(my $dh, $dir) or die "Can't open $dir: $!";
    while (my $file = readdir($dh)) {
        next unless $file =~ $comp_pattern;
        $file = "$dir/$file";
        next unless -f $file;
        push(@files, $file);
    }
    closedir($dh);

    return @files;
}

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

    return $self->{_install_root};
}

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

    return $self->_get_dir(
        $self->{_install_root},
        $self->get_install_path($package, $target, $user_context, $app_context)
    );
}

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

    return $self->{_archive_root};
}

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

    return $self->_get_dir(
        $self->{_archive_root},
        $self->get_archive_path($package, $target, $user_context, $app_context)
    );
}

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

    return $self->{_version_root};
}

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

    return $self->_get_dir(
        $self->{_version_root},
        $self->get_version_path($package, $target, $user_context, $app_context)
    );
}

sub _get_dir {
    my ($self, $root, $path) = @_;

    return substr($path, 0, 1) eq '/' ?
        $path :
        $root . '/' . $path;
}

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

    return 
        $self->get_install_dir($package, $target, $user_context, $app_context) .
        '/' .
        $package->get_file_name();
}

1;