diff options
Diffstat (limited to 'Master/tlpkg/tlperl0/bin/cpan2dist')
-rwxr-xr-x | Master/tlpkg/tlperl0/bin/cpan2dist | 671 |
1 files changed, 671 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl0/bin/cpan2dist b/Master/tlpkg/tlperl0/bin/cpan2dist new file mode 100755 index 00000000000..5ba4556c529 --- /dev/null +++ b/Master/tlpkg/tlperl0/bin/cpan2dist @@ -0,0 +1,671 @@ +#!/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<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 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<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: |