Commit | Line | Data |
6aaee015 |
1 | #!/usr/bin/perl -w |
2 | use strict; |
3 | use CPANPLUS::Backend; |
4 | use CPANPLUS::Dist; |
5 | use CPANPLUS::Internals::Constants; |
6 | use Data::Dumper; |
7 | use Getopt::Long; |
8 | use File::Spec; |
9 | use File::Basename; |
10 | use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext'; |
11 | |
622d31ac |
12 | local $Data::Dumper::Indent = 1; |
13 | |
6aaee015 |
14 | use constant PREREQ_SKIP_CLASS => 'CPANPLUS::To::Dist::PREREQ_SKIP'; |
15 | use constant ALARM_CLASS => 'CPANPLUS::To::Dist::ALARM'; |
16 | |
17 | ### print when you can |
18 | $|++; |
19 | |
20 | my $cb = CPANPLUS::Backend->new |
21 | or die loc("Could not create new CPANPLUS::Backend object"); |
22 | my $conf = $cb->configure_object; |
23 | |
24 | my %formats = map { $_ => $_ } CPANPLUS::Dist->dist_types; |
25 | |
26 | my $opts = {}; |
27 | GetOptions( $opts, |
622d31ac |
28 | 'format=s', 'archive', |
29 | 'verbose!', 'force!', |
30 | 'skiptest!', 'keepsource!', |
31 | 'makefile!', 'buildprereq!', |
32 | 'help', 'flushcache', |
33 | 'ban=s@', 'banlist=s@', |
34 | 'ignore=s@', 'ignorelist=s@', |
35 | 'defaults', 'modulelist=s@', |
36 | 'logfile=s', 'timeout=s', |
37 | 'dist-opts=s%', 'set-config=s%', |
38 | 'default-banlist!', 'set-program=s%', |
6aaee015 |
39 | 'default-ignorelist!', |
40 | ); |
41 | |
42 | die usage() if exists $opts->{'help'}; |
43 | |
44 | ### parse options |
45 | my $tarball = $opts->{'archive'} || 0; |
46 | my $keep = $opts->{'keepsource'} ? 1 : 0; |
47 | my $prereqbuild = exists $opts->{'buildprereq'} |
48 | ? $opts->{'buildprereq'} |
49 | : 0; |
50 | my $timeout = exists $opts->{'timeout'} |
51 | ? $opts->{'timeout'} |
52 | : 300; |
53 | |
54 | ### use default answers? |
55 | $ENV{'PERL_MM_USE_DEFAULT'} = $opts->{'defaults'} ? 1 : 0; |
56 | |
57 | my $format; |
58 | ### if provided, we go with the command line option, fall back to conf setting |
59 | { $format = $opts->{'format'} || $conf->get_conf('dist_type'); |
60 | $conf->set_conf( dist_type => $format ); |
61 | |
62 | ### is this a valid format?? |
63 | die loc("Invalid format: " . ($format || "[NONE]") ) . usage() |
64 | unless $formats{$format}; |
65 | |
622d31ac |
66 | ### any options to fix config entries |
67 | { my $set_conf = $opts->{'set-config'} || {}; |
68 | while( my($key,$val) = each %$set_conf ) { |
69 | $conf->set_conf( $key => $val ); |
70 | } |
71 | } |
72 | |
73 | ### any options to fix program entries |
74 | { my $set_prog = $opts->{'set-program'} || {}; |
75 | while( my($key,$val) = each %$set_prog ) { |
76 | $conf->set_program( $key => $val ); |
77 | } |
78 | } |
79 | |
80 | ### any other options passed |
81 | { my %map = ( verbose => 'verbose', |
82 | force => 'force', |
83 | skiptest => 'skiptest', |
84 | makefile => 'prefer_makefile' |
85 | ); |
86 | |
87 | ### set config options from arguments |
88 | while (my($key,$val) = each %map) { |
89 | my $bool = exists $opts->{$key} |
90 | ? $opts->{$key} |
91 | : $conf->get_conf($val); |
92 | $conf->set_conf( $val => $bool ); |
93 | } |
94 | } |
6aaee015 |
95 | } |
96 | |
97 | my @modules = @ARGV; |
98 | if( exists $opts->{'modulelist'} ) { |
99 | push @modules, map { parse_file( $_ ) } @{ $opts->{'modulelist'} }; |
100 | } |
101 | |
102 | die usage() unless @modules; |
103 | |
104 | |
105 | my $fh; |
106 | LOGFILE: { |
107 | if( my $file = $opts->{logfile} ) { |
108 | open $fh, ">$file" or ( |
109 | warn loc("Could not open '%1' for writing: %2", $file,$!), |
110 | last LOGFILE |
111 | ); |
112 | |
113 | warn "Logging to '$file'\n"; |
114 | |
115 | *STDERR = $fh; |
116 | *STDOUT = $fh; |
117 | } |
118 | } |
119 | |
120 | ### reload indices if so desired |
121 | $cb->reload_indices() if $opts->{'flushcache'}; |
122 | |
123 | { my @ban = exists $opts->{'ban'} |
124 | ? map { qr/$_/ } @{ $opts->{'ban'} } |
125 | : (); |
126 | |
127 | |
128 | if( exists $opts->{'banlist'} ) { |
129 | push @ban, map { parse_file( $_, 1 ) } @{ $opts->{'banlist'} }; |
130 | } |
131 | |
132 | push @ban, map { s/\s+//; $_ } |
133 | map { [split /\s*#\s*/]->[0] } |
134 | grep { /#/ } |
135 | map { split /\n/ } _default_ban_list() |
136 | if $opts->{'default-banlist'}; |
137 | |
138 | ### use our prereq install callback |
139 | $conf->set_conf( prereqs => PREREQ_ASK ); |
140 | |
141 | ### register install callback ### |
142 | $cb->_register_callback( |
143 | name => 'install_prerequisite', |
144 | code => \&__ask_about_install, |
145 | ); |
146 | |
147 | |
148 | ### check for ban patterns when handling prereqs |
149 | sub __ask_about_install { |
150 | |
151 | my $mod = shift or return; |
152 | my $prereq = shift or return; |
153 | |
154 | |
155 | ### die with an error object, so we can verify that |
156 | ### the die came from this location, and that it's an |
157 | ### 'acceptable' death |
158 | my $pat = ban_me( $prereq ); |
622d31ac |
159 | die bless sub { loc("Module '%1' requires '%2' to be installed " . |
160 | "but found in your ban list (%3) -- skipping", |
161 | $mod->module, $prereq->module, $pat ) |
162 | }, PREREQ_SKIP_CLASS if $pat; |
6aaee015 |
163 | return 1; |
164 | } |
165 | |
166 | ### should we skip this module? |
167 | sub ban_me { |
168 | my $mod = shift; |
169 | |
170 | for my $pat ( @ban ) { |
622d31ac |
171 | return $pat if $mod->module =~ /$pat/i; |
6aaee015 |
172 | } |
173 | return; |
174 | } |
175 | } |
176 | |
177 | ### patterns to strip from prereq lists |
178 | { my @ignore = exists $opts->{'ignore'} |
179 | ? map { qr/$_/ } @{ $opts->{'ignore'} } |
180 | : (); |
181 | |
182 | if( exists $opts->{'ignorelist'} ) { |
183 | push @ignore, map { parse_file( $_, 1 ) } @{ $opts->{'ignorelist'} }; |
184 | } |
185 | |
186 | push @ignore, map { s/\s+//; $_ } |
187 | map { [split /\s*#\s*/]->[0] } |
188 | grep { /#/ } |
189 | map { split /\n/ } _default_ignore_list() |
190 | if $opts->{'default-ignorelist'}; |
191 | |
192 | |
193 | ### register install callback ### |
194 | $cb->_register_callback( |
195 | name => 'filter_prereqs', |
196 | code => \&__filter_prereqs, |
197 | ); |
198 | |
199 | sub __filter_prereqs { |
200 | my $cb = shift; |
201 | my $href = shift; |
202 | |
203 | for my $name ( keys %$href ) { |
204 | my $obj = $cb->parse_module( module => $name ) or ( |
205 | warn "Cannot make a module object out of ". |
206 | "'$name' -- skipping\n", |
207 | next ); |
208 | |
209 | if( my $pat = ignore_me( $obj ) ) { |
210 | warn loc("'%1' found in your ignore list (%2) ". |
211 | "-- filtering it out\n", $name, $pat); |
212 | |
213 | delete $href->{ $name }; |
214 | } |
215 | } |
216 | |
217 | return $href; |
218 | } |
219 | |
220 | ### should we skip this module? |
221 | sub ignore_me { |
222 | my $mod = shift; |
223 | |
224 | for my $pat ( @ignore ) { |
622d31ac |
225 | return $pat if $mod->module =~ /$pat/i; |
226 | return $pat if $mod->package_name =~ /$pat/i; |
6aaee015 |
227 | } |
228 | return; |
229 | } |
230 | } |
231 | |
232 | |
233 | my %done; |
234 | for my $name (@modules) { |
235 | |
236 | my $obj; |
237 | |
238 | ### is it a tarball? then we get it locally and transform it |
239 | ### and it's dependencies into .debs |
240 | if( $tarball ) { |
241 | ### make sure we use an absolute path, so chdirs() dont |
242 | ### mess things up |
243 | $name = File::Spec->rel2abs( $name ); |
244 | |
245 | ### ENOTARBALL? |
246 | unless( -e $name ) { |
247 | warn loc("Archive '$name' does not exist"); |
248 | next; |
249 | } |
250 | |
251 | $obj = CPANPLUS::Module::Fake->new( |
252 | module => basename($name), |
253 | path => dirname($name), |
254 | package => basename($name), |
255 | ); |
256 | |
257 | ### if it's a traditional CPAN package, we can tidy |
258 | ### up the module name some |
259 | $obj->module( $obj->package_name ) if $obj->package_name; |
260 | |
261 | ### get the version from the package name |
262 | $obj->version( $obj->package_version || 0 ); |
263 | |
264 | ### set the location of the tarball |
265 | $obj->status->fetch($name); |
266 | |
267 | ### plain old cpan module? |
268 | } else { |
269 | |
270 | ### find the corresponding module object ### |
271 | $obj = $cb->parse_module( module => $name ) or ( |
272 | warn "Cannot make a module object out of ". |
273 | "'$name' -- skipping\n", |
274 | next ); |
275 | } |
276 | |
277 | ### you banned it? |
278 | if( my $pat = ban_me( $obj ) ) { |
279 | warn loc("'%1' found in your ban list (%2) -- skipping\n", |
280 | $obj->module, $pat ); |
281 | next; |
282 | } |
283 | |
284 | ### or just ignored it? |
285 | if( my $pat = ignore_me( $obj ) ) { |
286 | warn loc("'%1' found in your ignore list (%2) -- skipping\n", |
287 | $obj->module, $pat ); |
288 | next; |
289 | } |
290 | |
291 | |
292 | my $dist = eval { |
293 | local $SIG{ALRM} = sub { die bless {}, ALARM_CLASS } |
294 | if $timeout; |
295 | |
296 | alarm $timeout || 0; |
297 | |
298 | my $dist_opts = $opts->{'dist-opts'} || {}; |
299 | |
300 | my $rv = $obj->install( |
301 | prereq_target => 'create', |
302 | target => 'create', |
303 | keep_source => $keep, |
304 | prereq_build => $prereqbuild, |
305 | |
306 | ### any passed arbitrary options |
307 | %$dist_opts, |
308 | ); |
309 | |
310 | alarm 0; |
311 | |
312 | $rv; |
313 | }; |
314 | |
315 | ### set here again, in case the install dies |
316 | alarm 0; |
317 | |
318 | ### install failed due to a 'die' in our prereq skipper? |
319 | if( $@ and ref $@ and $@->isa( PREREQ_SKIP_CLASS ) ) { |
320 | warn loc("Dist creation of '%1' skipped: '%2'", |
622d31ac |
321 | $obj->module, $@->() ); |
6aaee015 |
322 | next; |
323 | |
324 | } elsif ( $@ and ref $@ and $@->isa( ALARM_CLASS ) ) { |
325 | warn loc("\nDist creation of '%1' skipped, build time exceeded: ". |
326 | "%2 seconds\n", $obj->module, $timeout ); |
327 | next; |
328 | |
329 | ### died for some other reason? just report and skip |
330 | } elsif ( $@ ) { |
331 | warn loc("Dist creation of '%1' failed: '%2'", |
332 | $obj->module, $@ ); |
333 | next; |
334 | } |
335 | |
336 | ### we didn't get a dist object back? |
337 | unless ($dist and $obj->status->dist) { |
338 | warn loc("Unable to create '%1' dist of '%2'", $format, $obj->module); |
339 | next |
340 | } |
341 | |
342 | print "Created '$format' distribution for ", $obj->module, |
343 | " to:\n\t", $obj->status->dist->status->dist, "\n"; |
344 | } |
345 | |
346 | |
347 | sub parse_file { |
348 | my $file = shift or return; |
349 | my $qr = shift() ? 1 : 0; |
350 | |
351 | my $fh = OPEN_FILE->( $file ) or return; |
352 | |
353 | my @rv; |
354 | while( <$fh> ) { |
355 | chomp; |
356 | next if /^#/; # skip comments |
357 | next unless /\S/; # skip empty lines |
358 | s/^(\S+).*/$1/; # skip extra info |
359 | push @rv, $qr ? qr/$_/ : $_; # add pattern to the list |
360 | } |
361 | |
362 | return @rv; |
363 | } |
364 | |
365 | =head1 NAME |
366 | |
367 | cpan2dist - The CPANPLUS distribution creator |
368 | |
369 | =head1 DESCRIPTION |
370 | |
371 | This script will create distributions of C<CPAN> modules of the format |
372 | you specify, including its prerequisites. These packages can then be |
373 | installed using the corresponding package manager for the format. |
374 | |
375 | Note, you can also do this interactively from the default shell, |
376 | C<CPANPLUS::Shell::Default>. See the C<CPANPLUS::Dist> documentation, |
377 | as well as the documentation of your format of choice for any format |
378 | specific documentation. |
379 | |
380 | =head1 USAGE |
381 | |
382 | =cut |
383 | |
384 | sub usage { |
385 | my $me = basename($0); |
386 | my $formats = join "\n", map { "\t\t$_" } sort keys %formats; |
387 | |
388 | my $usage = << '=cut'; |
389 | =pod |
390 | |
391 | Usage: cpan2dist [--format FMT] [OPTS] Mod::Name [Mod::Name, ...] |
392 | cpan2dist [--format FMT] [OPTS] --modulelist /tmp/mods.list |
393 | cpan2dist [--format FMT] [OPTS] --archive /tmp/dist [/tmp/dist2] |
394 | |
395 | Will create a distribution of type FMT of the modules |
396 | specified on the command line, and all their prerequisites. |
397 | |
398 | Can also create a distribution of type FMT from a local |
399 | archive and all it's prerequisites |
400 | |
401 | =cut |
402 | |
403 | $usage .= qq[ |
404 | Possible formats are: |
405 | $formats |
406 | |
407 | You can install more formats from CPAN! |
408 | \n]; |
409 | |
410 | $usage .= << '=cut'; |
411 | =pod |
412 | |
413 | Options: |
414 | |
415 | ### take no argument: |
416 | --help Show this help message |
417 | --skiptest Skip tests. Can be negated using --noskiptest |
418 | --force Force operation. Can be negated using --noforce |
419 | --verbose Be verbose. Can be negated using --noverbose |
420 | --keepsource Keep sources after building distribution. Can be |
421 | negated by --nokeepsource. May not be supported |
422 | by all formats |
423 | --makefile Prefer Makefile.PL over Build.PL. Can be negated |
424 | using --nomakefile. Defaults to your config setting |
425 | --buildprereq Build packages of any prerequisites, even if they are |
426 | already uptodate on the local system. Can be negated |
427 | using --nobuildprereq. Defaults to false. |
428 | --archive Indicate that all modules listed are actually archives |
429 | --flushcache Update CPANPLUS' cache before commencing any operation |
430 | --defaults Instruct ExtUtils::MakeMaker and Module::Build to use |
431 | default answers during 'perl Makefile.PL' or 'perl |
432 | Build.PL' calls where possible |
433 | |
434 | ### take argument: |
435 | --format Installer format to use (defaults to config setting) |
622d31ac |
436 | --ban Patterns of module names to skip during installation, |
437 | case-insensitive (affects prerequisites too) |
438 | May be given multiple times |
6aaee015 |
439 | --banlist File containing patterns that could be given to --ban |
440 | Are appended to the ban list built up by --ban |
441 | May be given multiple times. |
442 | --ignore Patterns of modules to exclude from prereq list. Useful |
443 | for when a prereq listed by a CPAN module is resolved |
444 | in another way than from its corresponding CPAN package |
445 | (Match is done on both module name, and package name of |
622d31ac |
446 | the package the module is in, case-insensitive) |
6aaee015 |
447 | --ignorelist File containing patterns that may be given to --ignore. |
622d31ac |
448 | Are appended to the ban list built up by --ignore. |
6aaee015 |
449 | May be given multiple times. |
450 | --modulelist File containing a list of modules that should be built. |
451 | Are appended to the list of command line modules. |
452 | May be given multiple times. |
453 | --logfile File to log all output to. By default, all output goes |
454 | to the console. |
455 | --timeout The allowed time for buliding a distribution before |
456 | aborting. This is useful to terminate any build that |
457 | hang or happen to be interactive despite being told not |
458 | to be. Defaults to 300 seconds. To turn off, you can |
459 | set it to 0. |
622d31ac |
460 | --set-config Change any options as specified in your config for this |
461 | invocation only. See CPANPLUS::Config for a list of |
462 | supported options. |
463 | --set-program Change any programs as specified in your config for this |
464 | invocation only. See CPANPLUS::Config for a list of |
465 | supported programs. |
6aaee015 |
466 | --dist-opts Arbitrary options passed along to the chosen installer |
622d31ac |
467 | format's prepare()/create() routine. Please see the |
468 | documentation of the installer of your choice for |
469 | options it accepts. |
6aaee015 |
470 | |
471 | ### builtin lists |
472 | --default-banlist Use our builtin banlist. Works just like --ban |
473 | and --banlist, but with pre-set lists. See the |
474 | "Builtin Lists" section for details. |
475 | --default-ignorelist Use our builtin ignorelist. Works just like |
476 | --ignore and --ignorelist but with pre-set lists. |
477 | See the "Builtin Lists" section for details. |
478 | |
479 | Examples: |
480 | |
481 | ### build a debian package of DBI and it's prerequisites, |
482 | ### don't bother running tests |
483 | cpan2dist --format CPANPLUS::Dist::Deb --buildprereq --skiptest DBI |
484 | |
622d31ac |
485 | ### Build a package, whose format is determined by your config, of |
6aaee015 |
486 | ### the local tarball, reloading cpanplus' indices first and using |
487 | ### the tarballs Makefile.PL if it has one. |
488 | cpan2dist --makefile --flushcache --archive /path/to/Cwd-1.0.tgz |
489 | |
490 | ### build a package from Net::FTP, but dont build any packages or |
491 | ### dependencies whose name match 'Foo', 'Bar' or any of the |
492 | ### patterns mentioned in /tmp/ban |
493 | cpan2dist --ban Foo --ban Bar --banlist /tmp/ban Net::FTP |
494 | |
495 | ### build a package from Net::FTP, but ignore it's listed dependency |
496 | ### on IO::Socket, as it's shipped per default with the OS we're on |
497 | cpan2dist --ignore IO::Socket Net::FTP |
498 | |
499 | ### building all modules listed, plus their prerequisites |
500 | cpan2dist --ignorelist /tmp/modules.ignore --banlist /tmp/modules.ban |
501 | --modulelist /tmp/modules.list --buildprereq --flushcache |
502 | --makefile --defaults |
503 | |
504 | ### pass arbitrary options to the format's prepare()/create() routine |
505 | cpan2dist --dist-opts deb_version=3 --dist-opts prefix=corp |
506 | |
507 | =cut |
508 | |
509 | $usage .= qq[ |
510 | Builtin Lists: |
511 | |
512 | Ignore list:] . _default_ignore_list() . qq[ |
513 | Ban list:] . _default_ban_list(); |
514 | |
515 | ### strip the pod directives |
516 | $usage =~ s/=pod\n//g; |
517 | |
518 | return $usage; |
519 | } |
520 | |
521 | =pod |
522 | |
523 | =head1 Built-In Filter Lists |
524 | |
525 | Some modules you'd rather not package. Some because they |
526 | are part of core-perl and you dont want a new package. |
527 | Some because they won't build on your system. Some because |
528 | your package manager of choice already packages them for you. |
529 | |
530 | There may be a myriad of reasons. You can use the C<--ignore> |
531 | and C<--ban> options for this, but we provide some built-in |
532 | lists that catch common cases. You can use these built-in lists |
533 | if you like, or supply your own if need be. |
534 | |
535 | =head2 Built-In Ignore List |
536 | |
537 | =pod |
538 | |
539 | You can use this list of regexes to ignore modules matching |
540 | to be listed as prerequisites of a package. Particulaly useful |
541 | if they are bundled with core-perl anyway and they have known |
542 | issues building. |
543 | |
544 | Toggle it by supplying the C<--default-ignorelist> option. |
545 | |
546 | =cut |
547 | |
548 | sub _default_ignore_list { |
549 | |
550 | my $list = << '=cut'; |
551 | =pod |
552 | |
553 | ^IO$ # Provided with core anyway |
554 | ^Cwd$ # Provided with core anyway |
555 | ^File::Spec # Provided with core anyway |
556 | ^Config$ # Perl's own config, not shipped separately |
557 | ^ExtUtils::MakeMaker$ # Shipped with perl, recent versions |
558 | # have bug 14721 (see rt.cpan.org) |
559 | ^ExtUtils::Install$ # Part of of EU::MM, same reason |
560 | |
561 | =cut |
562 | |
563 | return $list; |
564 | } |
565 | |
566 | =head2 Built-In Ban list |
567 | |
568 | You can use this list of regexes to disable building of these |
569 | modules altogether. |
570 | |
571 | Toggle it by supplying the C<--default-banlist> option. |
572 | |
573 | =cut |
574 | |
575 | sub _default_ban_list { |
576 | |
577 | my $list = << '=cut'; |
578 | =pod |
579 | |
580 | ^GD$ # Needs c libaries |
581 | ^Berk.*DB # DB packages require specific options & linking |
582 | ^DBD:: # DBD drives require database files/headers |
583 | ^XML:: # XML modules usually require expat libraries |
584 | Apache # These usually require apache libraries |
585 | SSL # These usually require SSL certificates & libs |
586 | Image::Magick # Needs ImageMagick C libraries |
587 | Mail::ClamAV # Needs ClamAV C Libraries |
588 | ^Verilog # Needs Verilog C Libraries |
589 | ^Authen::PAM$ # Needs PAM C libraries & Headers |
590 | |
591 | =cut |
592 | |
593 | return $list; |
594 | } |
595 | |
596 | __END__ |
597 | |
598 | =head1 SEE ALSO |
599 | |
600 | L<CPANPLUS::Dist>, L<CPANPLUS::Module>, L<CPANPLUS::Shell::Default>, |
601 | C<cpanp> |
602 | |
603 | =head1 BUG REPORTS |
604 | |
605 | Please report bugs or other issues to E<lt>bug-cpanplus@rt.cpan.org<gt>. |
606 | |
607 | =head1 AUTHOR |
608 | |
609 | This module by Jos Boumans E<lt>kane@cpan.orgE<gt>. |
610 | |
611 | =head1 COPYRIGHT |
612 | |
613 | The CPAN++ interface (of which this module is a part of) is copyright (c) |
614 | 2001 - 2007, Jos Boumans E<lt>kane@cpan.orgE<gt>. All rights reserved. |
615 | |
616 | This library is free software; you may redistribute and/or modify it |
617 | under the same terms as Perl itself. |
618 | |
619 | =cut |
620 | |
621 | # Local variables: |
622 | # c-indentation-style: bsd |
623 | # c-basic-offset: 4 |
624 | # indent-tabs-mode: nil |
625 | # End: |
626 | # vim: expandtab shiftwidth=4: |