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