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