File Coverage

lib/CPANPLUS/Dist/Autobundle.pm
Criterion Covered Total %
statement 46 50 92.0
branch 5 10 50.0
condition 1 3 33.3
subroutine 10 11 90.9
pod 4 4 100.0
total 66 78 84.6


line stmt bran cond sub pod time code
1             package CPANPLUS::Dist::Autobundle;
2              
3 4     4   7535 use strict;
  4         13  
  4         153  
4 4     4   36 use warnings;
  4         13  
  4         414  
5 4     4   29 use CPANPLUS::Error qw[error msg];
  4         9  
  4         299  
6 4     4   30 use Params::Check qw[check];
  4         8  
  4         273  
7 4     4   30 use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';
  4         8  
  4         76  
8 4     4   1416 use vars qw[$VERSION];
  4         18  
  4         225  
9             $VERSION = "0.9912";
10              
11 4     4   30 use base qw[CPANPLUS::Dist::Base];
  4         14  
  4         2714  
12              
13             =head1 NAME
14              
15             CPANPLUS::Dist::Autobundle - distribution class for installation snapshots
16              
17             =head1 SYNOPSIS
18              
19             $modobj = $cb->parse_module( module => 'file://path/to/Snapshot_XXYY.pm' );
20             $modobj->install;
21              
22             =head1 DESCRIPTION
23              
24             C<CPANPLUS::Dist::Autobundle> is a distribution class for installing installation
25             snapshots as created by C<CPANPLUS>' C<autobundle> command.
26              
27             All modules as mentioned in the snapshot will be installed on your system.
28              
29             =cut
30              
31             sub init {
32 1     1 1 2 my $dist = shift;
33 1         6 my $status = $dist->status;
34              
35 1         143 $status->mk_accessors(
36             qw[prepared created installed _prepare_args _create_args _install_args _metadata]
37             );
38              
39 1         62 return 1;
40             }
41              
42             sub prepare {
43 1     1 1 2 my $dist = shift;
44 1         5 my %args = @_;
45              
46             ### store the arguments, so ->install can use them in recursive loops ###
47 1         6 $dist->status->_prepare_args( \%args );
48              
49 1         183 return $dist->status->prepared( 1 );
50             }
51              
52             sub create {
53 1     1 1 3 my $dist = shift;
54 1         6 my $self = $dist->parent;
55              
56             ### we're also the cpan_dist, since we don't need to have anything
57             ### prepared
58 1 50       98 $dist = $self->status->dist_cpan if $self->status->dist_cpan;
59 1 50       69 $self->status->dist_cpan( $dist ) unless $self->status->dist_cpan;
60              
61 1         72 my $cb = $self->parent;
62 1         4 my $conf = $cb->configure_object;
63 1         11 my %hash = @_;
64              
65 1         3 my( $force, $verbose, $prereq_target, $prereq_format, $prereq_build);
66              
67 1         2 my $args = do {
68 1         2 local $Params::Check::ALLOW_UNKNOWN = 1;
69 1         6 my $tmpl = {
70             force => { default => $conf->get_conf('force'),
71             store => \$force },
72             verbose => { default => $conf->get_conf('verbose'),
73             store => \$verbose },
74             prereq_target => { default => '', store => \$prereq_target },
75              
76             ### don't set the default prereq format to 'makemaker' -- wrong!
77             prereq_format => { #default => $self->status->installer_type,
78             default => '',
79             store => \$prereq_format },
80             prereq_build => { default => 0, store => \$prereq_build },
81             };
82              
83 1 50       13 check( $tmpl, \%hash ) or return;
84             };
85              
86             ### maybe we already ran a create on this object? ###
87 1 50 33     192 return 1 if $dist->status->created && !$force;
88              
89             ### store the arguments, so ->install can use them in recursive loops ###
90 1         211 $dist->status->_create_args( \%hash );
91              
92 1         181 msg(loc("Resolving prerequisites mentioned in the bundle"), $verbose);
93              
94             ### this will set the directory back to the start
95             ### dir, so we must chdir /again/
96 1         13 my $ok = $dist->_resolve_prereqs(
97             format => $prereq_format,
98             verbose => $verbose,
99             prereqs => $self->status->prereqs,
100             target => $prereq_target,
101             force => $force,
102             prereq_build => $prereq_build,
103             );
104              
105             ### if all went well, mark it & return
106 1 50       21 return $dist->status->created( $ok ? 1 : 0);
107             }
108              
109             sub install {
110 0     0 1   my $dist = shift;
111 0           my %args = @_;
112              
113             ### store the arguments, so ->install can use them in recursive loops ###
114 0           $dist->status->_install_args( \%args );
115              
116 0           return $dist->status->installed( 1 );
117             }
118              
119             1;