diff options
Diffstat (limited to 'lib/Youri/Package/Test.pm')
-rw-r--r-- | lib/Youri/Package/Test.pm | 151 |
1 files changed, 151 insertions, 0 deletions
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; |