path: root/lib/Youri/Repository/Mandriva_upload_pre.pm

# $Id: /local/youri/soft/trunk/lib/Youri/Upload/Action/RSS.pm 857 2006-01-29T10:15:43.298856Z guillaume  $
package Youri::Repository::Mandriva_upload_pre;

=head1 NAME

Youri::Repository::PLF - PLF repository implementation

=head1 DESCRIPTION

This module implements PLF repository.

=cut

use warnings;
use strict;
use Carp;
use Memoize;
use File::Find 'find';
use base qw/Youri::Repository/;
use SVN::Client;
use constant {
    PACKAGE_CLASS   => 'Youri::Package::URPM',
    PACKAGE_CHARSET => 'utf8'
};

memoize('_get_section');

sub _init {
    my $self   = shift;
    my %options = (
        module => 'SPECS', # CVS module
        noarch => 'i586', # noarch packages policy
	svn    => '',
	upload_root => '',
        @_
    );

    $self->{_module} = $options{module};
    $self->{_noarch} = $options{noarch};
    $self->{_svn} = $options{svn};
    $self->{_upload_root} = $options{upload_root};

    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time);
    $year+=1900;
    my $hostname = `hostname`;
    my ($host) = $hostname =~ /([^.]*)/;
    $self->{group_dir} = sprintf "$ENV{SUDO_USER}.$host.$$.$year%02d%02d%02d%02d%02d", $mon, $mday, $hour, $min, $sec;
}

sub get_package_class {
    return PACKAGE_CLASS;
}

sub package_in_svn {
    my ($self, $srpm_name) = @_;
    my $ctx = new SVN::Client(
	auth => [SVN::Client::get_simple_provider(),
	SVN::Client::get_simple_prompt_provider(\&simple_prompt,2),
	SVN::Client::get_username_provider()]
    );

    my $svn_entry = $ctx->ls("$self->{_svn}/", 'HEAD', 0);
    foreach (keys %{$svn_entry}) {
	if ($srpm_name eq $_) {
	    print "Package $_ is in the SVN\n";
	    return 1
	}
    }
}

sub get_svn_url {
    my ($self) = @_;
    $self->{_svn}
}

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

    my $arch = $define->{arch} || $package->get_arch;
    if ($arch eq 'src') {
	$arch = 'SRPMS'
    } else {
	$arch .= '/media'
    }
    my @packages;
    foreach my $dir ('main', 'contrib') {
	print "Looking into $self->{_install_root}/$target/$arch/$dir/release\n";
	push @packages, 
	map { $self->get_package_class()->new(file => $_) }
	$self->get_files(
	    $self->{_install_root},
	    "$target/$arch/$dir/release" ,
	    $self->get_package_class()->get_pattern($package->get_name(),undef, undef, $arch)
	);
    }

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

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

sub get_package_charset {
    return PACKAGE_CHARSET;
}

sub get_upload_dir {
    my ($self, $package, $target, $define) = @_;
    croak "Not a class method" unless ref $self;
    my $arch = $package->get_arch();
    my $section = $self->_get_section($package, $target, $define);
    my $media_path = $section eq 'main' ? $target  : $target =~ /^cooker/ ? "contrib" : "$target/contrib";
    my $arch_path = $arch eq 'src' ? 'SRPMS' : 'RPMS';
    my $force = $target =~ /_force/ ? 'force' : '';
    $self->{_upload_root} .  "/$media_path/$force/$arch_path/"
}

sub get_arch {
    my ($self, $package, $target, $define) = @_;
    my $arch = $package->get_arch();
    if ($arch eq 'noarch') {
	$arch = $self->{_noarch} 
    }
    $arch
}

sub get_install_path {
    my ($self, $package, $target, $define) = @_;

    return $self->_get_path($package, $target, $define);
}

sub get_archive_path {
    my ($self, $package, $target, $define) = @_;

    return $self->_get_path($package, $target, $define);
}

sub _get_path {
    my ($self, $package, $target, $define) = @_;

    my $arch = $package->get_arch;
    if ($arch eq 'src') {
	$arch = 'SRPMS'
    } else {
	$arch .= '/media'
    }
    my $section = $self->_get_section($package, $target, $define);

    return "$target/$arch/$section/release/";
}


sub get_version_path {
    my ($self, $package, $target, $define) = @_;

    my $section = $self->_get_section($package, $target, $define);

    return "$self->{_module}/$section/release/";
}

=head2 get_replaced_packages($package, $target, $define)

Overrides parent method to add libified packages.

=cut

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

    my @replaced_packages = 
        $self->SUPER::get_replaced_packages($package, $target, $define);

    # mandriva lib policy:
    # library package names change with revision, making mandatory to
    # duplicate older revisions search with a custom pattern
    my $name = $package->get_name();
    if ($name =~ /^(lib\w+[a-zA-Z_])[\d_\.]+([-\w]*)$/) {
        push(@replaced_packages,
            grep { $package->compare($_) > 0 }
            map { PACKAGE_CLASS->new(file => $_) }
            $self->get_files(
                $self->{_install_root},
                $self->get_install_path($package, $target, $define),
                PACKAGE_CLASS->get_pattern(
                    $1 . '[\d_\.]+' . $2, # custom name pattern
                    undef,
                    undef,
                    $package->get_arch()
                ),
            )
        );
    }

    return @replaced_packages;
       
}

sub _get_section {
    my ($self, $package, $target, $define) = @_;

    my $section;

    # try to find section automatically
    my $arch = $package->get_arch();
    $arch = $self->{_noarch} if $arch eq 'noarch';

    my $source_pattern = PACKAGE_CLASS->get_pattern(
        $package->get_canonical_name(),
        undef,
        undef,
        'src'
    );

    my $binary_pattern = PACKAGE_CLASS->get_pattern(
        $package->get_name(),
        undef,
        undef,
        $arch
    );

    # for each potential section, try to match
    # a suitable source patten in source directory
    # a suitable binary patten in binary directory
    foreach my $dir (qw/main contrib/) {
        next unless
            $self->get_files(
                $self->{_install_root},
                "$target/SRPMS/$dir/release",
                $source_pattern
            ) || $self->get_files(
                $self->{_install_root},
                "$target/$arch/media/$dir/release",
                $binary_pattern
            );
	print "Section is $dir\n";
        $section = $dir;
        last;
    }

    # use defined section if not found
    $section = $define->{section} unless $section;

    $section || 'contrib'
}

sub get_upload_newer_revisions {
    my ($self, $package, $target, $define) = @_;
    croak "Not a class method" unless ref $self;
    my $arch = $package->get_arch();
    my $pattern = $self->get_package_class()->get_pattern($package->get_name(), undef, undef, $arch);
    print "Looking for package $package revisions for $target in $self->{_upload_root} (pattern $pattern)\n";
    my @packages;
    foreach my $dir ('cooker', 'contrib') {
	find(sub { return if ! /^$pattern/; print "Find $_\n"; push @packages, $File::Find::name if $package->compare($self->get_package_class()->new(file => $File::Find::name)) <= 0 }, "$self->{_upload_root}/$dir");
    }
    return
        @packages;
}

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2002-2006, YOURI project

This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

=cut

1;