merging dev with upstream

1 files changed, 142 insertions, 78 deletions

diff --git a/lib/Youri/Repository.pm b/lib/Youri/Repository.pm
index 4f28b5e..97938cf 100644
--- a/lib/Youri/Repository.pm
+++ b/lib/Youri/Repository.pm
@@ -19,13 +19,6 @@ use Youri::Package;
 
 =head1 CLASS METHODS
 
-=head2 get_package_class()
-
-Return package class for this repository.
-
-=head2 get_package_charset()
-
-Return package charset for this repository.
 
 =head2 new(%args)
 
@@ -73,7 +66,45 @@ sub _init {
 
 =head1 INSTANCE METHODS
 
-=head2 get_older_revisions($package, $target, $define)
+=head2 get_package_class()
+
+Return package class for this repository.
+
+=cut
+
+sub get_package_class {
+    my ($self) = @_;
+    croak "Not a class method" unless ref $self;
+    return $self->{_package_class};
+}
+
+=head2 get_package_charset()
+
+Return package charset for this repository.
+
+=cut
+
+sub get_package_charset {
+    my ($self) = @_;
+    croak "Not a class method" unless ref $self;
+    return $self->{_package_charset};
+}
+
+=head2 get_extra_arches()
+
+Return the list of additional archictectures to handle when dealing with noarch
+packages.
+
+=cut
+
+sub get_extra_arches {
+    my ($self) = @_;
+    croak "Not a class method" unless ref $self;
+    return @{$self->{_extra_arches}};
+}
+
+
+=head2 get_older_revisions($package, $target, $user_context, $app_context)
 
 Get all older revisions from a package found in its installation directory, as a
 list of L<Youri::Package> objects.
@@ -81,7 +112,7 @@ list of L<Youri::Package> objects.
 =cut
 
 sub get_older_revisions {
-    my ($self, $package, $target, $define) = @_;
+    my ($self, $package, $target, $user_context, $app_context) = @_;
     croak "Not a class method" unless ref $self;
     print "Looking for package $package older revisions for $target\n"
         if $self->{_verbose} > 0;
@@ -89,12 +120,13 @@ sub get_older_revisions {
     return $self->get_revisions(
         $package,
         $target,
-        $define,
+        $user_context,
+        $app_context,
         sub { return $package->compare($_[0]) > 0 }
     );
 }
 
-=head2 get_last_older_revision($package, $target, $define)
+=head2 get_last_older_revision($package, $target, $user_context, $app_context)
 
 Get last older revision from a package found in its installation directory, as a
 single L<Youri::Package> object.
@@ -102,23 +134,30 @@ single L<Youri::Package> object.
 =cut
 
 sub get_last_older_revision {
-    my ($self, $package, $target, $define) = @_;
+    my ($self, $package, $target, $user_context, $app_context) = @_;
     croak "Not a class method" unless ref $self;
     print "Looking for package $package last older revision for $target\n"
         if $self->{_verbose} > 0;
 
-    return ($self->get_older_revisions($package, $target, $define))[0];
+    return (
+        $self->get_older_revisions(
+            $package,
+            $target,
+            $user_context,
+            $app_context
+        )
+    )[0];
 }
 
-=head2 get_newer_revisions($package, $target, $define)
+=head2 get_newer_revisions($package, $target, $user_context, $app_context)
 
-Get all newer revisions from a package found in its installation directory, as a
-list of L<Youri::Package> objects.
+Get all newer revisions from a package found in its installation directory, as
+a list of L<Youri::Package> objects.
 
 =cut
 
 sub get_newer_revisions {
-    my ($self, $package, $target, $define) = @_;
+    my ($self, $package, $target, $user_context, $app_context) = @_;
     croak "Not a class method" unless ref $self;
     print "Looking for package $package newer revisions for $target\n"
         if $self->{_verbose} > 0;
@@ -126,13 +165,14 @@ sub get_newer_revisions {
     return $self->get_revisions(
         $package,
         $target,
-        $define,
-        sub { return $_[0]->compare($package) >= 0 }
+        $user_context,
+        $app_context,
+        sub { return $_[0]->compare($package) > 0 }
     );
 }
 
 
-=head2 get_revisions($package, $target, $define, $filter)
+=head2 get_revisions($package, $target, $user_context, $app_context, $filter)
 
 Get all revisions from a package found in its installation directory, using an
 optional filter, as a list of L<Youri::Package> objects.
@@ -140,7 +180,7 @@ optional filter, as a list of L<Youri::Package> objects.
 =cut
 
 sub get_revisions {
-    my ($self, $package, $target, $define, $filter) = @_;
+    my ($self, $package, $target, $user_context, $app_context, $filter) = @_;
     croak "Not a class method" unless ref $self;
     print "Looking for package $package revisions for $target\n"
         if $self->{_verbose} > 0;
@@ -149,7 +189,12 @@ sub get_revisions {
         map { $self->get_package_class()->new(file => $_) }
         $self->get_files(
             $self->{_install_root},
-            $self->get_install_path($package, $target, $define),
+            $self->get_install_path(
+                $package,
+                $target,
+                $user_context,
+                $app_context
+            ),
             $self->get_package_class()->get_pattern(
                 $package->get_name(),
                 undef,
@@ -165,7 +210,7 @@ sub get_revisions {
         @packages;
 }
 
-=head2 get_obsoleted_packages($package, $target, $define)
+=head2 get_obsoleted_packages($package, $target, $user_context, $app_context)
 
 Get all packages obsoleted by given one, as a list of L<Youri::Package>
 objects.
@@ -173,7 +218,7 @@ objects.
 =cut
 
 sub get_obsoleted_packages {
-    my ($self, $package, $target, $define) = @_;
+    my ($self, $package, $target, $user_context, $app_context) = @_;
     croak "Not a class method" unless ref $self;
     print "Looking for packages obsoleted by $package for $target\n"
         if $self->{_verbose} > 0;
@@ -181,22 +226,26 @@ sub get_obsoleted_packages {
     my @packages;
     foreach my $obsolete ($package->get_obsoletes()) {
         my $pattern = $self->get_package_class()->get_pattern($obsolete->[Youri::Package::DEPENDENCY_NAME]);
-	my @list;
-        push(@list,
+        my $range = $obsolete->[Youri::Package::DEPENDENCY_RANGE];
+        push(@packages,
+            grep { $range ? $_->satisfy_range($range) : 1 } 
             map { $self->get_package_class()->new(file => $_) }
             $self->get_files(
                 $self->{_install_root},
-                $self->get_install_path($package, $target, $define),
+                $self->get_install_path(
+                    $package, $target,
+                    $user_context,
+                    $app_context
+                ),
                 $pattern
             )
         );
-	push @packages, grep { $package->range_check($obsolete, $_) } @list;
     }
 
     return @packages;
 }
 
-=head2 get_replaced_packages($package, $target, $define)
+=head2 get_replaced_packages($package, $target, $user_context, $app_context)
 
 Get all packages replaced by given one, as a list of L<Youri::Package>
 objects.
@@ -204,14 +253,42 @@ objects.
 =cut
 
 sub get_replaced_packages {
-    my ($self, $package, $target, $define) = @_;
+    my ($self, $package, $target, $user_context, $app_context) = @_;
     croak "Not a class method" unless ref $self;
     print "Looking for packages replaced by $package for $target\n"
         if $self->{_verbose} > 0;
 
-    return 
-        $self->get_older_revisions($package, $target, $define),
-        $self->get_obsoleted_packages($package, $target, $define);
+    my @list;
+
+    # collect all older revisions
+    push(@list, $self->get_older_revisions(
+        $package,
+        $target,
+        $user_context,
+        $app_context
+    ));
+
+    # noarch packages are potentially linked from other directories
+    if ($package->get_arch() eq 'noarch') {
+        foreach my $arch ($self->get_extra_arches()) {
+            push(@list, $self->get_older_revisions(
+                $package,
+                $target,
+                $user_context,
+                { arch => $arch }
+            ));
+        }
+    }
+
+    # collect all obsoleted packages
+    push(@list, $self->get_obsoleted_packages(
+        $package,
+        $target,
+        $user_context,
+        $app_context
+    ));
+
+    return @list;
 }
 
 =head2 get_files($path, $pattern)
@@ -224,8 +301,6 @@ Get all files found in a directory, using an optional filtering pattern
 sub get_files {
     my ($self, $root, $path, $pattern) = @_;
     croak "Not a class method" unless ref $self;
-    $root ||= '';
-    $path ||= '';
     print "Looking for files matching $pattern in $root/$path\n"
         if $self->{_verbose} > 1;
 
@@ -254,7 +329,7 @@ sub get_install_root {
     return $self->{_install_root};
 }
 
-=head2 get_install_dir($package, $target, $define)
+=head2 get_install_dir($package, $target, $user_context, $app_context)
 
 Returns install destination directory for given L<Youri::Package> object
 and given target.
@@ -262,13 +337,13 @@ and given target.
 =cut
 
 sub get_install_dir {
-    my ($self, $package, $target, $define) = @_;
+    my ($self, $package, $target, $user_context, $app_context) = @_;
     croak "Not a class method" unless ref $self;
 
-    return
-        $self->{_install_root} .
-        '/' .
-        $self->get_install_path($package, $target, $define);
+    return $self->_get_dir(
+        $self->{_install_root},
+        $self->get_install_path($package, $target, $user_context, $app_context)
+    );
 }
 
 =head2 get_archive_root()
@@ -284,7 +359,7 @@ sub get_archive_root {
     return $self->{_archive_root};
 }
 
-=head2 get_archive_dir($package, $target, $define)
+=head2 get_archive_dir($package, $target, $user_context, $app_context)
 
 Returns archiving destination directory for given L<Youri::Package> object
 and given target.
@@ -292,29 +367,16 @@ and given target.
 =cut
 
 sub get_archive_dir {
-    my ($self, $package, $target, $define) = @_;
+    my ($self, $package, $target, $user_context, $app_context) = @_;
     croak "Not a class method" unless ref $self;
 
-    return
-        $self->{_archive_root} .
-        '/' .
-        $self->get_archive_path($package, $target, $define);
+    return $self->_get_dir(
+        $self->{_archive_root},
+        $self->get_archive_path($package, $target, $user_context, $app_context)
+    );
 }
 
-=head2 get_reject_dir($package, $target, $define)
 
-Returns rejecting destination directory for given L<Youri::Package> object
-and given target.
-
-=cut
-
-sub get_reject_dir {
-    my ($self, $package, $target, $define) = @_;
-    croak "Not a class method" unless ref $self;
-
-    return
-        $self->get_reject_path($package, $target, $define);
-}
 =head2 get_version_root()
 
 Returns versionning root
@@ -328,7 +390,7 @@ sub get_version_root {
     return $self->{_version_root};
 }
 
-=head2 get_version_dir($package, $target, $define)
+=head2 get_version_dir($package, $target, $user_context, $app_context)
 
 Returns versioning destination directory for given L<Youri::Package>
 object and given target.
@@ -336,16 +398,24 @@ object and given target.
 =cut
 
 sub get_version_dir {
-    my ($self, $package, $target, $define) = @_;
+    my ($self, $package, $target, $user_context, $app_context) = @_;
     croak "Not a class method" unless ref $self;
 
-    return
-        $self->{_version_root} .
-        '/' .
-        $self->get_version_path($package, $target, $define);
+    return $self->_get_dir(
+        $self->{_version_root},
+        $self->get_version_path($package, $target, $user_context, $app_context)
+    );
+}
+
+sub _get_dir {
+    my ($self, $root, $path) = @_;
+
+    return substr($path, 0, 1) eq '/' ?
+        $path :
+        $root . '/' . $path;
 }
 
-=head2 get_install_file($package, $target, $define)
+=head2 get_install_file($package, $target, $user_context, $app_context)
 
 Returns install destination file for given L<Youri::Package> object and
 given target.
@@ -353,32 +423,26 @@ given target.
 =cut
 
 sub get_install_file {
-    my ($self, $package, $target, $define) = @_;
+    my ($self, $package, $target, $user_context, $app_context) = @_;
     croak "Not a class method" unless ref $self;
 
     return 
-        $self->get_install_dir($package, $target, $define) .
+        $self->get_install_dir($package, $target, $user_context, $app_context) .
         '/' .
         $package->get_file_name();
 }
 
-=head2 get_install_path($package, $target, $define)
+=head2 get_install_path($package, $target, $user_context, $app_context)
 
 Returns installation destination path (relative to repository root) for given
 L<Youri::Package> object and given target.
 
-=head2 get_archive_path($package, $target, $define)
+=head2 get_archive_path($package, $target, $user_context, $app_context)
 
 Returns archiving destination path (relative to repository root) for given
 L<Youri::Package> object and given target.
 
-=head2 get_reject_path($package, $target, $define)
-
-Returns reject destination path for given
-L<Youri::Package> object and given target.
-
-
-=head2 get_version_path($package, $target, $define)
+=head2 get_version_path($package, $target, $user_context, $app_context)
 
 Returns versioning destination path (relative to repository root) for given
 L<Youri::Package> object and given target.