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