merging dev with upstream

4 files changed, 214 insertions, 84 deletions

diff --git a/lib/Youri/Package/RPM.pm b/lib/Youri/Package/RPM.pm
index cdb1680..bb87f38 100644
--- a/lib/Youri/Package/RPM.pm
+++ b/lib/Youri/Package/RPM.pm
@@ -15,6 +15,7 @@ implementation.
 use strict;
 use warnings;
 use base 'Youri::Package';
+use Carp;
 
 sub get_pattern {
     my ($class, $name, $version, $release, $arch) = @_;
@@ -30,4 +31,18 @@ sub get_pattern {
         '\.rpm';
 }
 
+sub as_file {
+    my ($self) = @_;
+    croak "Not a class method" unless ref $self;
+
+    return $self->{_file};
+}
+
+sub is_debug {
+    my ($self) = @_;
+    croak "Not a class method" unless ref $self;
+
+    return $self->get_name() =~ /-debug$/o;
+}
+
 1;
diff --git a/lib/Youri/Package/RPM4.pm b/lib/Youri/Package/RPM4.pm
index 5437a3d..306c32f 100644
--- a/lib/Youri/Package/RPM4.pm
+++ b/lib/Youri/Package/RPM4.pm
@@ -3,14 +3,11 @@ package Youri::Package::RPM4;
 
 =head1 NAME
 
-Youri::Package::URPM - URPM-based rpm package implementation
+Youri::Package::RPM4 - URPM-based rpm package implementation
 
 =head1 DESCRIPTION
 
-This is an URPM-based L<Youri::Package> implementation for rpm.
-
-It is merely a wrapper over URPM::Package class, with a more structured
-interface.
+This is an RPM4-based L<Youri::Package> implementation for rpm.
 
 =cut
 
@@ -24,7 +21,7 @@ use File::Spec;
 use Scalar::Util qw/refaddr/;
 use base 'Youri::Package::RPM';
 use overload
-    '""'     => '_to_string',
+    '""'     => 'as_string',
     '0+'     => '_to_number',
     fallback => 1;
 
@@ -32,7 +29,7 @@ use overload
 
 =head2 new(%args)
 
-Creates and returns a new Youri::Package::URPM object.
+Creates and returns a new Youri::Package::RPM4 object.
 
 Specific parameters:
 
@@ -44,7 +41,7 @@ Path of file to use for creating this package.
 
 =item header $header
 
-L<URPM::Package> object to use for creating this package.
+L<RPM4::Header> object to use for creating this package.
 
 =back
 
@@ -99,7 +96,7 @@ sub _depsense2flag {
     return \@flags;
 }
 
-sub compare_ranges {
+sub check_ranges_compatibility {
     my ($class, $range1, $range2) = @_;
     my @deps1 = split(/ /, $range1);
     my @deps2 = split(/ /, $range2);
@@ -138,18 +135,11 @@ sub get_release {
     return $self->{_header}->tag('release');
 }
 
-sub get_revision_name {
-    my ($self) = @_;
-    croak "Not a class method" unless ref $self;
-
-    return join('-', ($self->get_name, $self->get_version, $self->get_release));
-}
-
-sub get_full_name {
+sub get_revision {
     my ($self) = @_;
     croak "Not a class method" unless ref $self;
 
-    return $self->{_header}->queryformat('%{NAME}-%{VERSION}-%{RELEASE}.%|SOURCERPM?{%{ARCH}}:{src}|');
+    return $self->{_header}->queryformat('%|EPOCH?{%{EPOCH}:}:{}|%{VERSION}-%{RELEASE}');
 }
 
 sub get_file_name {
@@ -159,6 +149,7 @@ sub get_file_name {
     return $self->{_header}->queryformat('%{NAME}-%{VERSION}-%{RELEASE}.%|SOURCERPM?{%{ARCH}}:{src}|.rpm');
 }
 
+
 sub get_arch {
     my ($self) = @_;
     croak "Not a class method" unless ref $self;
@@ -194,13 +185,6 @@ sub get_packager {
     return $self->{_header}->tag('packager');
 }
 
-sub get_file {
-    my ($self) = @_;
-    croak "Not a class method" unless ref $self;
-
-    return $self->{_file};
-}
-
 sub is_source {
     my ($self) = @_;
     croak "Not a class method" unless ref $self;
@@ -378,8 +362,18 @@ sub get_last_change {
     ];
 }
 
-sub _to_string {
-    return $_[0]->{_header}->fullname();
+sub as_string {
+    my ($self) = @_;
+    croak "Not a class method" unless ref $self;
+
+    return $self->{_header}->fullname();
+}
+
+sub as_formated_string {
+    my ($self, $format) = @_;
+    croak "Not a class method" unless ref $self;
+
+    return $self->{_header}->queryformat($format);
 }
 
 sub _to_number {
@@ -393,6 +387,13 @@ sub compare {
     return $self->{_header}->compare($package->{_header}) || 0;
 }
 
+sub satisfy_range {
+    my ($self, $range) = @_;
+    croak "Not a class method" unless ref $self;
+
+    return $self->check_range_compatibility($self->get_revision(), $range);
+}
+
 sub sign {
     my ($self, $name, $path, $passphrase) = @_;
     croak "Not a class method" unless ref $self;
diff --git a/lib/Youri/Package/Test.pm b/lib/Youri/Package/Test.pm
new file mode 100644
index 0000000..edd4777
--- /dev/null
+++ b/lib/Youri/Package/Test.pm
@@ -0,0 +1,151 @@
+# $Id: /local/youri/soft/core/trunk/lib/Youri/Package/URPM.pm 2133 2006-09-20T21:40:20.575763Z guillaume  $
+package Youri::Package::Test;
+
+=head1 NAME
+
+Youri::Package::Test - Fake test package
+
+=head1 DESCRIPTION
+
+This is just a fake package object, intended for testing purposes.
+
+=cut
+
+use strict;
+use warnings;
+use Carp;
+use base 'Youri::Package::RPM';
+use overload
+    '""'     => 'as_string',
+    '0+'     => '_to_number',
+    fallback => 1;
+
+our $AUTOLOAD;
+
+my @tags = qw/
+    name
+    version
+    release
+    filename
+    arch
+    url
+    summary
+    description
+    packager
+    buildtime
+    sourcerpm
+/;
+
+my %tags = map { $_ => 1 } @tags;
+
+=head1 CLASS METHODS
+
+=head2 new(%args)
+
+Creates and returns a new Youri::Package::Test object.
+
+Specific parameters:
+
+=over
+
+=item tag $tag
+
+Use given value for given tag
+
+=back
+
+=cut
+
+sub _init {
+    my ($self, %options) = @_;
+
+    $self->{"_$_"} = $options{$_} foreach keys %options;
+}
+
+sub get_revision {
+    my ($self) = @_;
+    croak "Not a class method" unless ref $self;
+
+    return $self->{_epoch} ?
+        "$self->{_epoch}:$self->{_version}-$self->{_release}" :
+        "$self->{_version}-$self->{_release}";
+}
+
+sub get_tag {
+    my ($self, $tag) = @_;
+    croak "Not a class method" unless ref $self;
+    croak "invalid tag $tag" unless $tags{$tag};
+    return $self->{'_' . $tag};
+}
+
+sub is_source {
+    my ($self) = @_;
+    croak "Not a class method" unless ref $self;
+
+    return $self->{_arch} eq 'src';
+}
+
+sub is_binary {
+    my ($self) = @_;
+    croak "Not a class method" unless ref $self;
+
+    return $self->{_arch} ne 'src';
+}
+
+sub get_type {
+    my ($self) = @_;
+    croak "Not a class method" unless ref $self;
+
+    return
+        $self->{_arch} eq 'src' ?
+        "source" :
+        "binary";
+}
+
+sub get_canonical_name {
+    my ($self) = @_;
+    croak "Not a class method" unless ref $self;
+
+    if ($self->{_arch} eq 'src') {
+       return $self->{_name};
+    } else {
+       if ($self->{_sourcerpm}) {
+           $self->{_sourcerpm} =~ /^(\S+)-[^-]+-[^-]+\.src\.rpm$/;
+           return $1;
+       } else {
+           return undef;
+       }
+    }
+}
+
+sub as_string {
+    my ($self) = @_;
+    croak "Not a class method" unless ref $self;
+
+    return 
+        $self->{_name} ? $self->{_name} : '' .
+        '-' .
+        $self->{_version} ? $self->{_version} : '' .
+        '-' .
+        $self->{_release} ? $self->{_release} : '';
+}
+
+sub _to_number {
+    return refaddr($_[0]);
+}
+
+sub AUTOLOAD {
+    my ($self) = @_;
+    croak "Not a class method" unless ref $self;
+
+    my $method = $AUTOLOAD;
+    $method =~ s/.*:://;
+    return if $method eq 'DESTROY';
+    croak "invalid method" unless $method =~ /^get_(\w+)$/;
+
+    my $tag = $1;
+    croak "invalid tag $tag" unless $tags{$tag};
+    return $self->{'_' . $tag};
+}
+
+1;
diff --git a/lib/Youri/Package/URPM.pm b/lib/Youri/Package/URPM.pm
index ea6d546..0691d83 100644
--- a/lib/Youri/Package/URPM.pm
+++ b/lib/Youri/Package/URPM.pm
@@ -23,7 +23,7 @@ use Expect;
 use Scalar::Util qw/refaddr/;
 use base 'Youri::Package::RPM';
 use overload
-    '""'     => '_to_string',
+    '""'     => 'as_string',
     '0+'     => '_to_number',
     fallback => 1;
 
@@ -90,7 +90,7 @@ sub compare_versions {
     return URPM::rpmvercmp($version1, $version2);
 }
 
-sub compare_ranges {
+sub check_ranges_compatibility {
     my ($class, $range1, $range2) = @_;
 
     return URPM::ranges_overlap($range1, $range2);
@@ -110,31 +110,6 @@ sub get_version {
     return $self->{_header}->version();
 }
 
-sub get_full_version {
-    my ($self) = @_;
-    croak "Not a class method" unless ref $self;
-
-    return $self->{_header}->epoch() ."-" . $self->{_header}->version() . "-". $self->{_header}->release()
-}
-
-sub range_check {
-    my ($self, $obsolete, $package) = @_;
-    croak "Not a class method" unless ref $self;
-    my $obs = $obsolete->[Youri::Package::DEPENDENCY_NAME];
-    my $range = $obsolete->[Youri::Package::DEPENDENCY_RANGE];
-    my ($flag, $version) = $range =~ /(\S+)\s+(.*)/;
-    if ($version) { 
-	my ($epoch, $ver, $release) = $version =~ /(?:(\d+):)?([^-]+(?:-[^-]*)?)/;
-	$release ||= '0';
-	$epoch ||= '0';
-	$range = "$flag $epoch-$ver-$release";
-	my $full_version = $package->get_full_version;
-	return URPM::ranges_overlap($range, "== $full_version")
-    } else {
-	return 1
-    }
-}
-
 sub get_release {
     my ($self) = @_;
     croak "Not a class method" unless ref $self;
@@ -142,18 +117,11 @@ sub get_release {
     return $self->{_header}->release();
 }
 
-sub get_revision_name {
-    my ($self) = @_;
-    croak "Not a class method" unless ref $self;
-
-    return join('-', ($self->{_header}->fullname())[0 .. 2]);
-}
-
-sub get_full_name {
+sub get_revision {
     my ($self) = @_;
     croak "Not a class method" unless ref $self;
 
-    return $self->{_header}->fullname();
+    return $self->{_header}->queryformat('%|EPOCH?{%{EPOCH}:}:{}|%{VERSION}-%{RELEASE}');
 }
 
 sub get_file_name {
@@ -198,13 +166,6 @@ sub get_packager {
     return $self->{_header}->packager();
 }
 
-sub get_file {
-    my ($self) = @_;
-    croak "Not a class method" unless ref $self;
-
-    return $self->{_file};
-}
-
 sub is_source {
     my ($self) = @_;
     croak "Not a class method" unless ref $self;
@@ -369,15 +330,18 @@ sub get_last_change {
     ];
 }
 
-sub get_buildhost {
+sub as_string {
     my ($self) = @_;
     croak "Not a class method" unless ref $self;
-    
-    return $self->{_header}->buildhost();
+
+    return $self->{_header}->fullname();
 }
 
-sub _to_string {
-    return $_[0]->{_header}->fullname();
+sub as_formated_string {
+    my ($self, $format) = @_;
+    croak "Not a class method" unless ref $self;
+
+    return $self->{_header}->queryformat($format);
 }
 
 sub _to_number {
@@ -391,6 +355,13 @@ sub compare {
     return $self->{_header}->compare_pkg($package->{_header});
 }
 
+sub satisfy_range {
+    my ($self, $range) = @_;
+    croak "Not a class method" unless ref $self;
+
+    return $self->check_range_compatibility($self->get_revision(), $range);
+}
+
 sub sign {
     my ($self, $name, $path, $passphrase) = @_;
     croak "Not a class method" unless ref $self;
@@ -400,16 +371,13 @@ sub sign {
     croak "Unsignable package, parent directory is read-only"
         unless -w $parent;
 
-    # FIXME Will have to change that
-    return !system("sudo -H /root/bin/resign_cooker $self->{_file}");
-    
     my $command =
         'LC_ALL=C rpm --resign ' . $self->{_file} .
         ' --define "_gpg_name ' . $name . '"' .
         ' --define "_gpg_path ' . $path . '"';
     my $expect = Expect->spawn($command) or die "Couldn't spawn command $command: $!\n";
     $expect->log_stdout(0);
-    $expect->expect(200, -re => 'Enter pass phrase:');
+    $expect->expect(20, -re => 'Enter pass phrase:');
     $expect->send("$passphrase\n");
 
     $expect->soft_close();
@@ -422,11 +390,6 @@ sub extract {
     system("rpm2cpio $self->{_file} | cpio -id >/dev/null 2>&1");
 }
 
-sub is_debug {
-    my ($self) = @_;
-    return $self->{_header}->name() =~ /-debug$/;
-}
-
 =head1 COPYRIGHT AND LICENSE
 
 Copyright (C) 2002-2006, YOURI project