imported initial version of youri svn

1 files changed, 273 insertions, 0 deletions

diff --git a/lib/Youri/Media/URPM.pm b/lib/Youri/Media/URPM.pm
new file mode 100644
index 0000000..ca26860
--- /dev/null
+++ b/lib/Youri/Media/URPM.pm
@@ -0,0 +1,273 @@
+# $Id: URPM.pm 903 2006-04-21 21:51:48Z guillomovitch $
+package Youri::Media::URPM;
+
+=head1 NAME
+
+Youri::Media::URPM - URPM-based media implementation
+
+=head1 DESCRIPTION
+
+This is an URPM-based L<Youri::Media> implementation.
+
+It can be created either from local or remote full (hdlist) or partial
+(synthesis) compressed header files, or from a package directory. File-based
+inputs are only usable with this latest option.
+
+=cut
+
+use URPM;
+use File::Find;
+use File::Temp ();
+use Youri::Utils;
+use LWP::Simple;
+use Carp;
+use strict;
+use warnings;
+use Youri::Package::URPM;
+
+use base 'Youri::Media';
+
+=head1 CLASS METHODS
+
+=head2 new(%args)
+
+Creates and returns a new Youri::Media::URPM object.
+
+Specific parameters:
+
+=over
+
+=item synthesis $synthesis
+
+Path, URL or list of path or URL of synthesis file used for creating
+this media. If a list is given, the first successfully accessed will be used,
+so as to allow better reliability.
+
+=item hdlist $hdlist
+
+Path, URL or list of path or URL of hdlist file used for creating
+this media. If a list is given, the first successfully accessed will be used,
+so as to allow better reliability.
+
+=item path $path
+
+Path or list of pathes of package directory used for creating this
+media. If a list is given, the first successfully accessed will be used, so as
+to allow better reliability.
+
+=item max_age $age
+
+Maximum age of packages for this media.
+
+=item rpmlint_config $file
+
+rpmlint configuration file for this media.
+
+=back
+
+In case of multiple B<synthesis>, B<hdlist> and B<path> options given, they
+will be tried in this order, so as to minimize parsing time.
+
+=cut
+
+sub _init {
+    my $self   = shift;
+
+    my %options = (
+        hdlist         => '',    # hdlist from which to create this media
+        synthesis      => '',    # synthesis from which to create this media
+        path           => '',    # directory from which to create this media
+        max_age        => '',    # maximum build age for packages
+        rpmlint_config => '',    # rpmlint configuration for packages
+        @_
+    );
+
+    my $urpm = URPM->new();
+    SOURCE: {
+        if ($options{synthesis}) {
+            foreach my $file (
+                ref $options{synthesis} eq 'ARRAY' ?
+                    @{$options{synthesis}} :
+                    $options{synthesis}
+            ) {
+                print "Attempting to retrieve synthesis $file\n"
+                    if $options{verbose};
+                my $synthesis = $self->_get_file($file);
+                if ($synthesis) {
+                    $urpm->parse_synthesis($synthesis, keep_all_tags => 1);
+                    last SOURCE;
+                }
+            }
+        }
+
+        if ($options{hdlist}) { 
+            foreach my $file (
+                ref $options{hdlist} eq 'ARRAY' ?
+                    @{$options{hdlist}} :
+                    $options{hdlist}
+            ) {
+                print "Attempting to retrieve hdlist $file\n"
+                    if $options{verbose};
+                my $hdlist = $self->_get_file($file);
+                if ($hdlist) {
+                    $urpm->parse_hdlist($hdlist, keep_all_tags => 1);
+                    last SOURCE;
+                }
+            }
+        }
+
+        if ($options{path}) {
+            foreach my $path (
+                ref $options{path} eq 'ARRAY' ?
+                    @{$options{path}} :
+                    $options{path}
+            ) {
+                print "Attempting to scan directory $path\n"
+                    if $options{verbose};
+                unless (-d $path) {
+                    carp "non-existing directory $path";
+                    next;
+                }
+                unless (-r $path) {
+                    carp "non-readable directory $path";
+                    next;
+                }
+
+                my $parse = sub {
+                    return unless -f $File::Find::name;
+                    return unless -r $File::Find::name;
+                    return unless /\.rpm$/;
+
+                    $urpm->parse_rpm($File::Find::name, keep_all_tags => 1);
+                };
+
+                find($parse, $path);
+                last SOURCE;
+            }
+        }
+        
+        croak "no source specified";
+    }
+
+    $self->{_urpm}           = $urpm;
+    $self->{_path}           = $options{path};
+    $self->{_max_age}        = $options{max_age};
+    $self->{_rpmlint_config} = $options{rpmlint_config};
+
+    return $self;
+}
+
+sub _remove_all_archs {
+    my ($self) = @_;
+    croak "Not a class method" unless ref $self;
+
+    $self->{_urpm}->{depslist} = [];
+}
+
+sub _remove_archs {
+    my ($self, $skip_archs) = @_;
+    croak "Not a class method" unless ref $self;
+
+    my $urpm = $self->{_urpm};
+    $urpm->{depslist} = [
+         grep { ! $skip_archs->{$_->arch()} } @{$urpm->{depslist}}
+    ];
+}
+
+=head1 INSTANCE METHODS
+
+=head2 max_age()
+
+Returns maximum age of packages for this media.
+
+=cut
+
+sub max_age {
+    my ($self) = @_;
+    croak "Not a class method" unless ref $self;
+
+    return $self->{_max_age};
+}
+
+=head2 rpmlint_config()
+
+Returns rpmlint configuration file for this media.
+
+=cut
+
+sub rpmlint_config {
+    my ($self) = @_;
+    croak "Not a class method" unless ref $self;
+
+    return $self->{_rpmlint_config};
+}
+
+sub get_package_class {
+    my ($self) = @_;
+    croak "Not a class method" unless ref $self;
+
+    return "Youri::Package::URPM";
+}
+
+sub traverse_files {
+    my ($self, $function) = @_;
+    croak "Not a class method" unless ref $self;
+
+    my $callback = sub {
+        return unless -f $File::Find::name;
+        return unless -r $File::Find::name;
+        return unless $_ =~ /\.rpm$/;
+
+        my $package = Youri::Package::URPM->new(file => $File::Find::name);
+        return if $self->{_skip_archs}->{$package->get_arch()};
+
+        $function->($File::Find::name, $package);
+    };
+
+    find($callback, $self->{_path});
+}
+
+sub traverse_headers {
+    my ($self, $function) = @_;
+    croak "Not a class method" unless ref $self;
+
+    $self->{_urpm}->traverse(sub {
+        local $_; # workaround mysterious problem between URPM and AppConfig
+        $function->(Youri::Package::URPM->new(header => $_[0]));
+    });
+    
+}
+
+sub _get_file {
+    my ($self, $file) = @_;
+
+    if ($file =~ /^(?:http|ftp):\/\/.*$/) {
+        my $tempfile = File::Temp->new();
+        my $status = getstore($file, $tempfile->filename());
+        unless (is_success($status)) {
+            carp "invalid URL $file: $status";
+            return;
+        }
+        return $tempfile;
+    } else {
+        unless (-f $file) {
+            carp "non-existing file $file";
+            return;
+        }
+        unless (-r $file) {
+            carp "non-readable file $file";
+            return;
+        }
+        return $file;
+    }
+}
+
+=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;