#!/usr/bin/perl eval 'exec /usr/bin/perl -S $0 ${1+"$@"}' if $running_under_some_shell; #!/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? $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() dont ### 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 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. See the C 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 buliding 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 dont 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 dont 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. Particulaly 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 libaries ^Berk.*DB # DB packages require specific options & linking ^DBD:: # DBD drives 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, L, L, C =head1 BUG REPORTS Please report bugs or other issues to Ebug-cpanplus@rt.cpan.org. =head1 AUTHOR This module by Jos Boumans Ekane@cpan.orgE. =head1 COPYRIGHT The CPAN++ interface (of which this module is a part of) is copyright (c) 2001 - 2007, Jos Boumans Ekane@cpan.orgE. 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: