view release on metacpan or  search on metacpan

lib/Youri/Package/RPM/URPM.pm  view on Meta::CPAN

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) = @_;
    croak "Not a class method" unless ref $self;

    return map {
        $_ =~ $relationship_pattern;
        Youri::Package::Relationship->new($1, $2)
    } $self->{_header}->requires();
}

sub get_provides {
    my ($self) = @_;
    croak "Not a class method" unless ref $self;

    return map {
        $_ =~ $relationship_pattern;
        Youri::Package::Relationship->new($1, $2)
    } $self->{_header}->provides();
}

sub get_obsoletes {
    my ($self) = @_;
    croak "Not a class method" unless ref $self;

    return map {
        $_ =~ $relationship_pattern;
        Youri::Package::Relationship->new($1, $2)
    } $self->{_header}->obsoletes();
}

sub get_conflicts {
    my ($self) = @_;
    croak "Not a class method" unless ref $self;

    return map {
        $_ =~ $relationship_pattern;
        Youri::Package::Relationship->new($1, $2)
    } return $self->{_header}->conflicts();
}

sub get_files {
    my ($self) = @_;
    croak "Not a class method" unless ref $self;

    my @modes   = $self->{_header}->files_mode();
    my @md5sums = $self->{_header}->files_md5sum();

    return map {
        Youri::Package::File->new($_, shift @modes, shift @md5sums)
    } $self->{_header}->files();
}

sub get_gpg_key {
    my ($self) = @_;
    croak "Not a class method" unless ref $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_changes {
    my ($self) = @_;
    croak "Not a class method" unless ref $self;

    my @times = $self->{_header}->changelog_time();
    my @texts = $self->{_header}->changelog_text();

    return map {
        Youri::Package::Change->new($_, shift @times, shift @texts)
    } $self->{_header}->changelog_name();
}

sub get_last_change {
    my ($self) = @_;
    croak "Not a class method" unless ref $self;

    my $text = ($self->{_header}->changelog_text())[0];
    my $name = ($self->{_header}->changelog_name())[0];
    my $time = ($self->{_header}->changelog_time())[0];

    return $text ?
        Youri::Package::Change->new($name, $time, $text) :
        undef;
}

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;
    croak "Not a __PACKAGE__ object" unless
        blessed $package && $package->isa(__PACKAGE__);

    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) = @_;
    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 $command =
        'LC_ALL=C rpm --resign ' . $self->{_file} .
        ' --define "_signature gpg"' .
        ' --define "_gpg_name ' . $name . '"' .
        ' --define "_gpg_path ' . $path . '"';
    my $expect = Expect->spawn($command)
        or croak "Couldn't spawn command $command: $ERRNO\n";
    my @log;
    $expect->log_stdout(0);
    $expect->log_file(sub { push(@log, $_[0]); });
    $expect->expect(10, 'Enter pass phrase:')
        or croak "Unexpected output: $log[-1]\n";
    $expect->send("$passphrase\n");

    $expect->soft_close();

    croak "Signature error: " . $log[-1] if $expect->exitstatus();
}

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;