diff options
Diffstat (limited to 'lib/Youri/Package')
-rw-r--r-- | lib/Youri/Package/RPM.pm | 58 | ||||
-rw-r--r-- | lib/Youri/Package/RPM4.pm | 424 | ||||
-rw-r--r-- | lib/Youri/Package/Test.pm | 151 | ||||
-rw-r--r-- | lib/Youri/Package/URPM.pm | 399 |
4 files changed, 1032 insertions, 0 deletions
diff --git a/lib/Youri/Package/RPM.pm b/lib/Youri/Package/RPM.pm new file mode 100644 index 0000000..1f72830 --- /dev/null +++ b/lib/Youri/Package/RPM.pm @@ -0,0 +1,58 @@ +# $Id: /local/youri/soft/trunk/lib/Youri/Package/URPM.pm 2257 2006-07-05T09:22:47.088572Z guillaume $ +package Youri::Package::RPM; + +=head1 NAME + +Youri::Package::RPM - Base class for all RPM-based package implementation + +=head1 DESCRIPTION + +This bases class factorize code between various RPM-based package +implementation. + +=cut + +use strict; +use warnings; +use base 'Youri::Package'; +use Carp; + +sub get_pattern { + my ($class, $name, $version, $release, $arch) = @_; + + return + ($name ? quotemeta($name) : '[\w-]+' ). + '-' . + ($version ? quotemeta($version) : '[^-]+' ). + '-' . + ($release ? quotemeta($release) : '[^-]+' ). + '\.' . + ($arch ? quotemeta($arch) : '\w+' ). + '\.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; + + my $name = $self->get_name(); + my $group = $self->get_tag('group'); + + # debug packages' names must end in -debug, except kernel + if ($group =~ m,^Development/Debug$, && + ($name =~ /-debug$/o || $name =~ /^kernel-.*-debug/o)) { + return 1; + } + else { + return 0; + } +} + +1; diff --git a/lib/Youri/Package/RPM4.pm b/lib/Youri/Package/RPM4.pm new file mode 100644 index 0000000..b1ed5d8 --- /dev/null +++ b/lib/Youri/Package/RPM4.pm @@ -0,0 +1,424 @@ +# $Id: /local/youri/soft/trunk/lib/Youri/Package/URPM.pm 2129 2006-06-23T09:41:01.599329Z guillomovitch $ +package Youri::Package::RPM4; + +=head1 NAME + +Youri::Package::RPM4 - URPM-based rpm package implementation + +=head1 DESCRIPTION + +This is an RPM4-based L<Youri::Package> implementation for rpm. + +=cut + +use strict; +use warnings; +use Carp; +use RPM4; +use RPM4::Header; +use RPM4::Sign; +use File::Spec; +use Scalar::Util qw/refaddr/; +use base 'Youri::Package::RPM'; +use overload + '""' => 'as_string', + '0+' => '_to_number', + fallback => 1; + +=head1 CLASS METHODS + +=head2 new(%args) + +Creates and returns a new Youri::Package::RPM4 object. + +Specific parameters: + +=over + +=item file $file + +Path of file to use for creating this package. + +=item header $header + +L<RPM4::Header> object to use for creating this package. + +=back + +=cut + +sub _init { + my ($self, %options) = @_; + + my $header; + HEADER: { + if (exists $options{header}) { + croak "undefined header" + unless $options{header}; + croak "invalid header" + unless $options{header}->isa('RPM4::Header'); + $header = $options{header}; + last HEADER; + } + + if (exists $options{file}) { + croak "undefined file" + unless $options{file}; + croak "non-existing file $options{file}" + unless -f $options{file}; + croak "non-readable file $options{file}" + unless -r $options{file}; + $header = RPM4::Header->new($options{file}); + croak "Can't get header from file $options{file}" if (!$header); + + last HEADER; + } + + croak "no way to extract header from arguments"; + } + + $self->{_header} = $header; + $self->{_file} = File::Spec->rel2abs($options{file}); +} + +sub compare_versions { + my ($class, $version1, $version2) = @_; + + return RPM4::rpmvercmp($version1, $version2); +} + +sub _depsense2flag { + my ($string) = @_; + my @flags = 0; + push(@flags, 'EQUAL') if ($string =~ /=/); + push(@flags, 'LESS') if ($string =~ /</); + push(@flags, 'GREATER') if ($string =~ />/); + return \@flags; +} + +sub check_ranges_compatibility { + my ($class, $range1, $range2) = @_; + my @deps1 = split(/ /, $range1); + my @deps2 = split(/ /, $range2); + $deps1[1] = _depsense2flag($range1); + $deps2[1] = _depsense2flag($range2); + my $dep1 = RPM4::Header::Dependencies( + "PROVIDENAME", + \@deps1, + ); + my $dep2 = RPM4::Header::Dependencies( + "PROVIDENAME", + \@deps2, + ); + + return $dep1->overlap($dep2); +} + +sub get_name { + my ($self) = @_; + croak "Not a class method" unless ref $self; + + return $self->{_header}->tag('name'); +} + +sub get_version { + my ($self) = @_; + croak "Not a class method" unless ref $self; + + return $self->{_header}->tag('version'); +} + +sub get_release { + my ($self) = @_; + croak "Not a class method" unless ref $self; + + return $self->{_header}->tag('release'); +} + +sub get_revision { + my ($self) = @_; + croak "Not a class method" unless ref $self; + + return $self->{_header}->queryformat('%|EPOCH?{%{EPOCH}:}:{}|%{VERSION}-%{RELEASE}'); +} + +sub get_file_name { + my ($self) = @_; + croak "Not a class method" unless ref $self; + + return $self->{_header}->queryformat('%{NAME}-%{VERSION}-%{RELEASE}.%|SOURCERPM?{%{ARCH}}:{src}|.rpm'); +} + + +sub get_arch { + my ($self) = @_; + croak "Not a class method" unless ref $self; + + return $self->{_header}->queryformat('%|SOURCERPM?{%{ARCH}}:{src}|'); +} + +sub get_url { + my ($self) = @_; + croak "Not a class method" unless ref $self; + + return $self->{_header}->tag('url'); +} + +sub get_summary { + my ($self) = @_; + croak "Not a class method" unless ref $self; + + return $self->{_header}->tag('summary'); +} + +sub get_description { + my ($self) = @_; + croak "Not a class method" unless ref $self; + + return $self->{_header}->tag('description'); +} + +sub get_packager { + my ($self) = @_; + croak "Not a class method" unless ref $self; + + return $self->{_header}->tag('packager'); +} + +sub is_source { + my ($self) = @_; + croak "Not a class method" unless ref $self; + + return $self->{_header}->issrc(); +} + +sub is_binary { + my ($self) = @_; + croak "Not a class method" unless ref $self; + + return !$self->{_header}->issrc(); +} + +sub get_type { + my ($self) = @_; + croak "Not a class method" unless ref $self; + + return + $self->{_header}->issrc() ? + "source" : + "binary"; +} + +sub get_age { + my ($self) = @_; + croak "Not a class method" unless ref $self; + + return $self->{_header}->tag('buildtime'); +} + +sub get_source_package { + my ($self) = @_; + croak "Not a class method" unless ref $self; + + return $self->{_header}->tag('sourcerpm'); +} + +sub get_canonical_name { + my ($self) = @_; + croak "Not a class method" unless ref $self; + + $self->{_header}->sourcerpmname() =~ /^(\S+)-[^-]+-[^-]+\.src\.rpm$/; + return $1; +} + +sub get_tag { + my ($self, $tag) = @_; + croak "Not a class method" unless ref $self; + #croak "invalid tag $tag" unless $self->{_header}->can($tag); + return $self->{_header}->tag($tag); +} + + +sub _get_dependencies { + my ($self, $deptype) = @_; + my $deps = $self->{_header}->dep($deptype); + my @deps_list; + if ($deps) { + $deps->init(); + while ($deps->next() >= 0) { + my @deps = $deps->info(); + $deps[1] =~ m/^rpmlib\(/ and next; # skipping internal rpmlib dep + $deps[2] =~ s/^=$/==/; # rpm say foo = 1, not foo == 1, == come from URPM, which sucks + my $range = $deps[3] ? ($deps[2] . ' ' . $deps[3]) : undef; + push(@deps_list, [ $deps[1], $range ]); + } + } + @deps_list +} + +sub get_requires { + my ($self) = @_; + + return $self->_get_dependencies('REQUIRENAME'); +} + +sub get_provides { + my ($self) = @_; + + return $self->_get_dependencies('PROVIDENAME'); +} + +sub get_obsoletes { + my ($self) = @_; + + return $self->_get_dependencies('OBSOLETENAME'); +} + +sub get_conflicts { + my ($self) = @_; + + return $self->_get_dependencies('CONFLICTNAME'); +} + +sub get_files { + my ($self) = @_; + + my $files = $self->{_header}->files(); + my @fileslist; + if ($files) { + $files->init(); + while ($files->next() >= 0) { + my $smode = $files->mode(); + my $umode = 0; + foreach (0..15) { # converting unsigned to signed int :\ + $umode |= $smode & (1 << $_); + } + push(@fileslist, [ $files->filename(), $umode, $files->md5() || '' ]); + } + } + @fileslist +} + +sub get_gpg_key { + my ($self) = @_; + + my $signature = $self->{_header}->queryformat('%{SIGGPG:pgpsig}'); + + return if $signature eq '(not a blob)'; + + my $key_id = (split(/\s+/, $signature))[-1]; + + return substr($key_id, 8); +} + +sub get_information { + my ($self) = @_; + + return $self->{_header}->queryformat(<<EOF); +Name : %-27{NAME} Relocations: %|PREFIXES?{[%{PREFIXES} ]}:{(not relocatable)}| +Version : %-27{VERSION} Vendor: %{VENDOR} +Release : %-27{RELEASE} Build Date: %{BUILDTIME:date} +Install Date: %|INSTALLTIME?{%-27{INSTALLTIME:date}}:{(not installed) }| Build Host: %{BUILDHOST} +Group : %-27{GROUP} Source RPM: %{SOURCERPM} +Size : %-27{SIZE}%|LICENSE?{ License: %{LICENSE}}| +Signature : %|DSAHEADER?{%{DSAHEADER:pgpsig}}:{%|RSAHEADER?{%{RSAHEADER:pgpsig}}:{%|SIGGPG?{%{SIGGPG:pgpsig}}:{%|SIGPGP?{%{SIGPGP:pgpsig}}:{(none)}|}|}|}| +%|PACKAGER?{Packager : %{PACKAGER}\n}|%|URL?{URL : %{URL}\n}|Summary : %{SUMMARY} +Description :\n%{DESCRIPTION} +EOF +} + +sub get_changes { + my ($self) = @_; + + my @names = $self->{_header}->tag('changelogname'); + my @time = $self->{_header}->tag('changelogtime'); + my @text = $self->{_header}->tag('changelogtext'); + + my @changes; + foreach my $i (0 .. $#names) { + $changes[$i] = [ + $names[$i], + $time[$i], + $text[$i], + ]; + } + + return @changes; +} + +sub get_last_change { + my ($self) = @_; + + return [ + ($self->{_header}->tag('changelogname'))[0], + ($self->{_header}->tag('changelogtime'))[0], + ($self->{_header}->tag('changelogtext'))[0], + ]; +} + +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 { + return refaddr($_[0]); +} + +sub compare { + my ($self, $package) = @_; + croak "Not a class method" unless ref $self; + + 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; + + # check if parent directory is writable + my $parent = (File::Spec->splitpath($self->{_file}))[1]; + croak "Unsignable package, parent directory is read-only" + unless -w $parent; + + my $sign = RPM4::Sign->new( + name => $name, + path => $path, + ); + $sign->{passphrase} = $passphrase; + + $sign->rpmssign($self->{_file}) +} + +sub extract { + my ($self) = @_; + croak "Not a class method" unless ref $self; + + system("rpm2cpio $self->{_file} | cpio -id >/dev/null 2>&1"); +} + +=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/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 new file mode 100644 index 0000000..419eeb3 --- /dev/null +++ b/lib/Youri/Package/URPM.pm @@ -0,0 +1,399 @@ +# $Id: URPM.pm 266577 2010-03-02 14:51:24Z bogdano $ +package Youri::Package::URPM; + +=head1 NAME + +Youri::Package::URPM - 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. + +=cut + +use strict; +use warnings; +use Carp; +use URPM; +use File::Spec; +use Expect; +use Scalar::Util qw/refaddr/; +use base 'Youri::Package::RPM'; +use overload + '""' => 'as_string', + '0+' => '_to_number', + fallback => 1; + +=head1 CLASS METHODS + +=head2 new(%args) + +Creates and returns a new Youri::Package::URPM object. + +Specific parameters: + +=over + +=item file $file + +Path of file to use for creating this package. + +=item header $header + +L<URPM::Package> object to use for creating this package. + +=back + +=cut + +sub _init { + my ($self, %options) = @_; + + my $header; + HEADER: { + if (exists $options{header}) { + croak "undefined header" + unless $options{header}; + croak "invalid header" + unless $options{header}->isa('URPM::Package'); + $header = $options{header}; + last HEADER; + } + + if (exists $options{file}) { + croak "undefined file" + unless $options{file}; + croak "non-existing file $options{file}" + unless -f $options{file}; + croak "non-readable file $options{file}" + unless -r $options{file}; + my $urpm = URPM->new(); + $urpm->parse_rpm($options{file}, keep_all_tags => 1); + $header = $urpm->{depslist}->[0]; + croak "non-rpm file $options{file}" unless $header; + last HEADER; + } + + croak "no way to extract header from arguments"; + } + + $self->{_header} = $header; + $self->{_file} = File::Spec->rel2abs($options{file}); +} + +sub compare_versions { + my ($class, $version1, $version2) = @_; + + return URPM::rpmvercmp($version1, $version2); +} + +sub check_ranges_compatibility { + my ($class, $range1, $range2) = @_; + + return URPM::ranges_overlap($range1, $range2); +} + +sub get_name { + my ($self) = @_; + croak "Not a class method" unless ref $self; + + return $self->{_header}->name(); +} + +sub get_version { + my ($self) = @_; + croak "Not a class method" unless ref $self; + + return $self->{_header}->version(); +} + +sub get_release { + my ($self) = @_; + croak "Not a class method" unless ref $self; + + return $self->{_header}->release(); +} + +sub get_revision { + my ($self) = @_; + croak "Not a class method" unless ref $self; + + return $self->{_header}->queryformat('%|EPOCH?{%{EPOCH}:}:{}|%{VERSION}-%{RELEASE}'); +} + +sub get_file_name { + my ($self) = @_; + croak "Not a class method" unless ref $self; + + return $self->{_file} || die "_file is not defined in header-only objects!\n"; +} + +sub get_arch { + my ($self) = @_; + croak "Not a class method" unless ref $self; + + return $self->{_header}->arch(); +} + +sub get_url { + my ($self) = @_; + croak "Not a class method" unless ref $self; + + return $self->{_header}->url(); +} + +sub get_summary { + my ($self) = @_; + croak "Not a class method" unless ref $self; + + return $self->{_header}->summary(); +} + +sub get_description { + my ($self) = @_; + croak "Not a class method" unless ref $self; + + return $self->{_header}->description(); +} + +sub get_packager { + my ($self) = @_; + croak "Not a class method" unless ref $self; + + return $self->{_header}->packager(); +} + +sub is_source { + my ($self) = @_; + croak "Not a class method" unless ref $self; + + return $self->{_header}->arch() eq 'src'; +} + +sub is_binary { + my ($self) = @_; + croak "Not a class method" unless ref $self; + + return $self->{_header}->arch() ne 'src'; +} + +sub get_type { + my ($self) = @_; + croak "Not a class method" unless ref $self; + + return + $self->{_header}->arch() eq 'src' ? + "source" : + "binary"; +} + +sub get_age { + my ($self) = @_; + croak "Not a class method" unless ref $self; + + return $self->{_header}->buildtime(); +} + +sub get_source_package { + my ($self) = @_; + croak "Not a class method" unless ref $self; + + return $self->{_header}->sourcerpm(); +} + +sub get_canonical_name { + my ($self) = @_; + croak "Not a class method" unless ref $self; + + if ($self->{_header}->arch() eq 'src') { + return $self->{_header}->name(); + } else { + $self->{_header}->sourcerpm() =~ /^(\S+)-[^-]+-[^-]+\.src\.rpm$/; + return $1; + } +} + +sub get_tag { + my ($self, $tag) = @_; + croak "Not a class method" unless ref $self; + croak "invalid tag $tag" unless $self->{_header}->can($tag); + return $self->{_header}->$tag(); +} + +sub get_requires { + my ($self) = @_; + + return map { + $_ =~ /^([^[]+)(?:\[\*\])?(?:\[(.+)\])?$/; + [ $1, $2 ] + } $self->{_header}->requires(); +} + +sub get_provides { + my ($self) = @_; + + return map { + $_ =~ /^([^[]+)(?:\[(.+)\])?$/; + [ $1, $2 && $2 ne '*' ? $2 : undef ] + } $self->{_header}->provides(); +} + +sub get_obsoletes { + my ($self) = @_; + + return map { + $_ =~ /^([^[]+)(?:\[(.+)\])?$/; + [ $1, $2 && $2 ne '*' ? $2 : undef ] + } $self->{_header}->obsoletes(); +} + +sub get_conflicts { + my ($self) = @_; + + return $self->{_header}->conflicts(); +} + +sub get_files { + my ($self) = @_; + + my @modes = $self->{_header}->files_mode(); + my @md5sums = $self->{_header}->files_md5sum(); + + return map { + [ $_, shift @modes, shift @md5sums ] + } $self->{_header}->files(); +} + +sub get_gpg_key { + my ($self) = @_; + + my $signature = $self->{_header}->queryformat('%{SIGGPG:pgpsig}'); + + return if $signature eq '(not a blob)'; + + my $key_id = (split(/\s+/, $signature))[-1]; + + return substr($key_id, 8); +} + +sub get_information { + my ($self) = @_; + + return $self->{_header}->queryformat(<<EOF); +Name : %-27{NAME} Relocations: %|PREFIXES?{[%{PREFIXES} ]}:{(not relocatable)}| +Version : %-27{VERSION} Vendor: %{VENDOR} +Release : %-27{RELEASE} Build Date: %{BUILDTIME:date} +Install Date: %|INSTALLTIME?{%-27{INSTALLTIME:date}}:{(not installed) }| Build Host: %{BUILDHOST} +Group : %-27{GROUP} Source RPM: %{SOURCERPM} +Size : %-27{SIZE}%|LICENSE?{ License: %{LICENSE}}| +Signature : %|DSAHEADER?{%{DSAHEADER:pgpsig}}:{%|RSAHEADER?{%{RSAHEADER:pgpsig}}:{%|SIGGPG?{%{SIGGPG:pgpsig}}:{%|SIGPGP?{%{SIGPGP:pgpsig}}:{(none)}|}|}|}| +%|PACKAGER?{Packager : %{PACKAGER}\n}|%|URL?{URL : %{URL}\n}|Summary : %{SUMMARY} +Description :\n%{DESCRIPTION} +EOF +} + +sub get_changes { + my ($self) = @_; + + my @names = $self->{_header}->changelog_name(); + my @time = $self->{_header}->changelog_time(); + my @text = $self->{_header}->changelog_text(); + + my @changes; + foreach my $i (0 .. $#names) { + $changes[$i] = [ + $names[$i], + $time[$i], + $text[$i], + ]; + } + + return @changes; +} + +sub get_last_change { + my ($self) = @_; + + return [ + ($self->{_header}->changelog_name())[0], + ($self->{_header}->changelog_time())[0], + ($self->{_header}->changelog_text())[0], + ]; +} + +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 { + return refaddr($_[0]); +} + +sub compare { + my ($self, $package) = @_; + croak "Not a class method" unless ref $self; + + return $self->{_header}->compare_pkg($package->{_header}); +} + +sub satisfy_range { + my ($self, $range) = @_; + croak "Not a class method" unless ref $self; + + return $self->check_ranges_compatibility("== " . $self->get_revision(), $range); +} + +sub sign { + my ($self, $name, $path, $passphrase, $target) = @_; + croak "Not a class method" unless ref $self; + + # check if parent directory is writable + my $parent = (File::Spec->splitpath($self->{_file}))[1]; + croak "Unsignable package, parent directory is read-only" + unless -w $parent; + + # FIXME Will have to change that + # we sign with cooker key even fro 2007.0 because this is for testing section + 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(20, -re => 'Enter pass phrase:'); + $expect->send("$passphrase\n"); + + $expect->soft_close(); +} + +sub extract { + my ($self) = @_; + croak "Not a class method" unless ref $self; + + system("rpm2cpio $self->{_file} | cpio -id >/dev/null 2>&1"); +} + +=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; |