1#line 1
2##
3# name:      Module::Install::Package
4# abstract:  Module::Install support for Module::Package
5# author:    Ingy döt Net <ingy@cpan.org>
6# license:   perl
7# copyright: 2011
8# see:
9# - Module::Package
10
11# This module contains the Module::Package logic that must be available to
12# both the Author and the End User. Author-only logic goes in a
13# Module::Package::Plugin subclass.
14package Module::Install::Package;
15use strict;
16use Module::Install::Base;
17use vars qw'@ISA $VERSION';
18@ISA = 'Module::Install::Base';
19$VERSION = '0.30';
20
21#-----------------------------------------------------------------------------#
22# XXX BOOTBUGHACK
23# This is here to try to get us out of Module-Package-0.11 cpantesters hell...
24# Remove this when the situation has blown over.
25sub pkg {
26    *inc::Module::Package::VERSION = sub { $VERSION };
27    my $self = shift;
28    $self->module_package_internals_init($@);
29}
30
31#-----------------------------------------------------------------------------#
32# We allow the author to specify key/value options after the plugin. These
33# options need to be available both at author time and install time.
34#-----------------------------------------------------------------------------#
35# OO accessor for command line options:
36sub package_options {
37    @_>1?($_[0]->{package_options}=$_[1]):$_[0]->{package_options}}
38
39my $default_options = {
40    deps_list => 1,
41    install_bin => 1,
42    install_share => 1,
43    manifest_skip => 1,
44    requires_from => 1,
45};
46
47#-----------------------------------------------------------------------------#
48# Module::Install plugin directives. Use long, ugly names to not pollute the
49# Module::Install plugin namespace. These are only intended to be called from
50# Module::Package.
51#-----------------------------------------------------------------------------#
52
53# Module::Package starts off life as a normal call to this Module::Install
54# plugin directive:
55my $module_install_plugin;
56my $module_package_plugin;
57my $module_package_dist_plugin;
58# XXX ARGVHACK This @argv thing is a temporary fix for an ugly bug somewhere in the
59# Wikitext module usage.
60my @argv;
61sub module_package_internals_init {
62    my $self = $module_install_plugin = shift;
63    my ($plugin_spec, %options) = @_;
64    $self->package_options({%$default_options, %options});
65
66    if ($module_install_plugin->is_admin) {
67        $module_package_plugin = $self->_load_plugin($plugin_spec);
68        $module_package_plugin->mi($module_install_plugin);
69        $module_package_plugin->version_check($VERSION);
70    }
71    else {
72        $module_package_dist_plugin = $self->_load_dist_plugin($plugin_spec);
73        $module_package_dist_plugin->mi($module_install_plugin) if ref $module_package_dist_plugin;
74    }
75    # NOTE - This is the point in time where the body of Makefile.PL runs...
76    return;
77
78    sub INIT {
79        return unless $module_install_plugin;
80        return if $Module::Package::ERROR;
81        eval {
82            if ($module_install_plugin->is_admin) {
83                $module_package_plugin->initial();
84                $module_package_plugin->main();
85            }
86            else {
87                $module_install_plugin->_initial();
88                $module_package_dist_plugin->_initial() if ref $module_package_dist_plugin;
89                $module_install_plugin->_main();
90                $module_package_dist_plugin->_main() if ref $module_package_dist_plugin;
91            }
92        };
93        if ($@) {
94            $Module::Package::ERROR = $@;
95            die $@;
96        }
97        @argv = @ARGV; # XXX ARGVHACK
98    }
99
100    # If this Module::Install plugin was used (by Module::Package) then wrap
101    # up any loose ends. This will get called after Makefile.PL has completed.
102    sub END {
103        @ARGV = @argv; # XXX ARGVHACK
104        return unless $module_install_plugin;
105        return if $Module::Package::ERROR;
106        $module_package_plugin
107            ? do {
108                $module_package_plugin->final;
109                $module_package_plugin->replicate_module_package;
110            }
111            : do {
112                $module_install_plugin->_final;
113                $module_package_dist_plugin->_final() if ref $module_package_dist_plugin;
114            }
115    }
116}
117
118# Module::Package, Module::Install::Package and Module::Package::Plugin
119# must all have the same version. Seems wise.
120sub module_package_internals_version_check {
121    my ($self, $version) = @_;
122    return if $version < 0.1800001;   # XXX BOOTBUGHACK!!
123    die <<"..." unless $version == $VERSION;
124
125Error! Something has gone awry:
126    Module::Package version=$version is using
127    Module::Install::Package version=$VERSION
128If you are the author of this module, try upgrading Module::Package.
129Otherwise, please notify the author of this error.
130
131...
132}
133
134# Find and load the author side plugin:
135sub _load_plugin {
136    my ($self, $spec, $namespace) = @_;
137    $spec ||= '';
138    $namespace ||= 'Module::Package';
139    my $version = '';
140    $Module::Package::plugin_version = 0;
141    if ($spec =~ s/\s+(\S+)\s*//) {
142        $version = $1;
143        $Module::Package::plugin_version = $version;
144    }
145    my ($module, $plugin) =
146        not($spec) ? ('Plugin', "Plugin::basic") :
147        ($spec =~ /^\w(\w|::)*$/) ? ($spec, $spec) :
148        ($spec =~ /^:(\w+)$/) ? ('Plugin', "Plugin::$1") :
149        ($spec =~ /^(\S*\w):(\w+)$/) ? ($1, "$1::$2") :
150        die "$spec is invalid";
151    $module = "${namespace}::${module}";
152    $plugin = "${namespace}::${plugin}";
153    eval "use $module $version (); 1" or die $@;
154    return $plugin->new();
155}
156
157# Find and load the user side plugin:
158sub _load_dist_plugin {
159    my ($self, $spec, $namespace) = @_;
160    $spec ||= '';
161    $namespace ||= 'Module::Package::Dist';
162    my $r = eval { $self->_load_plugin($spec, $namespace); };
163    return $r if ref $r;
164    return;
165}
166
167#-----------------------------------------------------------------------------#
168# These are the user side analogs to the author side plugin API calls.
169# Prefix with '_' to not pollute Module::Install plugin space.
170#-----------------------------------------------------------------------------#
171sub _initial {
172    my ($self) = @_;
173}
174
175sub _main {
176    my ($self) = @_;
177}
178
179# NOTE These must match Module::Package::Plugin::final.
180sub _final {
181    my ($self) = @_;
182    $self->_all_from;
183    $self->_requires_from;
184    $self->_install_bin;
185    $self->_install_share;
186    $self->_WriteAll;
187}
188
189#-----------------------------------------------------------------------------#
190# This section is where all the useful code bits go. These bits are needed by
191# both Author and User side runs.
192#-----------------------------------------------------------------------------#
193
194my $all_from = 0;
195sub _all_from {
196    my $self = shift;
197    return if $all_from++;
198    return if $self->name;
199    my $file = shift || "$main::PM" or die "all_from has no file";
200    $self->all_from($file);
201}
202
203my $requires_from = 0;
204sub _requires_from {
205    my $self = shift;
206    return if $requires_from++;
207    return unless $self->package_options->{requires_from};
208    my $file = shift || "$main::PM" or die "requires_from has no file";
209    $self->requires_from($main::PM)
210}
211
212my $install_bin = 0;
213sub _install_bin {
214    my $self = shift;
215    return if $install_bin++;
216    return unless $self->package_options->{install_bin};
217    return unless -d 'bin';
218    my @bin;
219    File::Find::find(sub {
220        return unless -f $_;
221        push @bin, $File::Find::name;
222    }, 'bin');
223    $self->install_script($_) for @bin;
224}
225
226my $install_share = 0;
227sub _install_share {
228    my $self = shift;
229    return if $install_share++;
230    return unless $self->package_options->{install_share};
231    return unless -d 'share';
232    $self->install_share;
233}
234
235my $WriteAll = 0;
236sub _WriteAll {
237    my $self = shift;
238    return if $WriteAll++;
239    $self->WriteAll(@_);
240}
241
242# Base package for Module::Package plugin distributed components.
243package Module::Package::Dist;
244
245sub new {
246    my ($class, %args) = @_;
247    bless \%args, $class;
248}
249
250sub mi {
251    @_ > 1 ? ($_[0]->{mi}=$_[1]) : $_[0]->{mi};
252}
253
254sub _initial {
255    my ($self) = @_;
256}
257
258sub _main {
259    my ($self) = @_;
260}
261
262sub _final {
263    my ($self) = @_;
264}
265
2661;
267
268#-----------------------------------------------------------------------------#
269# Take a guess at the primary .pm and .pod files for 'all_from', and friends.
270# Put them in global magical vars in the main:: namespace.
271#-----------------------------------------------------------------------------#
272package Module::Package::PM;
273use overload '""' => sub {
274    $_[0]->guess_pm unless @{$_[0]};
275    return $_[0]->[0];
276};
277sub set { $_[0]->[0] = $_[1] }
278sub guess_pm {
279    my $pm = '';
280    my $self = shift;
281    if (-e 'META.yml') {
282        open META, 'META.yml' or die "Can't open 'META.yml' for input:\n$!";
283        my $meta = do { local $/; <META> };
284        close META;
285        $meta =~ /^module_name: (\S+)$/m
286            or die "Can't get module_name from META.yml";
287        $pm = $1;
288        $pm =~ s!::!/!g;
289        $pm = "lib/$pm.pm";
290    }
291    else {
292        require File::Find;
293        my @array = ();
294        File::Find::find(sub {
295            return unless /\.pm$/;
296            my $name = $File::Find::name;
297            my $num = ($name =~ s!/+!/!g);
298            my $ary = $array[$num] ||= [];
299            push @$ary, $name;
300        }, 'lib');
301        shift @array while @array and not defined $array[0];
302        die "Can't guess main module" unless @array;
303        (($pm) = sort @{$array[0]}) or
304            die "Can't guess main module";
305    }
306    my $pmc = $pm . 'c';
307    $pm = $pmc if -e $pmc;
308    $self->set($pm);
309}
310$main::PM = bless [$main::PM ? ($main::PM) : ()], __PACKAGE__;
311
312package Module::Package::POD;
313use overload '""' => sub {
314    return $_[0]->[0] if @{$_[0]};
315    (my $pod = "$main::PM") =~ s/\.pm/.pod/
316        or die "Module::Package's \$main::PM value should end in '.pm'";
317    return -e $pod ? $pod : '';
318};
319sub set { $_[0][0] = $_[1] }
320$main::POD = bless [$main::POD ? ($main::POD) : ()], __PACKAGE__;
321
3221;
323
324