lib/CPANPLUS/bin/cpan2dist

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