Commit | Line | Data |
613f422f |
1 | package inc::latest; |
2 | use strict; |
3 | use vars qw($VERSION); |
7dc9e1b4 |
4 | $VERSION = '0.3603'; |
613f422f |
5 | $VERSION = eval $VERSION; |
6 | |
7 | use Carp; |
8 | use File::Basename (); |
9 | use File::Spec (); |
10 | use File::Path (); |
11 | use IO::File (); |
12 | use File::Copy (); |
13 | |
14 | # track and return modules loaded by inc::latest |
15 | my @loaded_modules; |
16 | sub loaded_modules {@loaded_modules} |
17 | |
18 | # must ultimately "goto" the import routine of the module to be loaded |
19 | # so that the calling package is correct when $mod->import() runs. |
20 | sub import { |
21 | my ($package, $mod, @args) = @_; |
22 | return unless(defined $mod); |
23 | |
53fc1c7e |
24 | my $private_path = 'inc/latest/private.pm'; |
25 | if(-e $private_path) { |
26 | # user mode - delegate work to bundled private module |
613f422f |
27 | require $private_path; |
53fc1c7e |
28 | splice( @_, 0, 1, 'inc::latest::private'); |
29 | goto \&inc::latest::private::import; |
613f422f |
30 | } |
31 | |
53fc1c7e |
32 | # author mode - just record and load the modules |
613f422f |
33 | push(@loaded_modules, $mod); |
34 | require inc::latest::private; |
35 | goto \&inc::latest::private::_load_module; |
36 | } |
37 | |
38 | sub write { |
39 | my $package = shift; |
40 | my ($where, @preload) = @_; |
41 | |
42 | warn "should really be writing in inc/" unless $where =~ /inc$/; |
43 | |
44 | # write inc/latest.pm |
45 | File::Path::mkpath( $where ); |
46 | my $fh = IO::File->new( File::Spec->catfile($where,'latest.pm'), "w" ); |
47 | print {$fh} "# This stub created by inc::latest $VERSION\n"; |
48 | print {$fh} <<'HERE'; |
49 | package inc::latest; |
50 | use strict; |
51 | use vars '@ISA'; |
52 | require inc::latest::private; |
53 | @ISA = qw/inc::latest::private/; |
54 | HERE |
55 | if (@preload) { |
56 | print {$fh} "\npackage inc::latest::preload;\n"; |
57 | for my $mod (@preload) { |
58 | print {$fh} "inc::latest->import('$mod');\n"; |
59 | } |
60 | } |
61 | print {$fh} "\n1;\n"; |
62 | close $fh; |
63 | |
64 | # write inc/latest/private; |
65 | require inc::latest::private; |
66 | File::Path::mkpath( File::Spec->catdir( $where, 'latest' ) ); |
67 | my $from = $INC{'inc/latest/private.pm'}; |
68 | my $to = File::Spec->catfile($where,'latest','private.pm'); |
69 | File::Copy::copy( $from, $to ) or die "Couldn't copy '$from' to '$to': $!"; |
70 | |
71 | return 1; |
72 | } |
73 | |
74 | sub bundle_module { |
75 | my ($package, $module, $where) = @_; |
53fc1c7e |
76 | |
613f422f |
77 | # create inc/inc_$foo |
78 | (my $dist = $module) =~ s{::}{-}g; |
79 | my $inc_lib = File::Spec->catdir($where,"inc_$dist"); |
80 | File::Path::mkpath $inc_lib; |
81 | |
82 | # get list of files to copy |
83 | require ExtUtils::Installed; |
84 | # workaround buggy EU::Installed check of @INC |
85 | my $inst = ExtUtils::Installed->new(extra_libs => [@INC]); |
86 | my $packlist = $inst->packlist( $module ) or die "Couldn't find packlist"; |
87 | my @files = grep { /\.pm$/ } keys %$packlist; |
88 | |
89 | |
90 | # figure out prefix |
91 | my $mod_path = quotemeta $package->_mod2path( $module ); |
92 | my ($prefix) = grep { /$mod_path$/ } @files; |
93 | $prefix =~ s{$mod_path$}{}; |
94 | |
95 | # copy files |
96 | for my $from ( @files ) { |
97 | next unless $from =~ /\.pm$/; |
98 | (my $mod_path = $from) =~ s{^\Q$prefix\E}{}; |
99 | my $to = File::Spec->catfile( $inc_lib, $mod_path ); |
100 | File::Path::mkpath(File::Basename::dirname($to)); |
101 | File::Copy::copy( $from, $to ) or die "Couldn't copy '$from' to '$to': $!"; |
102 | } |
103 | return 1; |
104 | } |
105 | |
106 | # Translate a module name into a directory/file.pm to search for in @INC |
107 | sub _mod2path { |
108 | my ($self, $mod) = @_; |
109 | my @parts = split /::/, $mod; |
110 | $parts[-1] .= '.pm'; |
111 | return $parts[0] if @parts == 1; |
112 | return File::Spec->catfile(@parts); |
113 | } |
114 | |
115 | 1; |
116 | |
117 | |
118 | =head1 NAME |
119 | |
120 | inc::latest - use modules bundled in inc/ if they are newer than installed ones |
121 | |
122 | =head1 SYNOPSIS |
123 | |
124 | # in Build.PL |
125 | use inc::latest 'Module::Build'; |
126 | |
127 | =head1 DESCRIPTION |
128 | |
129 | The C<inc::latest> module helps bootstrap configure-time dependencies for CPAN |
130 | distributions. These dependencies get bundled into the C<inc> directory within |
53fc1c7e |
131 | a distribution and are used by Build.PL (or Makefile.PL). |
613f422f |
132 | |
133 | Arguments to C<inc::latest> are module names that are checked against both the |
134 | current C<@INC> array and against specially-named directories in C<inc>. If |
135 | the bundled verison is newer than the installed one (or the module isn't |
136 | installed, then, the bundled directory is added to the start of <@INC> and the |
137 | module is loaded from there. |
138 | |
139 | There are actually two variations of C<inc::latest> -- one for authors and one |
140 | for the C<inc> directory. For distribution authors, the C<inc::latest> |
141 | installed in the system will record modules loaded via C<inc::latest> and can |
142 | be used to create the bundled files in C<inc>, including writing the second |
143 | variation as C<inc/latest.pm>. |
144 | |
145 | This second C<inc::latest> is the one that is loaded in a distribution being |
146 | installed (e.g. from Build.PL). This bundled C<inc::latest> is the one |
147 | that determines which module to load. |
148 | |
149 | =head2 Special notes on bundling |
150 | |
151 | The C<inc::latest> module creates bundled directories based on the packlist |
152 | file of an installed distribution. Even though C<inc::latest> takes module |
153 | name arguments, it is better to think of it as bundling and making available |
154 | entire I<distributions>. When a module is loaded through C<inc::latest>, |
155 | it looks in all bundled distributions in C<inc/> for a newer module than |
156 | can be found in the existing C<@INC> array. |
157 | |
158 | Thus, the module-name provided should usually be the "top-level" module name of |
159 | a distribution, though this is not strictly required. For example, |
160 | L<Module::Build> has a number of heuristics to map module names to packlists, |
161 | allowing users to do things like this: |
162 | |
163 | use inc::latest 'Devel::AssertOS::Unix'; |
164 | |
165 | even though Devel::AssertOS::Unix is contained within the Devel-CheckOS |
166 | distribution. |
167 | |
168 | At the current time, packlists are required. Thus, bundling dual-core modules |
169 | may require a 'forced install' over versions in the latest version of perl |
170 | in order to create the necessary packlist for bundling. |
171 | |
172 | =head1 USAGE |
173 | |
174 | When calling C<use>, the bundled C<inc::latest> takes a single module name and |
175 | optional arguments to pass to that module's own import method. |
176 | |
177 | use 'inc::latest' 'Foo::Bar' qw/foo bar baz/; |
178 | |
179 | =head2 Author-mode |
180 | |
181 | You are in author-mode inc::latest if any of the Author-mode methods are |
182 | available. For example: |
183 | |
184 | if ( inc::latest->can('write') ) { |
185 | inc::latest->write('inc'); |
186 | } |
187 | |
188 | =over 4 |
189 | |
190 | =item loaded_modules() |
191 | |
192 | my @list = inc::latest->loaded_modules; |
193 | |
194 | This takes no arguments and always returns a list of module names requested for |
195 | loading via "use inc::latest 'MODULE'", regardless of wether the load was |
196 | successful or not. |
197 | |
198 | =item write() |
199 | |
200 | inc::latest->write( 'inc' ); |
201 | |
202 | This writes the bundled version of inc::latest to the directory name given as an |
203 | argument. It almost all cases, it should be 'C<inc>'. |
204 | |
205 | =item bundle_module() |
206 | |
207 | for my $mod ( inc::latest->loaded_modules ) { |
208 | inc::latest->bundle_module($mod, $dir); |
209 | } |
210 | |
211 | If $mod corresponds to a packlist, then this function creates a specially-named |
212 | directory in $dir and copies all .pm files from the modlist to the new |
213 | directory (which almost always should just be 'inc'). For example, if Foo::Bar |
214 | is the name of the module, and $dir is 'inc', then the directory would be |
215 | 'inc/inc_Foo-Bar' and contain files like this: |
216 | |
217 | inc/inc_Foo-Bar/Foo/Bar.pm |
218 | |
219 | Currently, $mod B<must> have a packlist. If this is not the case (e.g. for a |
220 | dual-core module), then the bundling will fail. You may be able to create a |
221 | packlist by forced installing the module on top of the version that came with |
222 | core Perl. |
223 | |
224 | =back |
225 | |
226 | =head2 As bundled in inc/ |
227 | |
228 | All methods are private. Only the C<import> method is public. |
229 | |
230 | =head1 AUTHOR |
231 | |
232 | Eric Wilhelm <ewilhelm@cpan.org>, David Golden <dagolden@cpan.org> |
233 | |
234 | =head1 COPYRIGHT |
235 | |
236 | Copyright (c) 2009 by Eric Wilhelm and David Golden |
237 | |
238 | This library is free software; you can redistribute it and/or |
239 | modify it under the same terms as Perl itself. |
240 | |
241 | =head1 SEE ALSO |
242 | |
243 | L<Module::Build> |
244 | |
245 | =cut |
246 | |