← Back to branch summary

~ubuntu-branches/ubuntu/quantal/libyaml-libyaml-perl/quantal-security

« back to all changes in this revision

Viewing changes to inc/Module/Install/Package.pm

  • Committer: Bazaar Package Importer
  • Author(s): gregor herrmann, Ansgar Burchardt, Salvatore Bonaccorso, gregor herrmann
  • Date: 2011-10-01 17:23:11 UTC
  • mfrom: (5.1.1 sid)
  • Revision ID: james.westby@ubuntu.com-20111001172311-lo7q2s7x0nmk3ihz
Tags: 0.37-1
[ Ansgar Burchardt ]
* debian/control: Convert Vcs-* fields to Git.

[ Salvatore Bonaccorso ]
* debian/copyright: Replace DEP5 Format-Specification URL from
  svn.debian.org to anonscm.debian.org URL.

[ gregor herrmann ]
* New upstream release.
* Update copyright years for inc/Module/*.
* Add /me to Uploaders.

Show diffs side-by-side

added added

removed removed

Lines of Context:
inc/Module/Install/Package.pm
 
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.
 
14
package Module::Install::Package;
 
15
use strict;
 
16
use Module::Install::Base;
 
17
use vars qw'@ISA $VERSION';
 
18
@ISA = 'Module::Install::Base';
 
19
$VERSION = '0.29';
 
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.
 
25
sub 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:
 
36
sub package_options {
 
37
    @_>1?($_[0]->{package_options}=$_[1]):$_[0]->{package_options}}
 
38
 
 
39
my $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:
 
55
my $module_install_plugin;
 
56
my $module_package_plugin;
 
57
# XXX ARGVHACK This @argv thing is a temporary fix for an ugly bug somewhere in the
 
58
# Wikitext module usage.
 
59
my @argv;
 
60
sub module_package_internals_init {
 
61
    my $self = $module_install_plugin = shift;
 
62
    my ($plugin_spec, %options) = @_;
 
63
    $self->package_options({%$default_options, %options});
 
64
 
 
65
    if ($module_install_plugin->is_admin) {
 
66
        $module_package_plugin = $self->_load_plugin($plugin_spec);
 
67
        $module_package_plugin->mi($module_install_plugin);
 
68
        $module_package_plugin->version_check($VERSION);
 
69
    }
 
70
    # NOTE - This is the point in time where the body of Makefile.PL runs...
 
71
    return;
 
72
 
 
73
    sub INIT {
 
74
        return unless $module_install_plugin;
 
75
        return if $Module::Package::ERROR;
 
76
        eval {
 
77
            if ($module_install_plugin->is_admin) {
 
78
                $module_package_plugin->initial();
 
79
                $module_package_plugin->main();
 
80
            }
 
81
            else {
 
82
                $module_install_plugin->_initial();
 
83
                $module_install_plugin->_main();
 
84
            }
 
85
        };
 
86
        if ($@) {
 
87
            $Module::Package::ERROR = $@;
 
88
            die $@;
 
89
        }
 
90
        @argv = @ARGV; # XXX ARGVHACK
 
91
    }
 
92
 
 
93
    # If this Module::Install plugin was used (by Module::Package) then wrap
 
94
    # up any loose ends. This will get called after Makefile.PL has completed.
 
95
    sub END {
 
96
        @ARGV = @argv; # XXX ARGVHACK
 
97
        return unless $module_install_plugin;
 
98
        return if $Module::Package::ERROR;
 
99
        $module_package_plugin
 
100
            ? do {
 
101
                $module_package_plugin->final;
 
102
                $module_package_plugin->replicate_module_package;
 
103
            }
 
104
            : $module_install_plugin->_final;
 
105
    }
 
106
}
 
107
 
 
108
# Module::Package, Module::Install::Package and Module::Package::Plugin
 
109
# must all have the same version. Seems wise.
 
110
sub module_package_internals_version_check {
 
111
    my ($self, $version) = @_;
 
112
    return if $version < 0.1800001;   # XXX BOOTBUGHACK!!
 
113
    die <<"..." unless $version == $VERSION;
 
114
 
 
115
Error! Something has gone awry:
 
116
    Module::Package version=$version is using 
 
117
    Module::Install::Package version=$VERSION
 
118
If you are the author of this module, try upgrading Module::Package.
 
119
Otherwise, please notify the author of this error.
 
120
 
 
121
...
 
122
}
 
123
 
 
124
# Find and load the author side plugin:
 
125
sub _load_plugin {
 
126
    my ($self, $spec) = @_;
 
127
    $spec ||= '';
 
128
    my $version = '';
 
129
    $Module::Package::plugin_version = 0;
 
130
    if ($spec =~ s/\s+(\S+)\s*//) {
 
131
        $version = $1;
 
132
        $Module::Package::plugin_version = $version;
 
133
    }
 
134
    my ($module, $plugin) =
 
135
        not($spec) ? ('Plugin', "Plugin::basic") :
 
136
        ($spec =~ /^\w(\w|::)*$/) ? ($spec, $spec) :
 
137
        ($spec =~ /^:(\w+)$/) ? ('Plugin', "Plugin::$1") :
 
138
        ($spec =~ /^(\S*\w):(\w+)$/) ? ($1, "$1::$2") :
 
139
        die "$spec is invalid";
 
140
    $module = "Module::Package::$module";
 
