# $Id: URPM.pm 2370 2013-01-03 19:26:49Z guillomovitch $
package Youri::Package::RPM::URPM;

=head1 NAME

Youri::Package::RPM::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 base 'Youri::Package::RPM';
use overload
    '""'     => 'as_string',
    '0+'     => '_to_number',
    fallback => 1;

use Carp;
use English qw(-no_match_vars);
use Expect;
use File::Spec;
use Scalar::Util qw/refaddr blessed/;
use URPM;

use Youri::Package::Change;
use Youri::Package::File;
use Youri::Package::Relationship;

=head1 CLASS METHODS

=head2 new(%args)

Creates and returns a new Youri::Package::RPM::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_revisions {
    my ($class, $revision1, $revision2) = @_;

    return URPM::rpmvercmp($revision1, $revision2);
}

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->{_header}->filename();
}

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

    if ($self->{_header}->arch() eq 'src') {
       return $self->{_header}->get_revision();
    } 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) = @_;
    croak "Not a class method" unless ref $self;

    my $pattern = qr/^([^[]+)(?:\[\*\])?(?:\[(.+)\])?$/;

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

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

    my $pattern = qr/^([^[]+)(?:\[(.+)\])?$/;

    return map {
        $_ =~ /$pattern/;
        Youri::Package::Relationship->new($1, $2 && $2 ne '*' ?  $2 : undef)
    } $self->{_header}->provides();
}

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

    my $pattern = qr/^([^[]+)(?:\[(.+)\])?$/;

    return map {
        $_ =~ $pattern;
        Youri::Package::Relationship->new($1, $2 && $2 ne '*' ?  $2 : undef)
    } $self->{_header}->obsoletes();
}

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

    my $pattern = qr/^([^[]+)(?:\[(.+)\])?$/;

    return map {
        $_ =~ $pattern;
        Youri::Package::Relationship->new($1, $2 && $2 ne '*' ?  $2 : undef)
    } 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;