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


line stmt bran cond sub pod time code
1             package WWW::AUR::Package::File;
2              
3 7     7   31 use warnings 'FATAL' => 'all';
  7         17  
  7         290  
4 7     7   36 use strict;
  7         10  
  7         236  
5              
6 7     7   35 use File::Basename qw(basename);
  7         11  
  7         351  
7 7     7   5623 use Archive::Tar qw();
  7         662693  
  7         289  
8 7     7   68 use File::Spec qw();
  7         13  
  7         131  
9 7     7   65 use File::Path qw(make_path);
  7         9  
  7         515  
10 7     7   38 use Carp qw();
  7         15  
  7         114  
11 7     7   27 use Cwd qw(getcwd);
  7         12  
  7         251  
12              
13 7     7   3279 use WWW::AUR::PKGBUILD qw();
  7         18  
  7         177  
14 7     7   1534 use WWW::AUR qw(_path_params);
  7         22  
  7         6763  
15              
16             sub new
17             {
18 4     4 0 11 my $class = shift;
19 4         11 my ($path) = @_;
20              
21 4 50       202 Carp::croak "$path does not exist or is not readable"
22             unless -r $path;
23              
24 4         25 bless { 'srcpkg_path' => $path,
25             _path_params( @_ ) }, $class;
26             }
27              
28             #---PUBLIC METHOD---
29             sub pkgbuild
30             {
31 1     1 1 2 my ($self) = @_;
32              
33 1 50       8 return $self->{pkgbuild}
34             if $self->{pkgbuild};
35              
36 1 50       5 $self->extract() unless $self->src_dir_path();
37            
38 1         22 my $pbpath = $self->make_src_path( 'PKGBUILD' );
39 1 50       44 open my $pbfile, '<', $pbpath or die "open: $!";
40 1         3 my $pbtext = do { local $/; <$pbfile> };
  1         5  
  1         17  
41 1         8 close $pbfile;
42              
43 1         12 $self->{pkgbuild} = WWW::AUR::PKGBUILD->new( $pbtext );
44 1         7 return $self->{pkgbuild}
45             }
46              
47             #---PUBLIC METHOD---
48             sub name
49             {
50 2     2 0 9 my ($self) = @_;
51              
52             # Only use the PKGBUILD if it is extracted already...
53 2 50       17 return $self->pkgbuild->pkgname if $self->{'pkgbuild'};
54              
55             # Otherwise parse the filename of the source package.
56 2 50       13 my $name = basename( $self->src_pkg_path(), '.src.tar.gz' )
57             or die 'Failed to extract package name from filename: '
58             . $self->src_pkg_path;
59              
60 2         34 return $name;
61             }
62              
63             #---OBJECT METHOD---
64             sub extract
65             {
66 2     2 1 4 my ($self) = @_;
67              
68 2         10 my $pkgpath = $self->src_pkg_path();
69 2         5 my $destdir = $self->{extpath};
70              
71 2         126 make_path( $destdir );
72 2         13 my $olddir = getcwd();
73              
74 2         4 eval {
75 2 50       21 my $tarball = Archive::Tar->new( $pkgpath )
76             or die 'Failed to create Archive::Tar object';
77              
78 2 50       13365 chdir $destdir or Carp::confess "Failed to chdir to $destdir";
79              
80 2 50       102 $tarball->extract()
81             or Carp::croak "Failed to extract source package file\nerror:"
82             . $tarball->error;
83             };
84              
85             # ALWAYS chdir back...
86 2         12347 { local $@; chdir $olddir; }
  2         11  
  2         30  
87              
88             # Propogates an error if one exists...
89 2 50       18 die if $@;
90              
91 2         22 my $srcpkg_dir = File::Spec->catdir( $destdir, $self->name );
92 2         25 return $self->{srcpkg_dir} = $srcpkg_dir;
93             }
94              
95             #---PUBLIC METHOD---
96             sub src_pkg_path
97             {
98 4     4 1 9 my ($self) = @_;
99 4         286 return $self->{srcpkg_path};
100             }
101              
102             #---PUBLIC METHOD---
103             sub src_dir_path
104             {
105 4     4 1 12 my ($self) = @_;
106 4         50 return $self->{srcpkg_dir};
107             }
108              
109             #---PUBLIC METHOD---
110             sub make_src_path
111             {
112 1     1 1 4 my ($self, $relpath) = @_;
113              
114 1 50       2 Carp::croak 'You must call extract() before make_src_path()'
115             unless $self->src_dir_path;
116              
117 1         5 $relpath =~ s{\A/+}{};
118 1         3 return File::Spec->catfile( $self->src_dir_path,
119             $relpath );
120             }
121              
122             #---PRIVATE METHOD---
123             sub _builtpkg_path
124             {
125 0     0     my ($self, $pkgdest) = @_;
126 0           my $pkgbuild = $self->pkgbuild;
127 0           my $arch = $pkgbuild->arch;
128              
129 0 0         if ( eval { $arch->[0] eq 'any' } ) {
  0            
130 0           $arch = 'any';
131             }
132              
133 0 0         unless ( $arch eq 'any' ) {
134 0           chomp ( $arch = `uname -m` );
135             }
136              
137 0           my $pkgfile = sprintf '%s-%s-%d-%s.pkg.tar',
138             $pkgbuild->pkgname, $pkgbuild->pkgver, $pkgbuild->pkgrel, $arch;
139              
140 0           ($pkgfile) = ( grep { -f $_ }
  0            
141 0           map { File::Spec->catfile( $pkgdest, $_ ) }
142             glob( $pkgfile . '{,.xz,.gz}' ));
143              
144 0           return $pkgfile
145             }
146              
147             #---PUBLIC METHOD---
148             sub build
149             {
150 0     0 1   my ($self, %params) = @_;
151              
152 0 0         return $self->bin_pkg_path()
153             if $self->bin_pkg_path();
154              
155 0   0       my $srcdir = $self->src_dir_path || $self->extract();
156 0           my $pkgdest = $params{ pkgdest };
157 0 0         if ( $pkgdest ) { $pkgdest =~ s{/+\z}{}; }
  0            
158 0           else { $pkgdest = $self->{destpath}; }
159 0           $pkgdest = File::Spec->rel2abs( $pkgdest );
160              
161 0           make_path( $pkgdest );
162 0           my $oldcwd = getcwd();
163 0           chdir $srcdir;
164              
165 0           my $cmd = 'makepkg -f';
166 0 0         $cmd = "$params{prefix} $cmd" if $params{prefix};
167 0 0         $cmd = "$cmd $params{args}" if $params{args};
168              
169 0 0         if ( $params{quiet} ) { $cmd .= ' 2>&1 >/dev/null'; }
  0            
170              
171 0           local $ENV{PKGDEST} = $pkgdest;
172 0           system $cmd;
173 0 0         unless ( $? == 0 ) {
174 0 0         my $errmsg = sprintf "makepkg failed to run: %s.\nError",
175             ( $? & 127
176             ? sprintf 'signal %d', $? & 127
177             : sprintf 'error code %d', $? >> 8 );
178 0           die $errmsg;
179             }
180              
181 0           chdir $oldcwd;
182              
183 0 0         my $built_path = $self->_builtpkg_path( $pkgdest )
184             or die "makepkg succeeded but the package file is missing.\nError";
185 0           return $self->{builtpkg_path} = $built_path;
186             }
187              
188             #---PUBLIC METHOD---
189             sub bin_pkg_path
190             {
191 0     0 1   my ($self) = @_;
192 0           return $self->{builtpkg_path};
193             }
194              
195             1;
196              
197             __END__