added mandriva modules

2 files changed, 556 insertions, 0 deletions

diff --git a/lib/Youri/Repository/Mandriva_upload.pm b/lib/Youri/Repository/Mandriva_upload.pm
new file mode 100644
index 0000000..0b5ee58
--- /dev/null
+++ b/lib/Youri/Repository/Mandriva_upload.pm
@@ -0,0 +1,297 @@
+# $Id: /local/youri/soft/trunk/lib/Youri/Upload/Action/RSS.pm 857 2006-01-29T10:15:43.298856Z guillaume  $
+package Youri::Repository::Mandriva_upload;
+
+=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 MDV::Distribconf::Build;
+use SVN::Client;
+use constant {
+    PACKAGE_CLASS   => 'Youri::Package::URPM',
+    PACKAGE_CHARSET => 'utf8'
+};
+
+memoize('_get_section', '_get_media_config');
+
+sub _init {
+    my $self   = shift;
+    my %options = (
+        noarch => 'i586', # noarch packages policy
+	install_root => '',
+        test          => 0,  # test mode
+        verbose       => 0,  # verbose mode
+	user	      => '',
+        @_
+    );
+
+    foreach my $var ('arch', 'upload_state') {
+	$self->{"_$var"} = [];
+	foreach my $value (split ' ', $options{$var}) {
+	    push @{$self->{"_$var"}}, $value
+	}
+    }
+    print "Initializing repository for @{$self->{_arch}}\n";
+    foreach my $v ('user', 'noarch', 'install_root', 'upload_root', 'verbose') {
+        $self->{"_$v"}  = $options{$v}
+    }
+
+    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time);
+    $year+=1900;
+    $mon++;
+    my $hostname = `hostname`;
+    my ($host) = $hostname =~ /([^.]*)/;
+    $self->{group_id} = sprintf "$year%02d%02d%02d%02d%02d.$self->{_user}.$host.${$}_", $mon, $mday, $hour, $min, $sec;
+    $self
+}
+
+sub _get_media_config {
+    my ($self, $target) = @_;
+    my %media;
+    foreach my $arch (@{$self->{_arch}}) {
+	my $root = "$self->{_install_root}/$target/$arch";
+	my $distrib = MDV::Distribconf::Build->new($root);
+	print "Getting media config from $root\n";
+	$self->{distrib}{$arch} = $distrib;
+	$distrib->loadtree or die "$root does not seem to be a distribution tree\n";
+	$distrib->parse_mediacfg;
+	foreach my $media ($distrib->listmedia) {
+	    my $rpms = $distrib->getvalue($media, 'rpms');
+	    my $debug_for = $distrib->getvalue($media, 'debug_for');
+	    my $srpms = $distrib->getvalue($media, 'srpms');
+	    my $path = $distrib->getfullpath($media, 'path');
+	    if (!$debug_for && !$rpms) {
+		if (-d $path) {
+		    print "MEDIA defining $media in $path\n";
+		    $media{$arch}{$media} = $path
+		} else {
+		    print "ERROR $path does not exist for media $media on $arch\n"
+		}
+	    }
+	    if ($rpms) {
+		my ($media) = split ' ', $rpms;
+		if (-d $path) {
+		    print "MEDIA defining SOURCE media for $media in $path\n";
+		    $media{src}{$media} = $path
+		} else {
+		    print "ERROR $path does not exist for source media $media on $arch\n"
+		}
+	    }
+	}
+    }
+    \%media
+}
+
+sub get_package_class {
+    return PACKAGE_CLASS;
+}
+
+sub get_package_charset {
+    return PACKAGE_CHARSET;
+}
+
+sub get_upload_dir {
+    my ($self, $package, $target, $define, $user) = @_;
+    croak "Not a class method" unless ref $self;
+    my $arch = $package->get_arch();
+    print "USER $user\n";
+    return
+        $self->{_upload_root} .
+        "/todo/$target/" .
+        $self->_get_section($package, $target, $define) .
+	"/$self->{group_id}"
+}
+
+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 $section = $self->_get_section($package, $target, $define);
+
+    $section
+}
+
+
+sub get_version_path {
+    my ($self, $package, $target, $define) = @_;
+
+    my $section = $self->_get_section($package, $target, $define);
+
+    return "$self->{_module}/$section";
+}
+
+=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();
+
+    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
+    my $media = $self->_get_media_config($target);
+    foreach my $m (keys %{$media->{$arch}}) {
+        next unless
+            $self->get_files(
+		'',
+                $media->{src}{$m}, 
+                $source_pattern
+            ) || $self->get_files(
+	        '',
+                $media->{$arch}{$m},
+                $binary_pattern
+            );
+	print "Section is $m\n";
+        $section = $m;
+        last;
+    }
+
+    # use defined section if not found
+    $section = $define->{section} unless $section;
+
+    die "Can't guess destination: section missing" unless $section;
+
+    return $section;
+}
+
+sub get_upload_newer_revisions {
+    my ($self, $package, $target, $define) = @_;
+    croak "Not a class method" unless ref $self;
+    my $arch = $package->get_arch();
+    my $name = $package->get_full_name;
+    my $pattern = $self->get_package_class()->get_pattern($package->get_name(), undef, undef, $arch);
+    my $media = $self->_get_media_config($target);
+    my @packages;
+    foreach my $state (@{$self->{_upload_state}}) {
+	foreach my $m (keys %{$media->{$arch}}) {
+	    my $path = "$self->{_upload_root}/$state/$target/$m";
+	    print "Looking for package $package revisions for $target in $path (pattern $pattern)\n";
+	    find(
+		sub { 
+		    s/([^_]+)_//; 
+		    return if ! /$pattern/; 
+		    print "Find $_\n"; 
+		    push @packages, $File::Find::name if $package->compare_ranges("== $name", "< $_")
+		}, $path);
+	}
+    }
+    return
+        @packages;
+}
+
+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}
+}
+
+# 20060801 warly
+#
+# Upload steps
+# SRPMS are uploaded in /home/mandrake/uploads/todo/$target/$media/group_id
+#
+# 
+#
+
+=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;
diff --git a/lib/Youri/Repository/Mandriva_upload_pre.pm b/lib/Youri/Repository/Mandriva_upload_pre.pm
new file mode 100644
index 0000000..d8c8c68
--- /dev/null
+++ b/lib/Youri/Repository/Mandriva_upload_pre.pm
@@ -0,0 +1,259 @@
+# $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 = $package->get_arch;
+    if ($arch eq 'src') {
+	$arch = 'SRPMS'
+    } else {
+	$arch .= '/media'
+    }
+    my @packages = 
+        map { $self->get_package_class()->new(file => $_) }
+        $self->get_files(
+            $self->{_install_root},
+            "$target/$arch/" . $self->_get_section($package, $target, $define),
+            $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_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_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();
+
+    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/) {
+	print "Checking $self->{_install_root}, SRPMS/$dir, $source_pattern\n" if $self->{_verbose};
+        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 $pattern = $self->get_package_class()->get_pattern($package->get_name());
+    print "Looking for package $package revisions for $target in $self->{_upload_root} (pattern $pattern)\n";
+    my @packages;
+    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});
+
+    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;