141
    $plugin = "Module::Package::$plugin";
 
142
    eval "use $module $version (); 1" or die $@;
 
143
    return $plugin->new();
 
144
}
 
145
 
 
146
#-----------------------------------------------------------------------------#
 
147
# These are the user side analogs to the author side plugin API calls.
 
148
# Prefix with '_' to not pollute Module::Install plugin space.
 
149
#-----------------------------------------------------------------------------#
 
150
sub _initial {
 
151
    my ($self) = @_;
 
152
}
 
153
 
 
154
sub _main {
 
155
    my ($self) = @_;
 
156
}
 
157
 
 
158
# NOTE These must match Module::Package::Plugin::final.
 
159
sub _final {
 
160
    my ($self) = @_;
 
161
    $self->_all_from;
 
162
    $self->_requires_from;
 
163
    $self->_install_bin;
 
164
    $self->_install_share;
 
165
    $self->_WriteAll;
 
166
}
 
167
 
 
168
#-----------------------------------------------------------------------------#
 
169
# This section is where all the useful code bits go. These bits are needed by
 
170
# both Author and User side runs.
 
171
#-----------------------------------------------------------------------------#
 
172
 
 
173
my $all_from = 0;
 
174
sub _all_from {
 
175
    my $self = shift;
 
176
    return if $all_from++;
 
177
    return if $self->name;
 
178
    my $file = shift || "$main::PM" or die "all_from has no file";
 
179
    $self->all_from($file);
 
180
}
 
181
 
 
182
my $requires_from = 0;
 
183
sub _requires_from {
 
184
    my $self = shift;
 
185
    return if $requires_from++;
 
186
    return unless $self->package_options->{requires_from};
 
187
    my $file = shift || "$main::PM" or die "requires_from has no file";
 
188
    $self->requires_from($main::PM)
 
189
}
 
190
 
 
191
my $install_bin = 0;
 
192
sub _install_bin {
 
193
    my $self = shift;
 
194
    return if $install_bin++;
 
195
    return unless $self->package_options->{install_bin};
 
196
    return unless -d 'bin';
 
197
    my @bin;
 
198
    File::Find::find(sub {
 
199
        return unless -f $_;
 
200
        push @bin, $File::Find::name;
 
201
    }, 'bin');
 
202
    $self->install_script($_) for @bin;
 
203
}
 
204
 
 
205
my $install_share = 0;
 
206
sub _install_share {
 
207
    my $self = shift;
 
208
    return if $install_share++;
 
209
    return unless $self->package_options->{install_share};
 
210
    return unless -d 'share';
 
211
    $self->install_share;
 
212
}
 
213
 
 
214
my $WriteAll = 0;
 
215
sub _WriteAll {
 
216
    my $self = shift;
 
217
    return if $WriteAll++;
 
218
    $self->WriteAll(@_);
 
219
}
 
220
 
 
221
#-----------------------------------------------------------------------------#
 
222
# Take a guess at the primary .pm and .pod files for 'all_from', and friends.
 
223
# Put them in global magical vars in the main:: namespace.
 
224
#-----------------------------------------------------------------------------#
 
225
package Module::Package::PM;
 
226
use overload '""' => sub {
 
227
    $_[0]->guess_pm unless @{$_[0]};
 
228
    return $_[0]->[0];
 
229
};
 
230
sub set { $_[0]->[0] = $_[1] }
 
231
sub guess_pm {
 
232
    my $pm = '';
 
233
    my $self = shift;
 
234
    if (-e 'META.yml') {
 
235
        open META, 'META.yml' or die "Can't open 'META.yml' for input:\n$!";
 
236
        my $meta = do { local $/; <META> };
 
237
        close META;
 
238
        $meta =~ /^module_name: (\S+)$/m
 
239
            or die "Can't get module_name from META.yml";
 
240
        $pm = $1;
 
241
        $pm =~ s!::!/!g;
 
242
        $pm = "lib/$pm.pm";
 
243
    }
 
244
    else {
 
245
        require File::Find;
 
246
        my @array = ();
 
247
        File::Find::find(sub {
 
248
            return unless /\.pm$/;
 
249
            my $name = $File::Find::name;
 
250
            my $num = ($name =~ s!/+!/!g);
 
251
            my $ary = $array[$num] ||= [];
 
252
            push @$ary, $name;
 
253
        }, 'lib');
 
254
        shift @array while @array and not defined $array[0];
 
255
        die "Can't guess main module" unless @array;
 
256
        (($pm) = sort @{$array[0]}) or
 
257
            die "Can't guess main module";
 
258
    }
 
259
    my $pmc = $pm . 'c';
 
260
    $pm = $pmc if -e $pmc;
 
261
    $self->set($pm);
 
262
}
 
263
$main::PM = bless [$main::PM ? ($main::PM) : ()], __PACKAGE__;
 
264
 
 
265
package Module::Package::POD;
 
266
use overload '""' => sub {
 
267
    return $_[0]->[0] if @{$_[0]};
 
268
    (my $pod = "$main::PM") =~ s/\.pm/.pod/
 
269
        or die "Module::Package's \$main::PM value should end in '.pm'";
 
270
    return -e $pod ? $pod : '';
 
271
};
 
272
sub set { $_[0][0] = $_[1] }
 
273
$main::POD = bless [$main::POD ? ($main::POD) : ()], __PACKAGE__;
 
274
 
 
275
1;
 
276