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