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__ =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.