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