—

              
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__
HideShow 204 lines of Pod
=head1 NAME
WWW::AUR::Package::File - Load, extract, and build a source package file
=head1 SYNOPSIS
  use WWW::AUR::Package::File;
  my $fileobj = WWW::AUR::Package::File->new( 'package.src.tar.gz' );
  $fileobj->extract();
  $fileobj->build();
  my $pbobj    = $fileobj->pkgbuild
  my %pbfields = $pbobj->fields();
  print "Package file path  : %s\n", $fileobj->src_pkg_path;
  print "Extracted dir      : %s\n", $fileobj->src_dir_path;
  print "Built package path : %s\n", $fileobj->bin_pkg_path;
=head1 CONSTRUCTOR
  $OBJ = WWW::AUR::Package::File->new( $PATH, %PATH_PARAMS? );
=over 4
=item C<$PATH>
The path to a source package file. These typically end with the
.src.tar.gz suffix.
=item C<%PATH_PARAMS> B<(Optional)>
Optional path parameters. See L<WWW::AUR/PATH PARAMETERS>.
=back
=head1 METHODS
=head2 extract
  $SRCPKGDIR = $OBJ->extract;
=over 4
=item C<$SRCPKGDIR>
The absolute path to the directory where the source package was
extracted. (This is the directory that is contained in the source
package file, extracted)
=back
=head2 build
  $BINPKGDIR = $OBJ->build( %BUILD_PARAMS? );
Builds the AUR package, using the makepkg utility.
=over 4
=item C<%BUILD_PARAMS> B<(Optional)>
Path parameters can be mixed with build parameters. Several build
parameters can be used to provide arguments to makepkg. Build
parameter keys:
=over 4
=item B<pkgdest>
Overrides where to store the built binary package file.
=item B<quiet>
If set to a true value the makepkg output is redirected to I</dev/null>.
=item B<prefix>
A string to prefix before the makepkg command.
=item B<args>
A string to append to the makepkg command as arguments.
=back
=item C<$BINPKGDIR>
The absolute path to the binary package that was created by running
makepkg.
=item B<Errors>
=over 4
=item * I<makepkg failed to run: signal %d.>
=item * I<makepkg failed to run: error code %d.>
=item * I<makepkg succeeded but the package file is missing.>
=back
=back
=head2 pkgbuild
  $PKGBUILD_OBJ = $OBJ->pkgbuild;
Create an object representing the PKGBUILD file of a source package.
A PKGBUILD is the main component of a source package. If the
source package archive has not been extracted yet, L</extract>
will be called automatically.
=over 4
=item C<$PKGBUILD_OBJ>
A L<WWW::AUR::PKGBUILD> object representing the PKGBUILD in the
extracted source package directory.
=back
=head2 src_pkg_path
  undef | $PATH = $OBJ->src_pkg_path;
If L</download> has been called, then the path of the downloaded source
package file is returned. Otherwise C<undef> is returned.
=head2 src_dir_path
  undef | $PATH = $OBJ->src_dir_path;
If L</extract> has been called, then the path of the extract source
package dir is returned. Otherwise C<undef> is returned.
=head2 bin_pkg_path
  undef | $PATH = $OBJ->bin_pkg_path;
If L</build> has been called, then the path of the built binary package
is returned. Otherwise C<undef> is returned.
=head2 make_src_path
  $PATH = $OBJ->make_src_path( $RELPATH )
Helper function to easily lookup the absolute path to a file inside
the source directory. This just builds the path it does not guarantee
the file exists!
=over 4
=item C<$RELPATH>
The relative path to a file I<inside> the extracted source
directory. This is allowed to have a leading forward-slash.
=item C<$PATH>
The absolute path to the file inside the source directory.
=back
=head3 Errors
=over 4
=item I<You must call extract() before make_src_path()>
=back
=head1 SEE ALSO
=over 4
=item * L<WWW::AUR::Package>
=item * L<WWW::AUR::PKGBUILD>
=item * L<http://www.archlinux.org/pacman/makepkg.8.html>
=back
=head1 AUTHOR
Justin Davis, C<< <juster at cpan dot org> >>
=head1 BUGS
Please email me any bugs you find. I will try to fix them as quick as I can.
=head1 SUPPORT
Send me an email if you have any questions or need help.
=head1 LICENSE AND COPYRIGHT
Copyright 2012 Justin Davis.
This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.
See http://dev.perl.org/licenses/ for more information.