diff options
-rw-r--r--[-rwxr-xr-x] | Makefile.PL | 2 | ||||
-rw-r--r-- | lib/Youri/Repository/Mageia_upload.pm (renamed from lib/Youri/Repository/Mandriva_upload.pm) | 31 | ||||
-rw-r--r-- | lib/Youri/Repository/Mandriva_upload_pre.pm | 274 |
3 files changed, 18 insertions, 289 deletions
diff --git a/Makefile.PL b/Makefile.PL index 38343c8..3a01ce9 100755..100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -3,7 +3,7 @@ use ExtUtils::MakeMaker; WriteMakefile( NAME => 'youri-core', - VERSION => 0.9, + VERSION => 0.9.1, AUTHOR => 'Youri project <youri@zarb.org>', PREREQ_PM => { 'AppConfig' => 0, diff --git a/lib/Youri/Repository/Mandriva_upload.pm b/lib/Youri/Repository/Mageia_upload.pm index d34bb80..c2bad46 100644 --- a/lib/Youri/Repository/Mandriva_upload.pm +++ b/lib/Youri/Repository/Mageia_upload.pm @@ -1,13 +1,13 @@ # $Id: /local/youri/soft/trunk/lib/Youri/Upload/Action/RSS.pm 857 2006-01-29T10:15:43.298856Z guillaume $ -package Youri::Repository::Mandriva_upload; +package Youri::Repository::Mageia_upload; =head1 NAME -Youri::Repository::PLF - PLF repository implementation +Youri::Repository::Mageia_upload - Mageia repository implementation, on upload phase =head1 DESCRIPTION -This module implements PLF repository. +This module implements Mageia repository, for the upload phase =cut @@ -19,6 +19,7 @@ use File::Find 'find'; use base qw/Youri::Repository/; use MDV::Distribconf::Build; use SVN::Client; +use Sys::Hostname; use constant { PACKAGE_CLASS => 'Youri::Package::URPM', @@ -70,8 +71,7 @@ sub get_group_id { my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time); $year+=1900; $mon++; - my $hostname = `hostname`; - my ($host) = $hostname =~ /([^.]*)/; + my ($host) = hostname =~ /([^.]*)/; sprintf "$year%02d%02d%02d%02d%02d.$user.$host.${$}_", $mon, $mday, $hour, $min, $sec; } @@ -320,13 +320,14 @@ sub _get_section { $section = $self->{packages}{$file}{section}; print "Section undefined, repository says it is '$section' for '$file'\n" if $self->{_verbose}; } - if ($section && $section !~ /debug_/ && $package->is_debug()) { - $section = "debug_$section" + # FIXME: use debug_for info + if ($section && $section !~ m|debug/| && $package->is_debug()) { + $section = "debug/$section" } # if have section already, check if it exists, and may return immediately if ($section) { - print "Using requested section $section\n"; + print "Using requested section $section\n" if $self->{_verbose}; if ($media->{$arch}{$section}) { return $section } else { @@ -374,7 +375,7 @@ sub _get_section { # first try to find section for the specific version, as it is possibly already there; # this is the case for when called in Youri::Submit::Action::Archive, to find the # section the package got installed - print "Looking for package $name with version $version-$release\n"; + print "Looking for package $name with version $version-$release\n" if $self->{_verbose}; foreach my $m (keys %{$media->{$arch}}) { print " .. section '$m' path '".$media->{$arch}{$m}."'\n" if $self->{_verbose}; # - prefer source for non-debug packages, use binary if there is no source media configured @@ -423,13 +424,13 @@ sub _get_section { # FIXME: doing this here is wrong; this way the caller can never know if # a section was actually found or not; should return undef and let the # caller set a default (Note: IIRC PLF|Zarb has this right, see there) -spuk - print STDERR "Warning: Can't guess destination: section missing, defaulting to contrib/release\n" unless $section; - $section ||= 'contrib/release'; + print STDERR "Warning: Can't guess destination: section missing, defaulting to core/release\n" unless $section; + $section ||= 'core/release'; # next time we don't need to search everything again $self->{packages}{$file}{section} = $section; - print "Section is '$section'.\n"; + print "Section is '$section'.\n" if $self->{_verbose}; return $section; } @@ -453,7 +454,7 @@ sub get_upload_newer_revisions { s/^\@\d+://; return if ! /^$pattern/; return if /\.info$/; - print "Find $_\n"; + print "Find $_\n" if $self->{_verbose} > 1; push @packages, $File::Find::name if $package->check_ranges_compatibility("== $name", "< $_") }, $path); } @@ -472,7 +473,7 @@ sub package_in_svn { my $svn_entry = $ctx->ls("$self->{_svn}/$srpm_name", 'HEAD', 0); if ($svn_entry) { - print "Package $srpm_name is in the SVN\n"; + print "Package $srpm_name is in the SVN\n" if $self->{_verbose}; return 1 } } @@ -538,6 +539,8 @@ sub get_archive_dir { =head1 COPYRIGHT AND LICENSE Copyright (C) 2002-2006, YOURI project +Copyright (C) 2006,2007,2009 Mandriva +Copyright (C) 2011 Nicolas Vigier, Michael Scherer This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/lib/Youri/Repository/Mandriva_upload_pre.pm b/lib/Youri/Repository/Mandriva_upload_pre.pm deleted file mode 100644 index 32efed0..0000000 --- a/lib/Youri/Repository/Mandriva_upload_pre.pm +++ /dev/null @@ -1,274 +0,0 @@ -# $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; |