File Coverage

blib/lib/OS/Package/Plugin/Solaris/SVR4.pm
Criterion Covered Total %
statement 19 21 90.4
branch n/a
condition n/a
subroutine 7 7 100.0
pod n/a
total 26 28 92.8


line stmt bran cond sub pod time code
1 1     1   1231 use v5.14.0;
  1         2  
  1         30  
2 1     1   4 use warnings;
  1         0  
  1         63  
3              
4             package OS::Package::Plugin::Solaris::SVR4;
5              
6             # ABSTRACT: Solaris 10 package plugin.
7             our $VERSION = '0.2.5'; # VERSION
8              
9 1     1   8 use Cwd;
  1         1  
  1         48  
10 1     1   3 use Moo;
  1         6  
  1         4  
11 1     1   176 use Env qw( $HOME );
  1         1  
  1         4  
12 1     1   648 use Time::Piece;
  1         7190  
  1         3  
13 1     1   217 use Types::Standard qw( Str );
  0            
  0            
14             use Template;
15             use Path::Tiny;
16             use File::ShareDir qw(dist_file);
17             use File::Basename qw( basename dirname );
18             use OS::Package::Config qw($OSPKG_CONFIG);
19             use OS::Package::Log;
20             use IPC::Cmd qw( can_run run );
21              
22             extends 'OS::Package';
23              
24             has user => (
25             is => 'rw',
26             isa => Str,
27             required => 1,
28             default => sub { $OSPKG_CONFIG->{package}{user} }
29             );
30              
31             has group => (
32             is => 'rw',
33             isa => Str,
34             required => 1,
35             default => sub { $OSPKG_CONFIG->{package}{group} }
36             );
37              
38             has category => (
39             is => 'rw',
40             isa => Str,
41             required => 1,
42             default => sub { $OSPKG_CONFIG->{package}{category} }
43             );
44              
45             has pstamp => (
46             is => 'rw',
47             isa => Str,
48             default => sub { my $t = localtime; return $t->datetime; }
49             );
50              
51             has pkgfile => (
52             is => 'rw',
53             isa => Str,
54             required => 1,
55             default => sub {
56             my $self = shift;
57             my $system = OS::Package::System->new;
58              
59             my $version =
60             $self->build_id
61             ? sprintf( '%s-b%s', $self->application->version,
62             $self->build_id )
63             : $self->application->version;
64              
65             return sprintf( '%s-%s-%s-%s.pkg',
66             $self->name, $version,
67             $system->os, $system->type );
68             }
69             );
70              
71             sub _generate_pkginfo {
72             my $self = shift;
73              
74             $LOGGER->info('generating: pkginfo');
75              
76             my $template =
77             dist_file( 'OS-Package', 'plugin/Solaris/SVR4/pkginfo.tt2' );
78              
79             my $ttcfg = { INCLUDE_PATH => dirname($template) };
80              
81             my $tt = Template->new($ttcfg);
82              
83             my $pkginfo = sprintf '%s/%s/pkginfo', path( $self->fakeroot ),
84             $self->prefix;
85              
86             my $version =
87             $self->build_id
88             ? sprintf '%s-b%s', $self->application->version, $self->build_id
89             : $self->application->version;
90              
91             $tt->process(
92             basename($template),
93             { pkgname => $self->name,
94             name => $self->application->name,
95             description => $self->description,
96             arch => $self->system->type,
97             version => $version,
98             category => $self->category,
99             vendor => $self->maintainer->by_line,
100             pstamp => $self->pstamp,
101             basedir => $self->prefix,
102             },
103             $pkginfo
104             ) or $LOGGER->logdie( $tt->error );
105              
106             return 1;
107             }
108              
109             sub _generate_prototype {
110             my $self = shift;
111              
112             $LOGGER->info('generating: prototype');
113              
114             my $pkg_path = sprintf '%s/%s', path( $self->fakeroot ), $self->prefix;
115              
116             chdir path($pkg_path);
117              
118             my $command = [ can_run('pkgproto'), '.' ];
119              
120             my ( $success, $error_message, $full_buf, $stdout_buf, $stderr_buf ) =
121             run( command => $command );
122              
123             foreach ( @{$full_buf} ) {
124             $LOGGER->debug($_);
125             }
126              
127             if ( !$success ) {
128             $LOGGER->error( sprintf "pkgproto failed: %s\n", $error_message );
129              
130             return 2;
131             }
132              
133             my @prototype = ("i pkginfo\n");
134              
135             my @lines = split "\n", join( q{}, @{$stdout_buf} );
136              
137             foreach my $line (@lines) {
138             my ( $file_type, $class, $pathname, $mode, $owner, $group ) =
139             split q{ }, $line;
140              
141             next if ( $pathname =~ qr{pkginfo|prototype}xms );
142              
143             if ( defined $mode ) {
144             push @prototype,
145             sprintf( "%s %s %s %s %s %s\n",
146             $file_type, $class, $pathname, $mode, $self->user,
147             $self->group );
148             }
149             else {
150             push @prototype,
151             sprintf( "%s %s %s\n", $file_type, $class, $pathname );
152             }
153             }
154              
155             path( sprintf( '%s/prototype', $pkg_path ) )->spew( \@prototype );
156              
157             chdir $HOME;
158              
159             return 1;
160             }
161              
162             sub _generate_package {
163             my $self = shift;
164              
165             $LOGGER->info( sprintf 'generating package: %s', $self->name );
166              
167             my $pkg_path = sprintf '%s/%s', path( $self->fakeroot ), $self->prefix;
168              
169             chdir path($pkg_path);
170              
171             if (-d sprintf( '%s/%s', path( $OSPKG_CONFIG->dir->packages ),
172             $self->name ) )
173             {
174             $LOGGER->debug('removing existing package spool directory');
175             my $spool_dir = sprintf( '%s/%s',
176             path( $OSPKG_CONFIG->dir->packages ),
177             $self->name );
178             path($spool_dir)->remove_tree( { safe => 0 } );
179             }
180              
181             if (-f sprintf( '%s/%s',
182             path( $OSPKG_CONFIG->dir->packages ),
183             $self->pkgfile )
184             )
185             {
186             $LOGGER->debug('removing existing package file from spool directory');
187             my $pkg_file = sprintf( '%s/%s',
188             path( $OSPKG_CONFIG->dir->packages ),
189             $self->pkgfile );
190             path($pkg_file)->remove;
191             }
192              
193             my $command = [
194             can_run('pkgmk'), '-o', '-r', cwd, '-d',
195             path( $OSPKG_CONFIG->dir->packages )
196             ];
197              
198             my ( $success, $error_message, $full_buf, $stdout_buf, $stderr_buf ) =
199             run( command => $command );
200              
201             foreach ( @{$full_buf} ) {
202             $LOGGER->debug($_);
203             }
204              
205             if ( !$success ) {
206             $LOGGER->error( sprintf "pkgproto failed: %s\n", $error_message );
207              
208             return 2;
209             }
210              
211             $command = [
212             can_run('pkgtrans'), '-s',
213             path( $OSPKG_CONFIG->dir->packages ), $self->pkgfile,
214             $self->name
215             ];
216              
217             ( $success, $error_message, $full_buf, $stdout_buf, $stderr_buf ) =
218             run( command => $command );
219              
220             foreach ( @{$full_buf} ) {
221             $LOGGER->debug($_);
222             }
223              
224             if ( !$success ) {
225             $LOGGER->error( sprintf "pkgtrans failed: %s\n", $error_message );
226              
227             return 2;
228             }
229              
230             if (-d sprintf( '%s/%s', path( $OSPKG_CONFIG->dir->packages ),
231             $self->name ) )
232             {
233             $LOGGER->debug('removing existing package spool directory');
234             my $spool_dir = sprintf( '%s/%s',
235             path( $OSPKG_CONFIG->dir->packages ),
236             $self->name );
237             path($spool_dir)->remove_tree( { safe => 0 } );
238             }
239              
240             chdir $HOME;
241              
242             $LOGGER->info(
243             sprintf 'created package: %s/%s',
244             path( $OSPKG_CONFIG->dir->packages ),
245             $self->pkgfile
246             );
247              
248             return 1;
249             }
250              
251             sub create {
252             my $self = shift;
253              
254             $LOGGER->info('generating: Solaris SVR4 package');
255              
256             $self->_generate_pkginfo;
257              
258             $self->_generate_prototype;
259              
260             $self->_generate_package;
261              
262             return 1;
263             }
264              
265             1;
266              
267             __END__