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 local $Data::Dumper::Indent = 1;
  13
  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,
  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%',
  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
  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     }
  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 );
 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;
 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 ) {
 171             return $pat if $mod->module =~ /$pat/i;
 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 ) {
 225             return $pat if $mod->module =~ /$pat/i;
 226             return $pat if $mod->package_name =~ /$pat/i;
 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'",
 321                     $obj->module, $@->() );
 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)
 436     --ban         Patterns of module names to skip during installation,
 437                   case-insensitive (affects prerequisites too)
 438                   May be given multiple times
 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
 446                   the package the module is in, case-insensitive)
 447     --ignorelist  File containing patterns that may be given to --ignore.
 448                   Are appended to the ban list built up by --ignore.
 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.
 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.
 466     --dist-opts   Arbitrary options passed along to the chosen installer
 467                   format's prepare()/create() routine. Please see the
 468                   documentation of the installer of your choice for
 469                   options it accepts.
 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
 485     ### Build a package, whose format is determined by your config, of
 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: