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