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