Commit | Line | Data |
3fea05b9 |
1 | package Module::Install::PAR; |
2 | |
3 | use strict; |
4 | use Module::Install::Base (); |
5 | |
6 | use vars qw{$VERSION @ISA $ISCORE}; |
7 | BEGIN { |
8 | $VERSION = '0.91'; |
9 | @ISA = 'Module::Install::Base'; |
10 | $ISCORE = 1; |
11 | } |
12 | |
13 | =head1 NAME |
14 | |
15 | Module::Install::PAR - Module::Install Support for PAR::Dist packages |
16 | |
17 | =head1 SYNOPSIS |
18 | |
19 | To offer your users the possibility to install binaries if no C |
20 | compiler was found, you could use this simplistic stub: |
21 | |
22 | use inc::Module::Install; |
23 | |
24 | name 'Foo'; |
25 | all_from 'lib/Foo.pm'; |
26 | |
27 | # Which CPAN directory do we fetch binaries from? |
28 | par_base 'SMUELLER'; |
29 | |
30 | unless ( can_cc() ) { |
31 | my $okay = extract_par( fetch_par ); |
32 | if (not $okay) { |
33 | die "No compiler and no binary package found. Aborting.\n"; |
34 | } |
35 | } |
36 | |
37 | WriteAll; |
38 | |
39 | =head1 DESCRIPTION |
40 | |
41 | This module adds a couple of directives to Module::Install |
42 | related to installing and creating PAR::Dist distributions. |
43 | |
44 | =head2 par_base |
45 | |
46 | This directive sets the CPAN ID from whose CPAN directory to |
47 | fetch binaries from. For example, you can choose to download |
48 | binaries from http://www.cpan.org/authors/id/S/SM/SMUELLER/ |
49 | or its ftp counterpart by writing: |
50 | |
51 | par_base 'SMUELLER'; |
52 | |
53 | By default, the name of the file to fetch is generated from |
54 | the distribution name, its version, your platform name and your |
55 | perl version concatenated with dashes. |
56 | |
57 | The directive, however, takes an optional second |
58 | argument which specifies the name of the file to fetch. |
59 | (Though C<par_base> does not fetch files itself, see below.) |
60 | |
61 | par_base 'SMUELLER', 'foo'; |
62 | |
63 | Once C<fetch_par> is called, the file 'foo' will be downloaded |
64 | from SMUELLER's CPAN directory. (It doesn't exist.) |
65 | |
66 | The second argument could be used to fetch platform-agnostic |
67 | binaries: |
68 | |
69 | par_base 'SMUELLER', "Some-Distribution-0.01.par"; |
70 | |
71 | (Documentation TODO: Use the previously defined distribution |
72 | name and version in example.) |
73 | |
74 | =cut |
75 | |
76 | sub par_base { |
77 | my ($self, $base, $file) = @_; |
78 | my $class = ref($self); |
79 | my $inc_class = join('::', @{$self->_top}{qw(prefix name)}); |
80 | my $ftp_base; |
81 | |
82 | if ( defined $base and length $base ) { |
83 | if ( $base =~ m!^(([A-Z])[A-Z])[-_A-Z]+\Z! ) { |
84 | $self->{mailto} = "$base\@cpan.org"; |
85 | $ftp_base = "ftp://ftp.cpan.org/pub/CPAN/authors/id/$2/$1/$base"; |
86 | $base = "http://www.cpan.org/authors/id/$2/$1/$base"; |
87 | } elsif ( $base !~ m!^(\w+)://! ) { |
88 | die "Cannot recognize path '$base'; please specify an URL or CPAN ID"; |
89 | } |
90 | $base .= '/' unless $base =~ m!/\Z!; |
91 | $ftp_base .= '/' unless $ftp_base =~ m!/\Z!; |
92 | } |
93 | |
94 | require Config; |
95 | my $suffix = "$Config::Config{archname}-$Config::Config{version}.par"; |
96 | |
97 | unless ( $file ||= $self->{file} ) { |
98 | my $name = $self->name or return; |
99 | my $version = $self->version or return; |
100 | $name =~ s!::!-!g; |
101 | $self->{file} = $file = "$name-$version-$suffix"; |
102 | } |
103 | |
104 | my $perl = $^X; |
105 | $perl = Win32::GetShortPathName($perl) |
106 | if $perl =~ / / and defined &Win32::GetShortPathName; |
107 | |
108 | $self->preamble(<<"END_MAKEFILE") if $base; |
109 | # --- $class section: |
110 | |
111 | all :: |
112 | \t\$(NOECHO) $perl "-M$inc_class" -e "extract_par(q($file))" |
113 | |
114 | END_MAKEFILE |
115 | |
116 | $self->postamble(<<"END_MAKEFILE"); |
117 | # --- $class section: |
118 | |
119 | $file: all test |
120 | \t\$(NOECHO) \$(PERL) "-M$inc_class" -e "make_par(q($file))" |
121 | |
122 | par :: $file |
123 | \t\$(NOECHO) \$(NOOP) |
124 | |
125 | par-upload :: $file |
126 | \tcpan-upload -verbose $file |
127 | |
128 | END_MAKEFILE |
129 | |
130 | $self->{url} = $base; |
131 | $self->{ftp_url} = $ftp_base; |
132 | $self->{suffix} = $suffix; |
133 | |
134 | return $self; |
135 | } |
136 | |
137 | =head2 fetch_par |
138 | |
139 | Fetches the .par file previously referenced in the documentation |
140 | of the C<par_base> directive. |
141 | |
142 | C<fetch_par> can be used without arguments given the C<par_base> |
143 | directive was used before. It will return the name of the file it |
144 | fetched. |
145 | |
146 | If the first argument is an URL or a CPAN user ID, the file is |
147 | fetched from that directory unless an URL has been previously set. |
148 | (Read that again.) |
149 | |
150 | If the second argument is a file name |
151 | it is used as the name of the file to download. |
152 | |
153 | If the file could not be fetched, a suitable error message |
154 | about no package being available, yada yada yada, is printed. |
155 | You can turn this off by specifying a true third argument. |
156 | |
157 | # Try to fetch the package (see par_base) but |
158 | # don't be verbose about failures |
159 | my $file = fetch_par('', '', undef); |
160 | |
161 | =cut |
162 | |
163 | sub fetch_par { |
164 | my ($self, $url, $file, $quiet) = @_; |
165 | $url = '' if not defined $url; |
166 | $file = '' if not defined $file; |
167 | |
168 | $url = $self->{url} || $self->par_base($url)->{url}; |
169 | my $ftp_url = $self->{ftp_url}; |
170 | $file ||= $self->{file}; |
171 | |
172 | return $file if -f $file or $self->get_file( |
173 | url => "$url$file", |
174 | ftp_url => "$ftp_url$file" |
175 | ); |
176 | |
177 | require Config; |
178 | print <<"END_MESSAGE" if $self->{mailto} and ! $quiet; |
179 | *** No installation package available for your architecture. |
180 | However, you may wish to generate one with '$Config::Config{make} par' and send |
181 | it to <$self->{mailto}>, so other people on the same platform |
182 | can benefit from it. |
183 | *** Proceeding with normal installation... |
184 | END_MESSAGE |
185 | return; |
186 | } |
187 | |
188 | =head2 extract_par |
189 | |
190 | Takes the name of a PAR::Dist archive file as first argument. The 'blib/' |
191 | directory of this archive is extracted and the 'pm_to_blib' is created. |
192 | |
193 | Typical shorthand usage: |
194 | |
195 | extract_par( fetch_par ) or die "Could not install PAR::Dist archive."; |
196 | |
197 | =cut |
198 | |
199 | sub extract_par { |
200 | my ($self, $file) = @_; |
201 | return unless -f $file; |
202 | |
203 | if ( eval { require Archive::Zip; 1 } ) { |
204 | my $zip = Archive::Zip->new; |
205 | return unless $zip->read($file) == Archive::Zip::AZ_OK() |
206 | and $zip->extractTree('', 'blib/') == Archive::Zip::AZ_OK(); |
207 | } elsif ( $self->can_run('unzip') ) { |
208 | return if system( unzip => $file, qw(-d blib) ); |
209 | } |
210 | else { |
211 | die <<'HERE'; |
212 | Could not extract .par archive because neither Archive::Zip nor a |
213 | working 'unzip' binary are available. Please consider installing |
214 | Archive::Zip. |
215 | HERE |
216 | } |
217 | |
218 | local *PM_TO_BLIB; |
219 | open PM_TO_BLIB, '> pm_to_blib' or die $!; |
220 | close PM_TO_BLIB or die $!; |
221 | |
222 | return 1; |
223 | } |
224 | |
225 | =head2 make_par |
226 | |
227 | This directive requires PAR::Dist (version 0.03 or up) on your system. |
228 | (And checks that it is available before continuing.) |
229 | |
230 | Creates a PAR::Dist archive from the 'blib/' subdirectory. |
231 | |
232 | First argument must be the name of the PAR::Dist archive to create. |
233 | |
234 | If your Makefile.PL has a C<par_base> directive, the C<make par> |
235 | make target will be available. It uses this C<make_par> directive |
236 | internally, so on your development system, you can do this to create |
237 | a .par binary archive for your platform: |
238 | |
239 | perl Makefile.PL |
240 | make |
241 | make par |
242 | |
243 | =cut |
244 | |
245 | sub make_par { |
246 | my ($self, $file) = @_; |
247 | unlink $file if -f $file; |
248 | |
249 | unless ( eval { require PAR::Dist; PAR::Dist->VERSION >= 0.03 } ) { |
250 | warn "Please install PAR::Dist 0.03 or above first."; |
251 | return; |
252 | } |
253 | |
254 | return PAR::Dist::blib_to_par( dist => $file ); |
255 | } |
256 | |
257 | 1; |
258 | |
259 | =head1 AUTHOR |
260 | |
261 | Audrey Tang <cpan@audreyt.org> |
262 | |
263 | With documentation from Steffen Mueller <smueller@cpan.org> |
264 | |
265 | =head1 COPYRIGHT |
266 | |
267 | Copyright (c) 2006. Audrey Tang. |
268 | |
269 | This program is free software; you can redistribute it and/or modify it |
270 | under the same terms as Perl itself. |
271 | |
272 | See L<http://www.perl.com/perl/misc/Artistic.html> |
273 | |
274 | =cut |