File Coverage

blib/lib/WWW/AUR/Package/File.pm

Criterion	Covered	Total	%
statement	72	111	64.8
branch	11	42	26.1
condition	0	3	0.0
subroutine	17	20	85.0
pod	7	9	77.7
total	107	185	57.8

package WWW::AUR::Package::File;

use warnings 'FATAL' => 'all';
use strict;

use File::Basename qw(basename);
use Archive::Tar   qw();
use File::Spec     qw();
use File::Path     qw(make_path);
use Carp           qw();
use Cwd            qw(getcwd);

use WWW::AUR::PKGBUILD qw();
use WWW::AUR           qw(_path_params);

sub new
{
    my $class  = shift;
    my ($path) = @_;

    Carp::croak "$path does not exist or is not readable"
        unless -r $path;

    bless { 'srcpkg_path' => $path,
            _path_params( @_ ) }, $class;
}

#---PUBLIC METHOD---
sub pkgbuild
{
    my ($self) = @_;

    return $self->{pkgbuild}
        if $self->{pkgbuild};

    $self->extract() unless $self->src_dir_path();

    my $pbpath = $self->make_src_path( 'PKGBUILD' );
    open my $pbfile, '<', $pbpath or die "open: $!";
    my $pbtext = do { local $/; <$pbfile> };
    close $pbfile;

    $self->{pkgbuild} = WWW::AUR::PKGBUILD->new( $pbtext );
    return $self->{pkgbuild}
}

#---PUBLIC METHOD---
sub name
{
    my ($self) = @_;

    # Only use the PKGBUILD if it is extracted already...
    return $self->pkgbuild->pkgname if $self->{'pkgbuild'};

    # Otherwise parse the filename of the source package.
    my $name = basename( $self->src_pkg_path(), '.src.tar.gz' )
        or die 'Failed to extract package name from filename: '
            . $self->src_pkg_path;

    return $name;
}

#---OBJECT METHOD---
sub extract
{
    my ($self) = @_;

    my $pkgpath = $self->src_pkg_path();
    my $destdir = $self->{extpath};

    make_path( $destdir );
    my $olddir = getcwd();

    eval {
        my $tarball = Archive::Tar->new( $pkgpath )
            or die 'Failed to create Archive::Tar object';

        chdir $destdir or Carp::confess "Failed to chdir to $destdir";

        $tarball->extract()
            or Carp::croak "Failed to extract source package file\nerror:"
                . $tarball->error;
    };

    # ALWAYS chdir back...
    { local $@; chdir $olddir; }

    # Propogates an error if one exists...
    die if $@;

    my $srcpkg_dir = File::Spec->catdir( $destdir, $self->name );
    return $self->{srcpkg_dir} = $srcpkg_dir;
}

#---PUBLIC METHOD---
sub src_pkg_path
{
    my ($self) = @_;
    return $self->{srcpkg_path};
}

#---PUBLIC METHOD---
sub src_dir_path
{
    my ($self) = @_;
    return $self->{srcpkg_dir};
}

#---PUBLIC METHOD---
sub make_src_path
{
    my ($self, $relpath) = @_;

    Carp::croak 'You must call extract() before make_src_path()'
        unless $self->src_dir_path;

    $relpath =~ s{\A/+}{};
    return File::Spec->catfile( $self->src_dir_path,
                                $relpath );
}

#---PRIVATE METHOD---
sub _builtpkg_path
{
    my ($self, $pkgdest) = @_;
    my $pkgbuild = $self->pkgbuild;
    my $arch     = $pkgbuild->arch;

    if ( eval { $arch->[0] eq 'any' } ) {
        $arch = 'any';
    }

    unless ( $arch eq 'any' ) {
        chomp ( $arch = `uname -m` );
    }

    my $pkgfile = sprintf '%s-%s-%d-%s.pkg.tar',
        $pkgbuild->pkgname, $pkgbuild->pkgver, $pkgbuild->pkgrel, $arch;

    ($pkgfile) = ( grep { -f $_ }
                   map { File::Spec->catfile( $pkgdest, $_ ) }
                   glob( $pkgfile . '{,.xz,.gz}' ));

    return $pkgfile
}

#---PUBLIC METHOD---
sub build
{
    my ($self, %params) = @_;

    return $self->bin_pkg_path()
        if $self->bin_pkg_path();

    my $srcdir  = $self->src_dir_path || $self->extract();
    my $pkgdest = $params{ pkgdest };
    if ( $pkgdest ) { $pkgdest =~ s{/+\z}{};        }
    else            { $pkgdest = $self->{destpath}; }
    $pkgdest = File::Spec->rel2abs( $pkgdest );

    make_path( $pkgdest );
    my $oldcwd = getcwd();
    chdir $srcdir;

    my $cmd = 'makepkg -f';
    $cmd = "$params{prefix} $cmd" if $params{prefix};
    $cmd = "$cmd $params{args}"   if $params{args};

    if ( $params{quiet} ) { $cmd .= ' 2>&1 >/dev/null'; }

    local $ENV{PKGDEST} = $pkgdest;
    system $cmd;
    unless ( $? == 0 ) {
        my $errmsg = sprintf "makepkg failed to run: %s.\nError",
            ( $? & 127
              ? sprintf 'signal %d',     $?  & 127
              : sprintf 'error code %d', $? >> 8 );
        die $errmsg;
    }

    chdir $oldcwd;

    my $built_path = $self->_builtpkg_path( $pkgdest )
        or die "makepkg succeeded but the package file is missing.\nError";
    return $self->{builtpkg_path} = $built_path;
}

#---PUBLIC METHOD---
sub bin_pkg_path
{
    my ($self) = @_;
    return $self->{builtpkg_path};
}

1;

__END__