aboutsummaryrefslogtreecommitdiffstats
path: root/lib/Youri/Package/URPM.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Youri/Package/URPM.pm')
-rw-r--r--lib/Youri/Package/URPM.pm399
1 files changed, 399 insertions, 0 deletions
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;
generated by cgit v1.2.1 (git 2.21.0) at 2024-05-02 01:01:39 +0000