different
versions of perl.
cpan The CPAN shell.
- cpan2dist The CPANPLUS distribution creator.
- cpanp The CPANPLUS shell.
- cpanp-run-perl A helper for cpanp.
enc2xs Encoding module generator.
find2perl find-to-perl translator.
h2ph Extract constants and simple macros from C
cpan/CPAN/PAUSE2007.pub CPAN public key
cpan/CPAN/PAUSE2009.pub CPAN public key
cpan/CPAN/PAUSE2011.pub
-cpan/CPANPLUS/bin/cpan2dist the cpan2dist utility
-cpan/CPANPLUS/bin/cpanp the cpanp utility
-cpan/CPANPLUS/bin/cpanp-run-perl the cpanp-run-perl utility
-cpan/CPANPLUS/lib/CPANPLUS/Backend.pm CPANPLUS
-cpan/CPANPLUS/lib/CPANPLUS/Backend/RV.pm CPANPLUS
-cpan/CPANPLUS/lib/CPANPLUS/Config/HomeEnv.pm
-cpan/CPANPLUS/lib/CPANPLUS/Config.pm CPANPLUS
-cpan/CPANPLUS/lib/CPANPLUS/Configure.pm CPANPLUS
-cpan/CPANPLUS/lib/CPANPLUS/Configure/Setup.pm CPANPLUS
-cpan/CPANPLUS/lib/CPANPLUS/Dist/Autobundle.pm CPANPLUS
-cpan/CPANPLUS/lib/CPANPLUS/Dist/Base.pm CPANPLUS
-cpan/CPANPLUS/lib/CPANPLUS/Dist/MM.pm CPANPLUS
-cpan/CPANPLUS/lib/CPANPLUS/Dist.pm CPANPLUS
-cpan/CPANPLUS/lib/CPANPLUS/Dist/Sample.pm CPANPLUS
-cpan/CPANPLUS/lib/CPANPLUS/Error.pm CPANPLUS
-cpan/CPANPLUS/lib/CPANPLUS/FAQ.pod CPANPLUS
-cpan/CPANPLUS/lib/CPANPLUS/Hacking.pod CPANPLUS
-cpan/CPANPLUS/lib/CPANPLUS/Internals/Constants.pm CPANPLUS
-cpan/CPANPLUS/lib/CPANPLUS/Internals/Constants/Report.pm CPANPLUS
-cpan/CPANPLUS/lib/CPANPLUS/Internals/Extract.pm CPANPLUS
-cpan/CPANPLUS/lib/CPANPLUS/Internals/Fetch.pm CPANPLUS
-cpan/CPANPLUS/lib/CPANPLUS/Internals.pm CPANPLUS
-cpan/CPANPLUS/lib/CPANPLUS/Internals/Report.pm CPANPLUS
-cpan/CPANPLUS/lib/CPANPLUS/Internals/Search.pm CPANPLUS
-cpan/CPANPLUS/lib/CPANPLUS/Internals/Source/Memory.pm CPANPLUS
-cpan/CPANPLUS/lib/CPANPLUS/Internals/Source.pm CPANPLUS
-cpan/CPANPLUS/lib/CPANPLUS/Internals/Source/SQLite.pm CPANPLUS
-cpan/CPANPLUS/lib/CPANPLUS/Internals/Source/SQLite/Tie.pm CPANPLUS
-cpan/CPANPLUS/lib/CPANPLUS/Internals/Utils/Autoflush.pm CPANPLUS
-cpan/CPANPLUS/lib/CPANPLUS/Internals/Utils.pm CPANPLUS
-cpan/CPANPLUS/lib/CPANPLUS/Module/Author/Fake.pm CPANPLUS
-cpan/CPANPLUS/lib/CPANPLUS/Module/Author.pm CPANPLUS
-cpan/CPANPLUS/lib/CPANPLUS/Module/Checksums.pm CPANPLUS
-cpan/CPANPLUS/lib/CPANPLUS/Module/Fake.pm CPANPLUS
-cpan/CPANPLUS/lib/CPANPLUS/Module.pm CPANPLUS
-cpan/CPANPLUS/lib/CPANPLUS/Module/Signature.pm CPANPLUS
-cpan/CPANPLUS/lib/CPANPLUS.pm CPANPLUS
-cpan/CPANPLUS/lib/CPANPLUS/Selfupdate.pm CPANPLUS
-cpan/CPANPLUS/lib/CPANPLUS/Shell/Classic.pm CPANPLUS
-cpan/CPANPLUS/lib/CPANPLUS/Shell/Default/Plugins/CustomSource.pm CPANPLUS
-cpan/CPANPLUS/lib/CPANPLUS/Shell/Default/Plugins/HOWTO.pod CPANPLUS
-cpan/CPANPLUS/lib/CPANPLUS/Shell/Default/Plugins/Remote.pm CPANPLUS
-cpan/CPANPLUS/lib/CPANPLUS/Shell/Default/Plugins/Source.pm CPANPLUS
-cpan/CPANPLUS/lib/CPANPLUS/Shell/Default.pm CPANPLUS
-cpan/CPANPLUS/lib/CPANPLUS/Shell.pm CPANPLUS
-cpan/CPANPLUS/Makefile.PL
-cpan/CPANPLUS/t/00_CPANPLUS-Internals-Utils.t CPANPLUS tests
-cpan/CPANPLUS/t/01_CPANPLUS-Configure.t CPANPLUS tests
-cpan/CPANPLUS/t/02_CPANPLUS-Internals.t CPANPLUS tests
-cpan/CPANPLUS/t/03_CPANPLUS-Internals-Source.t CPANPLUS tests
-cpan/CPANPLUS/t/04_CPANPLUS-Module.t CPANPLUS tests
-cpan/CPANPLUS/t/05_CPANPLUS-Internals-Fetch.t CPANPLUS tests
-cpan/CPANPLUS/t/06_CPANPLUS-Internals-Constants.t CPANPLUS tests
-cpan/CPANPLUS/t/07_CPANPLUS-Internals-Extract.t CPANPLUS tests
-cpan/CPANPLUS/t/08_CPANPLUS-Backend.t CPANPLUS tests
-cpan/CPANPLUS/t/09_CPANPLUS-Internals-Search.t CPANPLUS tests
-cpan/CPANPLUS/t/10_CPANPLUS-Error.t CPANPLUS tests
-cpan/CPANPLUS/t/15_CPANPLUS-Shell.t CPANPLUS tests
-cpan/CPANPLUS/t/19_CPANPLUS-Dist.t CPANPLUS tests
-cpan/CPANPLUS/t/20_CPANPLUS-Dist-MM.t CPANPLUS tests
-cpan/CPANPLUS/t/21_CPANPLUS-Dist-No-Build.t CPANPLUS tests
-cpan/CPANPLUS/t/25_CPANPLUS.t CPANPLUS tests
-cpan/CPANPLUS/t/30_CPANPLUS-Internals-Selfupdate.t CPANPLUS tests
-cpan/CPANPLUS/t/40_CPANPLUS-Internals-Report.t CPANPLUS tests
-cpan/CPANPLUS/t/dummy-CPAN/authors/01mailrc.txt.gz CPANPLUS tests
-cpan/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/Bundle-Foo-Bar-0.01.tar.gz CPANPLUS tests
-cpan/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/CHECKSUMS CPANPLUS tests
-cpan/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/Foo-Bar-0.01.meta CPANPLUS tests
-cpan/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/Foo-Bar-0.01.readme CPANPLUS tests
-cpan/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/Foo-Bar-0.01.tar.gz CPANPLUS tests
-cpan/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/perl5.005_03.tar.gz CPANPLUS tests
-cpan/CPANPLUS/t/dummy-CPAN/authors/id/EUXS/CHECKSUMS CPANPLUS tests
-cpan/CPANPLUS/t/dummy-CPAN/authors/id/EUXS/Foo-Bar-0.01.readme CPANPLUS tests
-cpan/CPANPLUS/t/dummy-CPAN/authors/id/EUXS/Foo-Bar-0.01.tar.gz CPANPLUS tests
-cpan/CPANPLUS/t/dummy-CPAN/authors/id/MBNOXS/CHECKSUMS CPANPLUS tests
-cpan/CPANPLUS/t/dummy-CPAN/authors/id/MBNOXS/Foo-Bar-0.01.readme CPANPLUS tests
-cpan/CPANPLUS/t/dummy-CPAN/authors/id/MBNOXS/Foo-Bar-0.01.tar.gz CPANPLUS tests
-cpan/CPANPLUS/t/dummy-CPAN/authors/id/MBXS/CHECKSUMS CPANPLUS tests
-cpan/CPANPLUS/t/dummy-CPAN/authors/id/MBXS/Foo-Bar-0.01.readme CPANPLUS tests
-cpan/CPANPLUS/t/dummy-CPAN/authors/id/MBXS/Foo-Bar-0.01.tar.gz CPANPLUS tests
-cpan/CPANPLUS/t/dummy-CPAN/autobundle/Snapshot.pm CPANPLUS tests
-cpan/CPANPLUS/t/dummy-CPAN/modules/02packages.details.txt.gz CPANPLUS tests
-cpan/CPANPLUS/t/dummy-CPAN/modules/03modlist.data.gz CPANPLUS tests
-cpan/CPANPLUS/t/inc/conf.pl CPANPLUS tests
cpan/CPAN/scripts/cpan easily interact with CPAN from the command line
cpan/CPAN/t/01loadme.t See if CPAN the module works
cpan/CPAN/t/02nox.t See if CPAN::Nox works
utils/c2ph.PL program to translate dbx stabs to perl
utils/config_data.PL Module::Build tool
utils/corelist.PL Module::CoreList
-utils/cpan2dist.PL the cpan2dist utility
utils/cpan.PL easily interact with CPAN from the command line
-utils/cpanp.PL the cpanp utility
-utils/cpanp-run-perl.PL the cpanp-run-perl utility
utils/enc2xs.PL Encode module generator
utils/h2ph.PL A thing to turn C .h files into perl .ph files
utils/h2xs.PL Program to make .xs files from C header files
rm -f lib/ExtUtils/ParseXS/t/XSTest$(OBJ_EXT)
rm -f lib/ExtUtils/ParseXS/t/XSTest$(DLSUFFIX)
rm -fr lib/B
- rm -fr lib/CPAN lib/CPANPLUS
+ rm -fr lib/CPAN
rm -fr lib/ExtUtils/CBuilder
rm -f pod2htmd.tmp
rm -rf pod/perlfunc pod/perlipc
- -rmdir cpan/CPANPLUS/t/dummy-cpanplus cpan/CPANPLUS/t/dummy-localmirror
-rmdir ext/B/lib
-rmdir lib/Archive/Tar lib/Archive lib/Attribute
-rmdir lib/CGI lib/Carp
'UPSTREAM' => 'cpan',
},
- 'CPANPLUS' => {
- 'MAINTAINER' => 'kane',
- 'DISTRIBUTION' => 'BINGOS/CPANPLUS-0.9134.tar.gz',
- 'FILES' => q[cpan/CPANPLUS],
- 'EXCLUDED' => [
- qr{^inc/},
- qr{^t/dummy-.*\.hidden$},
- qr{^t/dummy-(cpanplus|perl|localmirror)/},
- 'bin/cpanp-boxed',
-
- # SQLite tests would be skipped in core, and
- # the filenames are too long for VMS!
- qw( t/031_CPANPLUS-Internals-Source-SQLite.t
- t/032_CPANPLUS-Internals-Source-via-sqlite.t
- ),
- 'Makefile.PL',
- ],
- 'CUSTOMIZED' => ['Makefile.PL'],
- 'UPSTREAM' => 'cpan',
- 'BUGS' => 'bug-cpanplus@rt.cpan.org',
- 'DEPRECATED' => '5.017009',
- },
-
'CPAN::Meta' => {
'MAINTAINER' => 'dagolden',
'DISTRIBUTION' => 'DAGOLDEN/CPAN-Meta-2.120921.tar.gz',
42
$
-=head4 Bootstrap the CPANPLUS client
-
-Bootstrap the CPANPLUS client on the clean install:
-
- $ bin/cpanp
-
-=head4 Install the DBI module with CPANPLUS
-
- CPAN Terminal> i DBI
- CPAN Terminal> quit
- $ bin/perl -MDBI -e 1
- $
-
=head4 Make sure that perlbug works
Test L<perlbug> with the following:
ext/Win32CORE/Win32CORE.pm
- History of Win32CORE under Cygwin
lib/CGI.pm - binmode and path separator
- lib/CPANPLUS/Dist/MM.pm - Commented out code that fails under Win32/Cygwin
- lib/CPANPLUS/Internals/Constants/Report.pm
- - OS classifications
- lib/CPANPLUS/Internals/Constants.pm
- - Constants for Cygwin
- lib/CPANPLUS/Internals/Report.pm
- - Example of Cygwin report
- lib/CPANPLUS/Module.pm
- - Abort if running on old Cygwin version
lib/Cwd.pm - hook to internal Cwd::cwd
lib/ExtUtils/CBuilder/Platform/cygwin.pm
- use gcc for ld, and link to libperl.dll.a
lib/AnyDBM_File.t
lib/Archive/Extract/t/01_Archive-Extract.t
lib/Archive/Tar/t/02_methods.t
- lib/CPANPLUS/t/05_CPANPLUS-Internals-Fetch.t
- lib/CPANPLUS/t/20_CPANPLUS-Dist-MM.t
lib/ExtUtils/t/Embed.t
lib/ExtUtils/t/eu_command.t
lib/ExtUtils/t/MM_Cygwin.t
$ WRITE CONFIG "$ config_data== """ + perl_setup_perl + " ''vms_prefix':[utils]config_data.com"""
$ WRITE CONFIG "$ corelist == """ + perl_setup_perl + " ''vms_prefix':[utils]corelist.com"""
$ WRITE CONFIG "$ cpan == """ + perl_setup_perl + " ''vms_prefix':[utils]cpan.com"""
-$ WRITE CONFIG "$ cpan2dist == """ + perl_setup_perl + " ''vms_prefix':[utils]cpan2dist.com"""
-$! FIXME: "-" is an operator and illegal in a symbol name -- cpanp-run-perl can't work
-$!$ WRITE CONFIG "$ cpanp-run-perl == """ + perl_setup_perl + " ''vms_prefix':[utils]cpanp-run-perl.com"""
-$ WRITE CONFIG "$ cpanp == """ + perl_setup_perl + " ''vms_prefix':[utils]cpanp.com"""
$ WRITE CONFIG "$ enc2xs == """ + perl_setup_perl + " ''vms_prefix':[utils]enc2xs.com"""
$ WRITE CONFIG "$ find2perl == """ + perl_setup_perl + " ''vms_prefix':[utils]find2perl.com"""
$ WRITE CONFIG "$ h2ph == """ + perl_setup_perl + " ''vms_prefix':[utils]h2ph.com"""
+++ /dev/null
-use strict;
-use ExtUtils::MakeMaker;
-
-WriteMakefile (
- NAME => 'CPANPLUS',
- VERSION_FROM => 'lib/CPANPLUS/Internals.pm', # finds $VERSION
- EXE_FILES => ['bin/cpan2dist','bin/cpanp','bin/cpanp-run-perl'],
- INSTALLDIRS => ( $] >= 5.009005 ? 'perl' : 'site' ),
- AUTHOR => 'Jos Boumans <kane[at]cpan.org>',
- ABSTRACT => 'Ameliorated interface to the CPAN'
-);
+++ /dev/null
-#!/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() 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. 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 libaries
- ^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:
+++ /dev/null
-#!/usr/bin/perl
-# $File: //depot/cpanplus/dist/bin/cpanp $
-# $Revision: #8 $ $Change: 8345 $ $DateTime: 2003/10/05 19:25:48 $
-
-use strict;
-use vars '$VERSION';
-
-use CPANPLUS;
-$VERSION = CPANPLUS->VERSION;
-
-use CPANPLUS::Shell qw[Default];
-my $shell = CPANPLUS::Shell->new;
-
-### if we're given a command, run it; otherwise, open a shell.
-if (@ARGV) {
- ### take the command line arguments as a command
- my $input = "@ARGV";
- ### if they said "--help", fix it up to work.
- $input = 'h' if $input =~ /^\s*--?h(?:elp)?\s*$/i;
- ### strip the leading dash
- $input =~ s/^\s*-//;
- ### pass the command line to the shell
- ### exit with a useful return value on return
- exit not $shell->dispatch_on_input(input => $input, noninteractive => 1);
-} else {
- ### open a shell for the user
- $shell->shell();
-}
-
-=head1 NAME
-
-cpanp - The CPANPLUS launcher
-
-=head1 SYNOPSIS
-
-B<cpanp>
-
-B<cpanp> S<[-]B<a>> S<[ --[B<no>-]I<option>... ]> S< I<author>... >
-
-B<cpanp> S<[-]B<mfitulrcz>> S<[ --[B<no>-]I<option>... ]> S< I<module>... >
-
-B<cpanp> S<[-]B<d>> S<[ --[B<no>-]I<option>... ]> S<[ --B<fetchdir>=... ]> S< I<module>... >
-
-B<cpanp> S<[-]B<xb>> S<[ --[B<no>-]I<option>... ]>
-
-B<cpanp> S<[-]B<o>> S<[ --[B<no>-]I<option>... ]> S<[ I<module>... ]>
-
-=head1 DESCRIPTION
-
-This script launches the B<CPANPLUS> utility to perform various operations
-from the command line. If it's invoked without arguments, an interactive
-shell is executed by default.
-
-Optionally, it can take a single-letter switch and one or more argument,
-to perform the associated action on each arguments. A summary of the
-available commands is listed below; C<cpanp -h> provides a detailed list.
-
- h # help information
- v # version information
-
- a AUTHOR ... # search by author(s)
- m MODULE ... # search by module(s)
- f MODULE ... # list all releases of a module
-
- i MODULE ... # install module(s)
- t MODULE ... # test module(s)
- u MODULE ... # uninstall module(s)
- d MODULE ... # download module(s)
- l MODULE ... # display detailed information about module(s)
- r MODULE ... # display README files of module(s)
- c MODULE ... # check for module report(s) from cpan-testers
- z MODULE ... # extract module(s) and open command prompt in it
-
- x # reload CPAN indices
-
- o [ MODULE ... ] # list installed module(s) that aren't up to date
- b # write a bundle file for your configuration
-
-Each command may be followed by one or more I<options>. If preceded by C<no>,
-the corresponding option will be set to C<0>, otherwise it's set to C<1>.
-
-Example: To skip a module's tests,
-
- cpanp -i --skiptest MODULE ...
-
-Valid options for most commands are C<cpantest>, C<debug>, C<flush>, C<force>,
-C<prereqs>, C<storable>, C<verbose>, C<md5>, C<signature>, and C<skiptest>; the
-'d' command also accepts C<fetchdir>. Please consult L<CPANPLUS::Configure>
-for an explanation to their meanings.
-
-Example: To download a module's tarball to the current directory,
-
- cpanp -d --fetchdir=. MODULE ...
-
-=cut
-
-1;
-
-# Local variables:
-# c-indentation-style: bsd
-# c-basic-offset: 4
-# indent-tabs-mode: nil
-# End:
-# vim: expandtab shiftwidth=4:
+++ /dev/null
-use strict;
-BEGIN {
-my $old = select STDERR; $|++; # turn on autoflush
-select $old; $|++; # turn on autoflush
-$0 = shift(@ARGV); # rename the script
-my $rv = do($0); # execute the file
-die $@ if $@; # die on parse/execute error
-}
-### XXX 'do' returns last statement evaluated, which may be
-### undef as well. So don't die in that case.
-#die $! if not defined $rv; # die on execute error
+++ /dev/null
-package CPANPLUS;
-use deprecate;
-
-use strict;
-use Carp;
-
-use CPANPLUS::Error;
-use CPANPLUS::Backend;
-
-use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';
-
-BEGIN {
- use Exporter ();
- use vars qw( @EXPORT @ISA $VERSION );
- @EXPORT = qw( shell fetch get install );
- @ISA = qw( Exporter );
- $VERSION = "0.9135"; #have to hardcode or cpan.org gets unhappy
-}
-
-### purely for backward compatibility, so we can call it from the commandline:
-### perl -MCPANPLUS -e 'install Net::SMTP'
-sub install {
- my $cpan = CPANPLUS::Backend->new;
- my $mod = shift or (
- error(loc("No module specified!")), return
- );
-
- if ( ref $mod ) {
- error( loc( "You passed an object. Use %1 for OO style interaction",
- 'CPANPLUS::Backend' ));
- return;
-
- } else {
- my $obj = $cpan->module_tree($mod) or (
- error(loc("No such module '%1'", $mod)),
- return
- );
-
- my $ok = $obj->install;
-
- $ok
- ? msg(loc("Installing of %1 successful", $mod),1)
- : msg(loc("Installing of %1 failed", $mod),1);
-
- return $ok;
- }
-}
-
-### simply downloads a module and stores it
-sub fetch {
- my $cpan = CPANPLUS::Backend->new;
-
- my $mod = shift or (
- error(loc("No module specified!")), return
- );
-
- if ( ref $mod ) {
- error( loc( "You passed an object. Use %1 for OO style interaction",
- 'CPANPLUS::Backend' ));
- return;
-
- } else {
- my $obj = $cpan->module_tree($mod) or (
- error(loc("No such module '%1'", $mod)),
- return
- );
-
- my $ok = $obj->fetch( fetchdir => '.' );
-
- $ok
- ? msg(loc("Fetching of %1 successful", $mod),1)
- : msg(loc("Fetching of %1 failed", $mod),1);
-
- return $ok;
- }
-}
-
-### alias to fetch() due to compatibility with cpan.pm ###
-sub get { fetch(@_) }
-
-
-### purely for backwards compatibility, so we can call it from the commandline:
-### perl -MCPANPLUS -e 'shell'
-sub shell {
- my $option = shift;
-
- ### since the user can specify the type of shell they wish to start
- ### when they call the shell() function, we have to eval the usage
- ### of CPANPLUS::Shell so we can set up all the checks properly
- eval { require CPANPLUS::Shell; CPANPLUS::Shell->import($option) };
- die $@ if $@;
-
- my $cpan = CPANPLUS::Shell->new();
-
- $cpan->shell();
-}
-
-1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-CPANPLUS - API & CLI access to the CPAN mirrors
-
-=head1 SYNOPSIS
-
- ### standard invocation from the command line
- $ cpanp
- $ cpanp -i Some::Module
-
- $ perl -MCPANPLUS -eshell
- $ perl -MCPANPLUS -e'fetch Some::Module'
-
-
-=head1 DESCRIPTION
-
-The C<CPANPLUS> library is an API to the C<CPAN> mirrors and a
-collection of interactive shells, commandline programs, etc,
-that use this API.
-
-=head1 GUIDE TO DOCUMENTATION
-
-=head2 GENERAL USAGE
-
-This is the document you are currently reading. It describes
-basic usage and background information. Its main purpose is to
-assist the user who wants to learn how to invoke CPANPLUS
-and install modules from the commandline and to point you
-to more indepth reading if required.
-
-=head2 API REFERENCE
-
-The C<CPANPLUS> API is meant to let you programmatically
-interact with the C<CPAN> mirrors. The documentation in
-L<CPANPLUS::Backend> shows you how to create an object
-capable of interacting with those mirrors, letting you
-create & retrieve module objects.
-L<CPANPLUS::Module> shows you how you can use these module
-objects to perform actions like installing and testing.
-
-The default shell, documented in L<CPANPLUS::Shell::Default>
-is also scriptable. You can use its API to dispatch calls
-from your script to the CPANPLUS Shell.
-
-=cut
-
-=head1 COMMANDLINE TOOLS
-
-=head2 STARTING AN INTERACTIVE SHELL
-
-You can start an interactive shell by running either of
-the two following commands:
-
- $ cpanp
-
- $ perl -MCPANPLUS -eshell
-
-All commands available are listed in the interactive shells
-help menu. See C<cpanp -h> or L<CPANPLUS::Shell::Default>
-for instructions on using the default shell.
-
-=head2 CHOOSE A SHELL
-
-By running C<cpanp> without arguments, you will start up
-the shell specified in your config, which defaults to
-L<CPANPLUS::Shell::Default>. There are more shells available.
-C<CPANPLUS> itself ships with an emulation shell called
-L<CPANPLUS::Shell::Classic> that looks and feels just like
-the old C<CPAN.pm> shell.
-
-You can start this shell by typing:
-
- $ perl -MCPANPLUS -e'shell Classic'
-
-Even more shells may be available from C<CPAN>.
-
-Note that if you have changed your default shell in your
-configuration, that shell will be used instead. If for
-some reason there was an error with your specified shell,
-you will be given the default shell.
-
-=head2 BUILDING PACKAGES
-
-C<cpan2dist> is a commandline tool to convert any distribution
-from C<CPAN> into a package in the format of your choice, like
-for example C<.deb> or C<FreeBSD ports>.
-
-See C<cpan2dist -h> for details.
-
-
-=head1 FUNCTIONS
-
-For quick access to common commands, you may use this module,
-C<CPANPLUS> rather than the full programmatic API situated in
-C<CPANPLUS::Backend>. This module offers the following functions:
-
-=head2 $bool = install( Module::Name | /A/AU/AUTHOR/Module-Name-1.tgz )
-
-This function requires the full name of the module, which is case
-sensitive. The module name can also be provided as a fully
-qualified file name, beginning with a I</>, relative to
-the /authors/id directory on a CPAN mirror.
-
-It will download, extract and install the module.
-
-=head2 $where = fetch( Module::Name | /A/AU/AUTHOR/Module-Name-1.tgz )
-
-Like install, fetch needs the full name of a module or the fully
-qualified file name, and is case sensitive.
-
-It will download the specified module to the current directory.
-
-=head2 $where = get( Module::Name | /A/AU/AUTHOR/Module-Name-1.tgz )
-
-Get is provided as an alias for fetch for compatibility with
-CPAN.pm.
-
-=head2 shell()
-
-Shell starts the default CPAN shell. You can also start the shell
-by using the C<cpanp> command, which will be installed in your
-perl bin.
-
-=head1 FAQ
-
-For frequently asked questions and answers, please consult the
-C<CPANPLUS::FAQ> manual.
-
-=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.
-
-=head1 SEE ALSO
-
-L<CPANPLUS::Shell::Default>, L<CPANPLUS::FAQ>, L<CPANPLUS::Backend>, L<CPANPLUS::Module>, L<cpanp>, L<cpan2dist>
-
-=head1 CONTACT INFORMATION
-
-=over 4
-
-=item * Bug reporting:
-I<bug-cpanplus@rt.cpan.org>
-
-=item * Questions & suggestions:
-I<bug-cpanplus@rt.cpan.org>
-
-=back
-
-
-=cut
-
-# Local variables:
-# c-indentation-style: bsd
-# c-basic-offset: 4
-# indent-tabs-mode: nil
-# End:
-# vim: expandtab shiftwidth=4:
+++ /dev/null
-package CPANPLUS::Backend;
-use deprecate;
-
-use strict;
-
-
-use CPANPLUS::Error;
-use CPANPLUS::Configure;
-use CPANPLUS::Internals;
-use CPANPLUS::Internals::Constants;
-use CPANPLUS::Module;
-use CPANPLUS::Module::Author;
-use CPANPLUS::Backend::RV;
-
-use FileHandle;
-use File::Spec ();
-use File::Spec::Unix ();
-use File::Basename ();
-use Params::Check qw[check];
-use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';
-
-$Params::Check::VERBOSE = 1;
-
-use vars qw[@ISA $VERSION];
-
-@ISA = qw[CPANPLUS::Internals];
-$VERSION = "0.9135";
-
-### mark that we're running under CPANPLUS to spawned processes
-$ENV{'PERL5_CPANPLUS_IS_RUNNING'} = $$;
-
-### XXX version.pm MAY format this version, if it's in use... :(
-### so for consistency, just call ->VERSION ourselves as well.
-$ENV{'PERL5_CPANPLUS_IS_VERSION'} = __PACKAGE__->VERSION;
-
-=pod
-
-=head1 NAME
-
-CPANPLUS::Backend - programmer's interface to CPANPLUS
-
-=head1 SYNOPSIS
-
- my $cb = CPANPLUS::Backend->new;
- my $conf = $cb->configure_object;
-
- my $author = $cb->author_tree('KANE');
- my $mod = $cb->module_tree('Some::Module');
- my $mod = $cb->parse_module( module => 'Some::Module' );
-
- my @objs = $cb->search( type => TYPE,
- allow => [...] );
-
- $cb->flush('all');
- $cb->reload_indices;
- $cb->local_mirror;
-
-
-=head1 DESCRIPTION
-
-This module provides the programmer's interface to the C<CPANPLUS>
-libraries.
-
-=head1 ENVIRONMENT
-
-When C<CPANPLUS::Backend> is loaded, which is necessary for just
-about every <CPANPLUS> operation, the environment variable
-C<PERL5_CPANPLUS_IS_RUNNING> is set to the current process id.
-
-Additionally, the environment variable C<PERL5_CPANPLUS_IS_VERSION>
-will be set to the version of C<CPANPLUS::Backend>.
-
-This information might be useful somehow to spawned processes.
-
-=head1 METHODS
-
-=head2 $cb = CPANPLUS::Backend->new( [CONFIGURE_OBJ] )
-
-This method returns a new C<CPANPLUS::Backend> object.
-This also initialises the config corresponding to this object.
-You have two choices in this:
-
-=over 4
-
-=item Provide a valid C<CPANPLUS::Configure> object
-
-This will be used verbatim.
-
-=item No arguments
-
-Your default config will be loaded and used.
-
-=back
-
-New will return a C<CPANPLUS::Backend> object on success and die on
-failure.
-
-=cut
-
-sub new {
- my $class = shift;
- my $conf;
-
- if( $_[0] && IS_CONFOBJ->( conf => $_[0] ) ) {
- $conf = shift;
- } else {
- $conf = CPANPLUS::Configure->new() or return;
- }
-
- my $self = $class->SUPER::_init( _conf => $conf );
-
- return $self;
-}
-
-=pod
-
-=head2 $href = $cb->module_tree( [@modules_names_list] )
-
-Returns a reference to the CPANPLUS module tree.
-
-If you give it any arguments, they will be treated as module names
-and C<module_tree> will try to look up these module names and
-return the corresponding module objects instead.
-
-See L<CPANPLUS::Module> for the operations you can perform on a
-module object.
-
-=cut
-
-sub module_tree {
- my $self = shift;
- my $modtree = $self->_module_tree;
-
- if( @_ ) {
- my @rv;
- for my $name ( grep { defined } @_) {
-
- ### From John Malmberg: This is failing on VMS
- ### because ODS-2 does not retain the case of
- ### filenames that are created.
- ### The problem is the filename is being converted
- ### to a module name and then looked up in the
- ### %$modtree hash.
- ###
- ### As a fix, we do a search on VMS instead --
- ### more cpu cycles, but it gets around the case
- ### problem --kane
- my ($modobj) = do {
- ON_VMS
- ? $self->search(
- type => 'module',
- allow => [qr/^$name$/i],
- )
- : $modtree->{$name}
- };
-
- push @rv, $modobj || '';
- }
- return @rv == 1 ? $rv[0] : @rv;
- } else {
- return $modtree;
- }
-}
-
-=pod
-
-=head2 $href = $cb->author_tree( [@author_names_list] )
-
-Returns a reference to the CPANPLUS author tree.
-
-If you give it any arguments, they will be treated as author names
-and C<author_tree> will try to look up these author names and
-return the corresponding author objects instead.
-
-See L<CPANPLUS::Module::Author> for the operations you can perform on
-an author object.
-
-=cut
-
-sub author_tree {
- my $self = shift;
- my $authtree = $self->_author_tree;
-
- if( @_ ) {
- my @rv;
- for my $name (@_) {
- push @rv, $authtree->{$name} || '';
- }
- return @rv == 1 ? $rv[0] : @rv;
- } else {
- return $authtree;
- }
-}
-
-=pod
-
-=head2 $conf = $cb->configure_object;
-
-Returns a copy of the C<CPANPLUS::Configure> object.
-
-See L<CPANPLUS::Configure> for operations you can perform on a
-configure object.
-
-=cut
-
-sub configure_object { return shift->_conf() };
-
-=head2 $su = $cb->selfupdate_object;
-
-Returns a copy of the C<CPANPLUS::Selfupdate> object.
-
-See the L<CPANPLUS::Selfupdate> manpage for the operations
-you can perform on the selfupdate object.
-
-=cut
-
-sub selfupdate_object { return shift->_selfupdate() };
-
-=pod
-
-=head2 @mods = $cb->search( type => TYPE, allow => AREF, [data => AREF, verbose => BOOL] )
-
-C<search> enables you to search for either module or author objects,
-based on their data. The C<type> you can specify is any of the
-accessors specified in C<CPANPLUS::Module::Author> or
-C<CPANPLUS::Module>. C<search> will determine by the C<type> you
-specified whether to search by author object or module object.
-
-You have to specify an array reference of regular expressions or
-strings to match against. The rules used for this array ref are the
-same as in C<Params::Check>, so read that manpage for details.
-
-The search is an C<or> search, meaning that if C<any> of the criteria
-match, the search is considered to be successful.
-
-You can specify the result of a previous search as C<data> to limit
-the new search to these module or author objects, rather than the
-entire module or author tree. This is how you do C<and> searches.
-
-Returns a list of module or author objects on success and false
-on failure.
-
-See L<CPANPLUS::Module> for the operations you can perform on a
-module object.
-See L<CPANPLUS::Module::Author> for the operations you can perform on
-an author object.
-
-=cut
-
-sub search {
- my $self = shift;
- my $conf = $self->configure_object;
- my %hash = @_;
-
- my ($type);
- my $args = do {
- local $Params::Check::NO_DUPLICATES = 0;
- local $Params::Check::ALLOW_UNKNOWN = 1;
-
- my $tmpl = {
- type => { required => 1, allow => [CPANPLUS::Module->accessors(),
- CPANPLUS::Module::Author->accessors()], store => \$type },
- allow => { required => 1, default => [ ], strict_type => 1 },
- };
-
- check( $tmpl, \%hash )
- } or return;
-
- ### figure out whether it was an author or a module search
- ### when ambiguous, it'll be an author search.
- my $aref;
- if( grep { $type eq $_ } CPANPLUS::Module::Author->accessors() ) {
- $aref = $self->_search_author_tree( %$args );
- } else {
- $aref = $self->_search_module_tree( %$args );
- }
-
- return @$aref if $aref;
- return;
-}
-
-=pod
-
-=head2 $backend_rv = $cb->fetch( modules => \@mods )
-
-Fetches a list of modules. C<@mods> can be a list of distribution
-names, module names or module objects--basically anything that
-L<parse_module> can understand.
-
-See the equivalent method in C<CPANPLUS::Module> for details on
-other options you can pass.
-
-Since this is a multi-module method call, the return value is
-implemented as a C<CPANPLUS::Backend::RV> object. Please consult
-that module's documentation on how to interpret the return value.
-
-=head2 $backend_rv = $cb->extract( modules => \@mods )
-
-Extracts a list of modules. C<@mods> can be a list of distribution
-names, module names or module objects--basically anything that
-L<parse_module> can understand.
-
-See the equivalent method in C<CPANPLUS::Module> for details on
-other options you can pass.
-
-Since this is a multi-module method call, the return value is
-implemented as a C<CPANPLUS::Backend::RV> object. Please consult
-that module's documentation on how to interpret the return value.
-
-=head2 $backend_rv = $cb->install( modules => \@mods )
-
-Installs a list of modules. C<@mods> can be a list of distribution
-names, module names or module objects--basically anything that
-L<parse_module> can understand.
-
-See the equivalent method in C<CPANPLUS::Module> for details on
-other options you can pass.
-
-Since this is a multi-module method call, the return value is
-implemented as a C<CPANPLUS::Backend::RV> object. Please consult
-that module's documentation on how to interpret the return value.
-
-=head2 $backend_rv = $cb->readme( modules => \@mods )
-
-Fetches the readme for a list of modules. C<@mods> can be a list of
-distribution names, module names or module objects--basically
-anything that L<parse_module> can understand.
-
-See the equivalent method in C<CPANPLUS::Module> for details on
-other options you can pass.
-
-Since this is a multi-module method call, the return value is
-implemented as a C<CPANPLUS::Backend::RV> object. Please consult
-that module's documentation on how to interpret the return value.
-
-=head2 $backend_rv = $cb->files( modules => \@mods )
-
-Returns a list of files used by these modules if they are installed.
-C<@mods> can be a list of distribution names, module names or module
-objects--basically anything that L<parse_module> can understand.
-
-See the equivalent method in C<CPANPLUS::Module> for details on
-other options you can pass.
-
-Since this is a multi-module method call, the return value is
-implemented as a C<CPANPLUS::Backend::RV> object. Please consult
-that module's documentation on how to interpret the return value.
-
-=head2 $backend_rv = $cb->distributions( modules => \@mods )
-
-Returns a list of module objects representing all releases for this
-module on success.
-C<@mods> can be a list of distribution names, module names or module
-objects, basically anything that L<parse_module> can understand.
-
-See the equivalent method in C<CPANPLUS::Module> for details on
-other options you can pass.
-
-Since this is a multi-module method call, the return value is
-implemented as a C<CPANPLUS::Backend::RV> object. Please consult
-that module's documentation on how to interpret the return value.
-
-=cut
-
-### XXX add direcotry_tree, packlist etc? or maybe remove files? ###
-for my $func (qw[fetch extract install readme files distributions]) {
- no strict 'refs';
-
- *$func = sub {
- my $self = shift;
- my $conf = $self->configure_object;
- my %hash = @_;
-
- my ($mods);
- my $args = do {
- local $Params::Check::NO_DUPLICATES = 1;
- local $Params::Check::ALLOW_UNKNOWN = 1;
-
- my $tmpl = {
- modules => { default => [], strict_type => 1,
- required => 1, store => \$mods },
- };
-
- check( $tmpl, \%hash );
- } or return;
-
- ### make them all into module objects ###
- my %mods = map { $_ => $self->parse_module(module => $_) || '' } @$mods;
-
- my $flag; my $href;
- while( my($name,$obj) = each %mods ) {
- $href->{$name} = IS_MODOBJ->( mod => $obj )
- ? $obj->$func( %$args )
- : undef;
-
- $flag++ unless $href->{$name};
- }
-
- return CPANPLUS::Backend::RV->new(
- function => $func,
- ok => ( !$flag ? 1 : 0 ),
- rv => $href,
- args => \%hash,
- );
- }
-}
-
-=pod
-
-=head2 $mod_obj = $cb->parse_module( module => $modname|$distname|$modobj|URI|PATH )
-
-C<parse_module> tries to find a C<CPANPLUS::Module> object that
-matches your query. Here's a list of examples you could give to
-C<parse_module>;
-
-=over 4
-
-=item Text::Bastardize
-
-=item Text-Bastardize
-
-=item Text/Bastardize.pm
-
-=item Text-Bastardize-1.06
-
-=item AYRNIEU/Text-Bastardize
-
-=item AYRNIEU/Text-Bastardize-1.06
-
-=item AYRNIEU/Text-Bastardize-1.06.tar.gz
-
-=item http://example.com/Text-Bastardize-1.06.tar.gz
-
-=item file:///tmp/Text-Bastardize-1.06.tar.gz
-
-=item /tmp/Text-Bastardize-1.06
-
-=item ./Text-Bastardize-1.06
-
-=item .
-
-=back
-
-These items would all come up with a C<CPANPLUS::Module> object for
-C<Text::Bastardize>. The ones marked explicitly as being version 1.06
-would give back a C<CPANPLUS::Module> object of that version.
-Even if the version on CPAN is currently higher.
-
-The last three are examples of PATH resolution. In the first, we supply
-an absolute path to the unwrapped distribution. In the second the
-distribution is relative to the current working directory.
-In the third, we will use the current working directory.
-
-If C<parse_module> is unable to actually find the module you are looking
-for in its module tree, but you supplied it with an author, module
-and version part in a distribution name or URI, it will create a fake
-C<CPANPLUS::Module> object for you, that you can use just like the
-real thing.
-
-See L<CPANPLUS::Module> for the operations you can perform on a
-module object.
-
-If even this fancy guessing doesn't enable C<parse_module> to create
-a fake module object for you to use, it will warn about an error and
-return false.
-
-=cut
-
-sub parse_module {
- my $self = shift;
- my $conf = $self->configure_object;
- my %hash = @_;
-
- my $mod;
- my $tmpl = {
- module => { required => 1, store => \$mod },
- };
-
- my $args = check( $tmpl, \%hash ) or return;
-
- return $mod if IS_MODOBJ->( module => $mod );
-
- ### ok, so it's not a module object, but a ref nonetheless?
- ### what are you smoking?
- if( ref $mod ) {
- error(loc("Can not parse module string from reference '%1'", $mod ));
- return;
- }
-
- ### check only for allowed characters in a module name
- unless( $mod =~ /[^\w:]/ ) {
-
- ### perhaps we can find it in the module tree?
- my $maybe = $self->module_tree($mod);
- return $maybe if IS_MODOBJ->( module => $maybe );
- }
-
- ### Special case arbitrary file paths such as '.' etc.
- if ( $mod and -d File::Spec->rel2abs($mod) ) {
- my $dir = File::Spec->rel2abs($mod);
- my $parent = File::Spec->rel2abs( File::Spec->catdir( $dir, '..' ) );
-
- ### fix paths on VMS
- if (ON_VMS) {
- $dir = VMS::Filespec::unixify($dir);
- $parent = VMS::Filespec::unixify($parent);
- }
-
- my $dist = $mod = File::Basename::basename($dir);
- $dist .= '-0' unless $dist =~ /\-[0-9._]+$/;
- $dist .= '.tar.gz' unless $dist =~ /\.[A-Za-z]+$/;
-
- my $modobj = CPANPLUS::Module::Fake->new(
- module => $mod,
- version => 0,
- package => $dist,
- path => $parent,
- author => CPANPLUS::Module::Author::Fake->new
- );
-
- ### better guess for the version
- $modobj->version( $modobj->package_version )
- if defined $modobj->package_version;
-
- ### better guess at module name, if possible
- if ( my $pkgname = $modobj->package_name ) {
- $pkgname =~ s/-/::/g;
-
- ### no sense replacing it unless we changed something
- $modobj->module( $pkgname )
- if ($pkgname ne $modobj->package_name) || $pkgname !~ /-/;
- }
-
- $modobj->status->fetch( $parent );
- $modobj->status->extract( $dir );
- $modobj->get_installer_type;
- return $modobj;
- }
-
- ### ok, so it looks like a distribution then?
- my @parts = split '/', $mod;
- my $dist = pop @parts;
-
- ### ah, it's a URL
- if( $mod =~ m|\w+://.+| ) {
- my $modobj = CPANPLUS::Module::Fake->new(
- module => $dist,
- version => 0,
- package => $dist,
- path => File::Spec::Unix->catdir(
- $conf->_get_mirror('base'),
- UNKNOWN_DL_LOCATION ),
- author => CPANPLUS::Module::Author::Fake->new
- );
-
- ### set the fetch_from accessor so we know to by pass the
- ### usual mirrors
- $modobj->status->_fetch_from( $mod );
-
- ### better guess for the version
- $modobj->version( $modobj->package_version )
- if defined $modobj->package_version;
-
- ### better guess at module name, if possible
- if ( my $pkgname = $modobj->package_name ) {
- $pkgname =~ s/-/::/g;
-
- ### no sense replacing it unless we changed something
- $modobj->module( $pkgname )
- if ($pkgname ne $modobj->package_name) || $pkgname !~ /-/;
- }
-
- return $modobj;
- }
-
- # Stolen from cpanminus to support 'Module/Install.pm'
- # type input
- if ( ( my $tmpmod = $mod ) =~ s/\.pm$//i ) {
- my ($volume, $dirs, $file) = File::Spec->splitpath( $tmpmod );
- $tmpmod = join '::', grep { $_ } File::Spec->splitdir( $dirs ), $file;
- ### perhaps we can find it in the module tree?
- my $maybe = $self->module_tree( $tmpmod );
- return $maybe if IS_MODOBJ->( module => $maybe );
- }
-
- ### perhaps we can find it's a third party module?
- { my $modobj = CPANPLUS::Module::Fake->new(
- module => $mod,
- version => 0,
- package => $dist,
- path => File::Spec::Unix->catdir(
- $conf->_get_mirror('base'),
- UNKNOWN_DL_LOCATION ),
- author => CPANPLUS::Module::Author::Fake->new
- );
- if( $modobj->is_third_party ) {
- my $info = $modobj->third_party_information;
-
- $modobj->author->author( $info->{author} );
- $modobj->author->email( $info->{author_url} );
- $modobj->description( $info->{url} );
-
- return $modobj;
- }
- }
-
- unless( $dist ) {
- error( loc("%1 is not a proper distribution name!", $mod) );
- return;
- }
-
- ### there's wonky uris out there, like this:
- ### E/EY/EYCK/Net/Lite/Net-Lite-FTP-0.091
- ### compensate for that
- my $author;
- ### you probably have an A/AB/ABC/....../Dist.tgz type uri
- if( (defined $parts[0] and length $parts[0] == 1) and
- (defined $parts[1] and length $parts[1] == 2) and
- $parts[2] =~ /^$parts[0]/i and $parts[2] =~ /^$parts[1]/i
- ) {
- splice @parts, 0, 2; # remove the first 2 entries from the list
- $author = shift @parts; # this is the actual author name then
-
- ### we''ll assume a ABC/..../Dist.tgz
- } else {
- $author = shift @parts || '';
- }
-
- my($pkg, $version, $ext, $full) =
- $self->_split_package_string( package => $dist );
-
- ### translate a distribution into a module name ###
- my $guess = $pkg;
- $guess =~ s/-/::/g if $guess;
-
- my $maybe = $self->module_tree( $guess );
- if( IS_MODOBJ->( module => $maybe ) ) {
-
- ### maybe you asked for a package instead
- if ( $maybe->package eq $mod ) {
- return $maybe;
-
- ### perhaps an outdated version instead?
- } elsif ( $version ) {
- my $auth_obj; my $path;
-
- ### did you give us an author part? ###
- if( $author ) {
- $auth_obj = CPANPLUS::Module::Author::Fake->new(
- _id => $maybe->_id,
- cpanid => uc $author,
- author => uc $author,
- );
- $path = File::Spec::Unix->catdir(
- $conf->_get_mirror('base'),
- substr(uc $author, 0, 1),
- substr(uc $author, 0, 2),
- uc $author,
- @parts, #possible sub dirs
- );
- } else {
- $auth_obj = $maybe->author;
- $path = $maybe->path;
- }
-
- if( $maybe->package_name eq $pkg ) {
-
- my $modobj = CPANPLUS::Module::Fake->new(
- module => $maybe->module,
- version => $version,
- ### no extension? use the extension the original package
- ### had instead
- package => do { $ext
- ? $full
- : $full .'.'. $maybe->package_extension
- },
- path => $path,
- author => $auth_obj,
- _id => $maybe->_id
- );
- return $modobj;
-
- ### you asked for a specific version?
- ### assume our $maybe is the one you wanted,
- ### and fix up the version..
- } else {
-
- my $modobj = $maybe->clone;
- $modobj->version( $version );
- $modobj->package(
- $maybe->package_name .'-'.
- $version .'.'.
- $maybe->package_extension
- );
-
- ### you wanted a specific author, but it's not the one
- ### from the module tree? we'll fix it up
- if( $author and $author ne $modobj->author->cpanid ) {
- $modobj->author( $auth_obj );
- $modobj->path( $path );
- }
-
- return $modobj;
- }
-
- ### you didn't care about a version, so just return the object then
- } elsif ( !$version ) {
- return $maybe;
- }
-
- ### ok, so we can't find it, and it's not an outdated dist either
- ### perhaps we can fake one based on the author name and so on
- } elsif ( $author and $version ) {
-
- ### be extra friendly and pad the .tar.gz suffix where needed
- ### it's just a guess of course, but most dists are .tar.gz
- $dist .= '.tar.gz' unless $dist =~ /\.[A-Za-z]+$/;
-
- ### XXX duplication from above for generating author obj + path...
- my $modobj = CPANPLUS::Module::Fake->new(
- module => $guess,
- version => $version,
- package => $dist,
- author => CPANPLUS::Module::Author::Fake->new(
- author => uc $author,
- cpanid => uc $author,
- _id => $self->_id,
- ),
- path => File::Spec::Unix->catdir(
- $conf->_get_mirror('base'),
- substr(uc $author, 0, 1),
- substr(uc $author, 0, 2),
- uc $author,
- @parts, #possible subdirs
- ),
- _id => $self->_id,
- );
-
- return $modobj;
-
- ### face it, we have /no/ idea what he or she wants...
- ### let's start putting the blame somewhere
- } else {
-
- # Lets not give up too easily. There is one last chance
- # http://perlmonks.org/?node_id=805957
- # This should catch edge-cases where the package name
- # is unrelated to the modules it contains.
-
- my ($modobj) = grep { $_->package_name eq $mod }
- $self->search( type => 'package', allow => [ qr/^\Q$mod\E/ ], );
- return $modobj if IS_MODOBJ->( module => $modobj );
-
- unless( $author ) {
- error( loc( "'%1' does not contain an author part", $mod ) );
- }
-
- error( loc( "Cannot find '%1' in the module tree", $mod ) );
- }
-
- return;
-}
-
-=pod
-
-=head2 $bool = $cb->reload_indices( [update_source => BOOL, verbose => BOOL] );
-
-This method reloads the source files.
-
-If C<update_source> is set to true, this will fetch new source files
-from your CPAN mirror. Otherwise, C<reload_indices> will do its
-usual cache checking and only update them if they are out of date.
-
-By default, C<update_source> will be false.
-
-The verbose setting defaults to what you have specified in your
-config file.
-
-Returns true on success and false on failure.
-
-=cut
-
-sub reload_indices {
- my $self = shift;
- my %hash = @_;
- my $conf = $self->configure_object;
-
- my $tmpl = {
- update_source => { default => 0, allow => [qr/^\d$/] },
- verbose => { default => $conf->get_conf('verbose') },
- };
-
- my $args = check( $tmpl, \%hash ) or return;
-
- ### make a call to the internal _module_tree, so it triggers cache
- ### file age
- my $uptodate = $self->_check_trees( %$args );
-
-
- return 1 if $self->_build_trees(
- uptodate => $uptodate,
- use_stored => 0,
- verbose => $conf->get_conf('verbose'),
- );
-
- error( loc( "Error rebuilding source trees!" ) );
-
- return;
-}
-
-=pod
-
-=head2 $bool = $cb->flush(CACHE_NAME)
-
-This method allows flushing of caches.
-There are several things which can be flushed:
-
-=over 4
-
-=item * C<methods>
-
-The return status of methods which have been attempted, such as
-different ways of fetching files. It is recommended that automatic
-flushing be used instead.
-
-=item * C<hosts>
-
-The return status of URIs which have been attempted, such as
-different hosts of fetching files. It is recommended that automatic
-flushing be used instead.
-
-=item * C<modules>
-
-Information about modules such as prerequisites and whether
-installation succeeded, failed, or was not attempted.
-
-=item * C<lib>
-
-This resets PERL5LIB, which is changed to ensure that while installing
-modules they are in our @INC.
-
-=item * C<load>
-
-This resets the cache of modules we've attempted to load, but failed.
-This enables you to load them again after a failed load, if they
-somehow have become available.
-
-=item * C<all>
-
-Flush all of the aforementioned caches.
-
-=back
-
-Returns true on success and false on failure.
-
-=cut
-
-sub flush {
- my $self = shift;
- my $type = shift or return;
-
- my $cache = {
- methods => [ qw( methods load ) ],
- hosts => [ qw( hosts ) ],
- modules => [ qw( modules lib) ],
- lib => [ qw( lib ) ],
- load => [ qw( load ) ],
- all => [ qw( hosts lib modules methods load ) ],
- };
-
- my $aref = $cache->{$type}
- or (
- error( loc("No such cache '%1'", $type) ),
- return
- );
-
- return $self->_flush( list => $aref );
-}
-
-=pod
-
-=head2 @mods = $cb->installed()
-
-Returns a list of module objects of all your installed modules.
-If an error occurs, it will return false.
-
-See L<CPANPLUS::Module> for the operations you can perform on a
-module object.
-
-=cut
-
-sub installed {
- my $self = shift;
- my $aref = $self->_all_installed;
-
- return @$aref if $aref;
- return;
-}
-
-=pod
-
-=head2 $bool = $cb->local_mirror([path => '/dir/to/save/to', index_files => BOOL, force => BOOL, verbose => BOOL] )
-
-Creates a local mirror of CPAN, of only the most recent sources in a
-location you specify. If you set this location equal to a custom host
-in your C<CPANPLUS::Config> you can use your local mirror to install
-from.
-
-It takes the following arguments:
-
-=over 4
-
-=item path
-
-The location where to create the local mirror.
-
-=item index_files
-
-Enable/disable fetching of index files. You can disable fetching of the
-index files if you don't plan to use the local mirror as your primary
-site, or if you'd like up-to-date index files be fetched from elsewhere.
-
-Defaults to true.
-
-=item force
-
-Forces refetching of packages, even if they are there already.
-
-Defaults to whatever setting you have in your C<CPANPLUS::Config>.
-
-=item verbose
-
-Prints more messages about what its doing.
-
-Defaults to whatever setting you have in your C<CPANPLUS::Config>.
-
-=back
-
-Returns true on success and false on error.
-
-=cut
-
-sub local_mirror {
- my $self = shift;
- my $conf = $self->configure_object;
- my %hash = @_;
-
- my($path, $index, $force, $verbose);
- my $tmpl = {
- path => { default => $conf->get_conf('base'),
- store => \$path },
- index_files => { default => 1, store => \$index },
- force => { default => $conf->get_conf('force'),
- store => \$force },
- verbose => { default => $conf->get_conf('verbose'),
- store => \$verbose },
- };
-
- check( $tmpl, \%hash ) or return;
-
- unless( -d $path ) {
- $self->_mkdir( dir => $path )
- or( error( loc( "Could not create '%1', giving up", $path ) ),
- return
- );
- } elsif ( ! -w _ ) {
- error( loc( "Could not write to '%1', giving up", $path ) );
- return;
- }
-
- my $flag;
- AUTHOR: {
- for my $auth ( sort { $a->cpanid cmp $b->cpanid }
- values %{$self->author_tree}
- ) {
-
- MODULE: {
- my $i;
- for my $mod ( $auth->modules ) {
- my $fetchdir = File::Spec->catdir( $path, $mod->path );
-
- my %opts = (
- verbose => $verbose,
- force => $force,
- fetchdir => $fetchdir,
- );
-
- ### only do this the for the first module ###
- unless( $i++ ) {
- $mod->_get_checksums_file(
- %opts
- ) or (
- error( loc( "Could not fetch %1 file, " .
- "skipping author '%2'",
- CHECKSUMS, $auth->cpanid ) ),
- $flag++, next AUTHOR
- );
- }
-
- $mod->fetch( %opts )
- or( error( loc( "Could not fetch '%1'", $mod->module ) ),
- $flag++, next MODULE
- );
- } }
- } }
-
- if( $index ) {
- for my $name (qw[auth dslip mod]) {
- $self->_update_source(
- name => $name,
- verbose => $verbose,
- path => $path,
- ) or ( $flag++, next );
- }
- }
-
- return !$flag;
-}
-
-=pod
-
-=head2 $file = $cb->autobundle([path => OUTPUT_PATH, force => BOOL, verbose => BOOL])
-
-Writes out a snapshot of your current installation in C<CPAN> bundle
-style. This can then be used to install the same modules for a
-different or on a different machine by issuing the following commands:
-
- ### using the default shell:
- CPAN Terminal> i file://path/to/Snapshot_XXYY.pm
-
- ### using the API
- $modobj = $cb->parse_module( module => 'file://path/to/Snapshot_XXYY.pm' );
- $modobj->install;
-
-It will, by default, write to an 'autobundle' directory under your
-cpanplus homedirectory, but you can override that by supplying a
-C<path> argument.
-
-It will return the location of the output file on success and false on
-failure.
-
-=cut
-
-sub autobundle {
- my $self = shift;
- my $conf = $self->configure_object;
- my %hash = @_;
-
- my($path,$force,$verbose);
- my $tmpl = {
- force => { default => $conf->get_conf('force'), store => \$force },
- verbose => { default => $conf->get_conf('verbose'), store => \$verbose },
- path => { default => File::Spec->catdir(
- $conf->get_conf('base'),
- $self->_perl_version( perl => $^X ),
- $conf->_get_build('distdir'),
- $conf->_get_build('autobundle') ),
- store => \$path },
- };
-
- check($tmpl, \%hash) or return;
-
- unless( -d $path ) {
- $self->_mkdir( dir => $path )
- or( error(loc("Could not create directory '%1'", $path ) ),
- return
- );
- }
-
- my $name; my $file;
- { ### default filename for the bundle ###
- my($year,$month,$day) = (localtime)[5,4,3];
- $year += 1900; $month++;
-
- my $ext = 0;
-
- my $prefix = $conf->_get_build('autobundle_prefix');
- my $format = "${prefix}_%04d_%02d_%02d_%02d";
-
- BLOCK: {
- $name = sprintf( $format, $year, $month, $day, $ext);
-
- $file = File::Spec->catfile( $path, $name . '.pm' );
-
- -f $file ? ++$ext && redo BLOCK : last BLOCK;
- }
- }
- my $fh;
- unless( $fh = FileHandle->new( ">$file" ) ) {
- error( loc( "Could not open '%1' for writing: %2", $file, $! ) );
- return;
- }
-
- ### make sure we load the module tree *before* doing this, as it
- ### starts to chdir all over the place
- $self->module_tree;
-
- my $string = join "\n\n",
- map {
- join ' ',
- $_->module,
- ($_->installed_version(verbose => 0) || 'undef')
- } sort {
- $a->module cmp $b->module
- } $self->installed;
-
- my $now = scalar localtime;
- my $head = '=head1';
- my $pkg = __PACKAGE__;
- my $version = $self->VERSION;
- my $perl_v = join '', `$^X -V`;
-
- print $fh <<EOF;
-package $name;
-
-\$VERSION = '0.01';
-
-1;
-
-__END__
-
-$head NAME
-
-$name - Snapshot of your installation at $now
-
-$head SYNOPSIS
-
-To install the modules from this snapshot, run:
-
- cpanp -i file://full/path/to/${name}.pm
-
-$head CONTENTS
-
-$string
-
-$head CONFIGURATION
-
-$perl_v
-
-$head AUTHOR
-
-This bundle has been generated autotomatically by
- $pkg $version
-
-EOF
-
- close $fh;
-
- return $file;
-}
-
-=head2 $bool = $cb->save_state
-
-Explicit command to save memory state to disk. This can be used to save
-information to disk about where a module was extracted, the result of
-C<make test>, etc. This will then be re-loaded into memory when a new
-session starts.
-
-The capability of saving state to disk depends on the source engine
-being used (See C<CPANPLUS::Config> for the option to choose your
-source engine). The default storage engine supports this option.
-
-Most users will not need this command, but it can handy for automated
-systems like setting up CPAN smoke testers.
-
-The method will return true if it managed to save the state to disk,
-or false if it did not.
-
-=cut
-
-sub save_state {
- my $self = shift;
- return $self->_save_state( @_ );
-}
-
-
-### XXX these wrappers are not individually tested! only the underlying
-### code through source.t and indirectly through he CustomSource plugin.
-
-=pod
-
-=head1 CUSTOM MODULE SOURCES
-
-Besides the sources as provided by the general C<CPAN> mirrors, it's
-possible to add your own sources list to your C<CPANPLUS> index.
-
-The methodology behind this works much like C<Debian's apt-sources>.
-
-The methods below show you how to make use of this functionality. Also
-note that most of these methods are available through the default shell
-plugin command C</cs>, making them available as shortcuts through the
-shell and via the commandline.
-
-=head2 %files = $cb->list_custom_sources
-
-Returns a mapping of registered custom sources and their local indices
-as follows:
-
- /full/path/to/local/index => http://remote/source
-
-Note that any file starting with an C<#> is being ignored.
-
-=cut
-
-sub list_custom_sources {
- return shift->__list_custom_module_sources( @_ );
-}
-
-=head2 $local_index = $cb->add_custom_source( uri => URI, [verbose => BOOL] );
-
-Adds an C<URI> to your own sources list and mirrors its index. See the
-documentation on C<< $cb->update_custom_source >> on how this is done.
-
-Returns the full path to the local index on success, or false on failure.
-
-Note that when adding a new C<URI>, the change to the in-memory tree is
-not saved until you rebuild or save the tree to disk again. You can do
-this using the C<< $cb->reload_indices >> method.
-
-=cut
-
-sub add_custom_source {
- return shift->_add_custom_module_source( @_ );
-}
-
-=head2 $local_index = $cb->remove_custom_source( uri => URI, [verbose => BOOL] );
-
-Removes an C<URI> from your own sources list and removes its index.
-
-To find out what C<URI>s you have as part of your own sources list, use
-the C<< $cb->list_custom_sources >> method.
-
-Returns the full path to the deleted local index file on success, or false
-on failure.
-
-=cut
-
-### XXX do clever dispatching based on arg number?
-sub remove_custom_source {
- return shift->_remove_custom_module_source( @_ );
-}
-
-=head2 $bool = $cb->update_custom_source( [remote => URI] );
-
-Updates the indexes for all your custom sources. It does this by fetching
-a file called C<packages.txt> in the root of the custom sources's C<URI>.
-If you provide the C<remote> argument, it will only update the index for
-that specific C<URI>.
-
-Here's an example of how custom sources would resolve into index files:
-
- file:///path/to/sources => file:///path/to/sources/packages.txt
- http://example.com/sources => http://example.com/sources/packages.txt
- ftp://example.com/sources => ftp://example.com/sources/packages.txt
-
-The file C<packages.txt> simply holds a list of packages that can be found
-under the root of the C<URI>. This file can be automatically generated for
-you when the remote source is a C<file:// URI>. For C<http://>, C<ftp://>,
-and similar, the administrator of that repository should run the method
-C<< $cb->write_custom_source_index >> on the repository to allow remote
-users to index it.
-
-For details, see the C<< $cb->write_custom_source_index >> method below.
-
-All packages that are added via this mechanism will be attributed to the
-author with C<CPANID> C<LOCAL>. You can use this id to search for all
-added packages.
-
-=cut
-
-sub update_custom_source {
- my $self = shift;
-
- ### if it mentions /remote/, the request is to update a single uri,
- ### not all the ones we have, so dispatch appropriately
- my $rv = grep( /remote/i, @_)
- ? $self->__update_custom_module_source( @_ )
- : $self->__update_custom_module_sources( @_ );
-
- return $rv;
-}
-
-=head2 $file = $cb->write_custom_source_index( path => /path/to/package/root, [to => /path/to/index/file, verbose => BOOL] );
-
-Writes the index for a custom repository root. Most users will not have to
-worry about this, but administrators of a repository will need to make sure
-their indexes are up to date.
-
-The index will be written to a file called C<packages.txt> in your repository
-root, which you can specify with the C<path> argument. You can override this
-location by specifying the C<to> argument, but in normal operation, that should
-not be required.
-
-Once the index file is written, users can then add the C<URI> pointing to
-the repository to their custom list of sources and start using it right away. See the C<< $cb->add_custom_source >> method for user details.
-
-=cut
-
-sub write_custom_source_index {
- return shift->__write_custom_module_index( @_ );
-}
-
-1;
-
-=pod
-
-=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.
-
-=head1 SEE ALSO
-
-L<CPANPLUS::Configure>, L<CPANPLUS::Module>, L<CPANPLUS::Module::Author>,
-L<CPANPLUS::Selfupdate>
-
-=cut
-
-# Local variables:
-# c-indentation-style: bsd
-# c-basic-offset: 4
-# indent-tabs-mode: nil
-# End:
-# vim: expandtab shiftwidth=4:
-
-__END__
-
-todo:
-sub dist { # not sure about this one -- probably already done
- enough in Module.pm
-sub reports { # in Module.pm, wrapper here
-
-
+++ /dev/null
-package CPANPLUS::Backend::RV;
-use deprecate;
-
-use strict;
-use vars qw[$STRUCT $VERSION];
-$VERSION = "0.9135";
-
-use CPANPLUS::Error;
-use CPANPLUS::Internals::Constants;
-
-use IPC::Cmd qw[can_run run];
-use Params::Check qw[check];
-
-use base 'Object::Accessor';
-
-local $Params::Check::VERBOSE = 1;
-
-
-=pod
-
-=head1 NAME
-
-CPANPLUS::Backend::RV - return value objects
-
-=head1 SYNOPSIS
-
- ### create a CPANPLUS::Backend::RV object
- $backend_rv = CPANPLUS::Backend::RV->new(
- ok => $boolean,
- args => $args,
- rv => $return_value
- function => $calling_function );
-
- ### if you have a CPANPLUS::Backend::RV object
- $passed_args = $backend_rv->args; # args passed to function
- $ok = $backend_rv->ok; # boolean indication overall
- # result of the call
- $function = $backend_rv->function # name of the calling
- # function
- $rv = $backend_rv->rv # the actual return value
- # of the calling function
-
-=head1 DESCRIPTION
-
-This module provides return value objects for multi-module
-calls to CPANPLUS::Backend. In boolean context, it returns the status
-of the overall result (ie, the same as the C<ok> method would).
-
-=head1 METHODS
-
-=head2 new( ok => BOOL, args => DATA, rv => DATA, [function => $method_name] )
-
-Creates a new CPANPLUS::Backend::RV object from the data provided.
-This method should only be called by CPANPLUS::Backend functions.
-The accessors may be used by users inspecting an RV object.
-
-All the argument names can be used as accessors later to retrieve the
-data.
-
-Arguments:
-
-=over 4
-
-=item ok
-
-Boolean indicating overall success
-
-=item args
-
-The arguments provided to the function that returned this rv object.
-Useful to inspect later to see what was actually passed to the function
-in case of an error.
-
-=item rv
-
-An arbitrary data structure that has the detailed return values of each
-of your multi-module calls.
-
-=item function
-
-The name of the function that created this rv object.
-Can be explicitly passed. If not, C<new()> will try to deduce the name
-from C<caller()> information.
-
-=back
-
-=cut
-
-sub new {
- my $class = shift;
- my %hash = @_;
-
- my $tmpl = {
- ok => { required => 1, allow => BOOLEANS },
- args => { required => 1 },
- rv => { required => 1 },
- function => { default => CALLING_FUNCTION->() },
- };
-
- my $args = check( $tmpl, \%hash ) or return;
- my $self = bless {}, $class;
-
-# $self->mk_accessors( qw[ok args function rv] );
- $self->mk_accessors( keys %$tmpl );
-
- ### set the values passed in the struct ###
- while( my($key,$val) = each %$args ) {
- $self->$key( $val );
- }
-
- return $self;
-}
-
-sub _ok { return shift->ok }
-#sub _stringify { Carp::carp( "stringifying!" ); overload::StrVal( shift ) }
-
-### make it easier to check if($rv) { foo() }
-### this allows people to not have to explicitly say
-### if( $rv->ok ) { foo() }
-### XXX add an explicit stringify, so it doesn't fall back to "bool"? :(
-use overload bool => \&_ok,
-# '""' => \&_stringify,
- fallback => 1;
-
-=pod
-
-=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
-
-1;
+++ /dev/null
-package CPANPLUS::Config;
-use deprecate;
-
-use strict;
-use warnings;
-
-use base 'Object::Accessor';
-use base 'CPANPLUS::Internals::Utils';
-
-use Config;
-use File::Spec;
-use Module::Load;
-use CPANPLUS;
-use CPANPLUS::Error;
-use CPANPLUS::Internals::Constants;
-
-use File::Basename qw[dirname];
-use IPC::Cmd qw[can_run];
-use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';
-use Module::Load::Conditional qw[check_install];
-use version;
-
-use vars qw[$VERSION];
-$VERSION = "0.9135";
-
-=pod
-
-=head1 NAME
-
-CPANPLUS::Config - configuration defaults and heuristics for CPANPLUS
-
-=head1 SYNOPSIS
-
- ### conf object via CPANPLUS::Backend;
- $cb = CPANPLUS::Backend->new;
- $conf = $cb->configure_object;
-
- ### or as a standalone object
- $conf = CPANPLUS::Configure->new;
-
- ### values in 'conf' section
- $verbose = $conf->get_conf( 'verbose' );
- $conf->set_conf( verbose => 1 );
-
- ### values in 'program' section
- $editor = $conf->get_program( 'editor' );
- $conf->set_program( editor => '/bin/vi' );
-
-=head1 DESCRIPTION
-
-This module contains defaults and heuristics for configuration
-information for CPANPLUS. To change any of these values, please
-see the documentation in C<CPANPLUS::Configure>.
-
-Below you'll find a list of configuration types and keys, and
-their meaning.
-
-=head1 CONFIGURATION
-
-=cut
-
-### BAH! you can't have POD interleaved with a hash
-### declaration.. so declare every entry separately :(
-my $Conf = {
- '_fetch' => {
- 'blacklist' => [ 'ftp' ],
- },
-
- ### _source, _build and _mirror are supposed to be static
- ### no changes should be needed unless pause/cpan changes
- '_source' => {
- 'hosts' => 'MIRRORED.BY',
- 'auth' => '01mailrc.txt.gz',
- 'stored' => 'sourcefiles',
- 'dslip' => '03modlist.data.gz',
- 'update' => '86400',
- 'mod' => '02packages.details.txt.gz',
- 'custom_index' => 'packages.txt',
- },
- '_build' => {
- 'plugins' => 'plugins',
- 'moddir' => 'build',
- 'startdir' => '',
- 'distdir' => 'dist',
- 'autobundle' => 'autobundle',
- 'autobundle_prefix' => 'Snapshot',
- 'autdir' => 'authors',
- 'install_log_dir' => 'install-logs',
- 'custom_sources' => 'custom-sources',
- 'sanity_check' => 1,
- },
- '_mirror' => {
- 'base' => 'authors/id/',
- 'auth' => 'authors/01mailrc.txt.gz',
- 'dslip' => 'modules/03modlist.data.gz',
- 'mod' => 'modules/02packages.details.txt.gz'
- },
-};
-
-=head2 Section 'conf'
-
-=over 4
-
-=item hosts
-
-An array ref containing hosts entries to be queried for packages.
-
-An example entry would like this:
-
- { 'scheme' => 'ftp',
- 'path' => '/pub/CPAN/',
- 'host' => 'ftp.cpan.org'
- },
-
-=cut
-
- ### default host list
- $Conf->{'conf'}->{'hosts'} = [
- {
- 'scheme' => 'ftp',
- 'path' => '/pub/CPAN/',
- 'host' => 'ftp.cpan.org'
- },
- {
- 'scheme' => 'http',
- 'path' => '/',
- 'host' => 'www.cpan.org'
- },
- {
- 'scheme' => 'ftp',
- 'path' => '/',
- 'host' => 'cpan.hexten.net'
- },
- {
- 'scheme' => 'ftp',
- 'path' => '/CPAN/',
- 'host' => 'cpan.cpantesters.org'
- },
- {
- 'scheme' => 'ftp',
- 'path' => '/pub/languages/perl/CPAN/',
- 'host' => 'ftp.funet.fi'
- }
- ];
-
-=item allow_build_interactivity
-
-Boolean flag to indicate whether 'perl Makefile.PL' and similar
-are run interactively or not. Defaults to 'true'.
-
-=cut
-
- $Conf->{'conf'}->{'allow_build_interactivity'} = 1;
-
-=item allow_unknown_prereqs
-
-Boolean flag to indicate that unresolvable prereqs are acceptable.
-If C<true> then only warnings will be issued (the behaviour before 0.9114)
-when a module is unresolvable from any our sources (CPAN and/or
-C<custom_sources>). If C<false> then an unresolvable prereq will fail
-during the C<prepare> stage of distribution installation.
-Defaults to C<true>.
-
-=cut
-
- $Conf->{'conf'}->{'allow_unknown_prereqs'} = 1;
-
-=item base
-
-The directory CPANPLUS keeps all its build and state information in.
-Defaults to ~/.cpanplus. If L<File::HomeDir> is available, that will
-be used to work out your C<HOME> directory. This may be overriden by
-setting the C<PERL5_CPANPLUS_HOME> environment variable, see
-L<CPANPLUS::Config::HomeEnv> for more details.
-
-=cut
-
- $Conf->{'conf'}->{'base'} = File::Spec->catdir(
- __PACKAGE__->_home_dir, DOT_CPANPLUS );
-
-=item buildflags
-
-Any flags to be passed to 'perl Build.PL'. See C<perldoc Module::Build>
-for details. Defaults to an empty string.
-
-=cut
-
- $Conf->{'conf'}->{'buildflags'} = '';
-
-=item cpantest
-
-Boolean flag to indicate whether or not to mail test results of module
-installations to C<http://testers.cpan.org>. Defaults to 'false'.
-
-=cut
-
- $Conf->{'conf'}->{'cpantest'} = 0;
-
-=item cpantest_mx
-
-String holding an explicit mailserver to use when sending out emails
-for C<http://testers.cpan.org>. An empty string will use your system
-settings. Defaults to an empty string.
-
-=cut
-
- $Conf->{'conf'}->{'cpantest_mx'} = '';
-
-=item debug
-
-Boolean flag to enable or disable extensive debuggging information.
-Defaults to 'false'.
-
-=cut
-
- $Conf->{'conf'}->{'debug'} = 0;
-
-=item dist_type
-
-Default distribution type to use when building packages. See C<cpan2dist>
-or C<CPANPLUS::Dist> for details. An empty string will not use any
-package building software. Defaults to an empty string.
-
-=cut
-
- $Conf->{'conf'}->{'dist_type'} = '';
-
-=item email
-
-Email address to use for anonymous ftp access and as C<from> address
-when sending emails. Defaults to an C<example.com> address.
-
-=cut
-
- $Conf->{'conf'}->{'email'} = DEFAULT_EMAIL;
-
-=item enable_custom_sources
-
-Boolean flag indicating whether custom sources should be enabled or
-not. See the C<CUSTOM MODULE SOURCES> in C<CPANPLUS::Backend> for
-details on how to use them.
-
-Defaults to C<true>
-
-=cut
-
- ### this addresses #32248 which requests a possibility to
- ### turn off custom sources
- $Conf->{'conf'}->{'enable_custom_sources'} = 1;
-
-=item extractdir
-
-String containing the directory where fetched archives should be
-extracted. An empty string will use a directory under your C<base>
-directory. Defaults to an empty string.
-
-=cut
-
- $Conf->{'conf'}->{'extractdir'} = '';
-
-=item fetchdir
-
-String containing the directory where fetched archives should be
-stored. An empty string will use a directory under your C<base>
-directory. Defaults to an empty string.
-
-=cut
-
- $Conf->{'conf'}->{'fetchdir'} = '';
-
-=item flush
-
-Boolean indicating whether build failures, cache dirs etc should
-be flushed after every operation or not. Defaults to 'true'.
-
-=cut
-
- $Conf->{'conf'}->{'flush'} = 1;
-
-=item force
-
-Boolean indicating whether files should be forcefully overwritten
-if they exist, modules should be installed when they fail tests,
-etc. Defaults to 'false'.
-
-=cut
-
- $Conf->{'conf'}->{'force'} = 0;
-
-=item histfile
-
-A string containing the history filename of the CPANPLUS readline instance.
-
-=cut
-
- $Conf->{'conf'}->{'histfile'} = File::Spec->catdir(
- __PACKAGE__->_home_dir, DOT_CPANPLUS, 'history' );
-
-=item lib
-
-An array ref holding directories to be added to C<@INC> when CPANPLUS
-starts up. Defaults to an empty array reference.
-
-=cut
-
- $Conf->{'conf'}->{'lib'} = [];
-
-=item makeflags
-
-A string holding flags that will be passed to the C<make> program
-when invoked. Defaults to an empty string.
-
-=cut
-
- $Conf->{'conf'}->{'makeflags'} = '';
-
-=item makemakerflags
-
-A string holding flags that will be passed to C<perl Makefile.PL>
-when invoked. Defaults to an empty string.
-
-=cut
-
- $Conf->{'conf'}->{'makemakerflags'} = '';
-
-=item md5
-
-A boolean indicating whether or not sha256 checks should be done when
-an archive is fetched. Defaults to 'true' if you have C<Digest::SHA>
-installed, 'false' otherwise.
-
-=cut
-
- $Conf->{'conf'}->{'md5'} = (
- check_install( module => 'Digest::SHA' ) ? 1 : 0 );
-
-=item no_update
-
-A boolean indicating whether or not C<CPANPLUS>' source files should be
-updated or not. Defaults to 'false'.
-
-=cut
-
- $Conf->{'conf'}->{'no_update'} = 0;
-
-=item passive
-
-A boolean indicating whether or not to use passive ftp connections.
-Defaults to 'true'.
-
-=cut
-
- $Conf->{'conf'}->{'passive'} = 1;
-
-=item prefer_bin
-
-A boolean indicating whether or not to prefer command line programs
-over perl modules. Defaults to 'false' unless you do not have
-C<Compress::Zlib> installed (as that would mean we could not extract
-C<.tar.gz> files)
-
-=cut
-
- ### if we dont have c::zlib, we'll need to use /bin/tar or we
- ### can not extract any files. Good time to change the default
- $Conf->{'conf'}->{'prefer_bin'} =
- (eval {require Compress::Zlib; 1} ? 0 : 1 );
-
-=item prefer_makefile
-
-A boolean indicating whether or not prefer a C<Makefile.PL> over a
-C<Build.PL> file if both are present. Defaults to 'true', unless
-the perl version is at least 5.10.1 or appropriate versions of L<Module::Build>
-and L<CPANPLUS::Dist::Build> are available.
-
-=cut
-
- $Conf->{'conf'}->{'prefer_makefile'} =
- ( $] >= 5.010001 or
- ( check_install( module => 'Module::Build', version => '0.32' ) and
- check_install( module => INSTALLER_BUILD, version => '0.60' ) )
- ? 0 : 1 );
-
-=item prereqs
-
-A digit indicating what to do when a package you are installing has a
-prerequisite. Options are:
-
- 0 Do not install
- 1 Install
- 2 Ask
- 3 Ignore (dangerous, install will probably fail!)
-
-The default is to ask.
-
-=cut
-
- $Conf->{'conf'}->{'prereqs'} = PREREQ_ASK;
-
-=item shell
-
-A string holding the shell class you wish to start up when starting
-C<CPANPLUS> in interactive mode.
-
-Defaults to C<CPANPLUS::Shell::Default>, the default CPANPLUS shell.
-
-=cut
-
- $Conf->{'conf'}->{'shell'} = 'CPANPLUS::Shell::Default';
-
-=item show_startup_tip
-
-A boolean indicating whether or not to show start up tips in the
-interactive shell. Defaults to 'true'.
-
-=cut
-
- $Conf->{'conf'}->{'show_startup_tip'} = 1;
-
-=item signature
-
-A boolean indicating whether or not check signatures if packages are
-signed. Defaults to 'true' if you have C<gpg> or C<Crypt::OpenPGP>
-installed, 'false' otherwise.
-
-=cut
-
- $Conf->{'conf'}->{'signature'} = do {
- check_install( module => 'Module::Signature', version => '0.06' )
- and ( can_run('gpg') ||
- check_install(module => 'Crypt::OpenPGP')
- );
- } ? 1 : 0;
-
-=item skiptest
-
-A boolean indicating whether or not to skip tests when installing modules.
-Defaults to 'false'.
-
-=cut
-
- $Conf->{'conf'}->{'skiptest'} = 0;
-
-=item storable
-
-A boolean indicating whether or not to use C<Storable> to write compiled
-source file information to disk. This makes for faster startup and look
-up times, but takes extra diskspace. Defaults to 'true' if you have
-C<Storable> installed and 'false' if you don't.
-
-=cut
-
- $Conf->{'conf'}->{'storable'} =
- ( check_install( module => 'Storable' ) ? 1 : 0 );
-
-=item timeout
-
-Digit indicating the time before a fetch request times out (in seconds).
-Defaults to 300.
-
-=cut
-
- $Conf->{'conf'}->{'timeout'} = 300;
-
-=item verbose
-
-A boolean indicating whether or not C<CPANPLUS> runs in verbose mode.
-Defaults to 'true' if you have the environment variable
-C<PERL5_CPANPLUS_VERBOSE> set to true, 'false' otherwise.
-
-It is recommended you run with verbose enabled, but it is disabled
-for historical reasons.
-
-=cut
-
- $Conf->{'conf'}->{'verbose'} = $ENV{PERL5_CPANPLUS_VERBOSE} || 0;
-
-=item write_install_log
-
-A boolean indicating whether or not to write install logs after installing
-a module using the interactive shell. Defaults to 'true'.
-
-
-=cut
-
- $Conf->{'conf'}->{'write_install_logs'} = 1;
-
-=item source_engine
-
-Class to use as the source engine, which is generally a subclass of
-C<CPANPLUS::Internals::Source>. Default to C<CPANPLUS::Internals::Source::Memory>.
-
-=cut
-
- $Conf->{'conf'}->{'source_engine'} = DEFAULT_SOURCE_ENGINE;
-
-=item cpantest_reporter_args
-
-A hashref of key => value pairs that are passed to the constructor
-of C<Test::Reporter>. If you'd want to enable TLS for example, you'd
-set it to:
-
- { transport => 'Net::SMTP::TLS',
- transport_args => [ User => 'Joe', Password => '123' ],
- }
-
-=cut
-
- $Conf->{'conf'}->{'cpantest_reporter_args'} = {};
-
-=back
-
-=head2 Section 'program'
-
-=cut
-
- ### Paths get stripped of whitespace on win32 in the constructor
- ### sudo gets emptied if there's no need for it in the constructor
-
-=over 4
-
-=item editor
-
-A string holding the path to your editor of choice. Defaults to your
-$ENV{EDITOR}, $ENV{VISUAL}, 'vi' or 'pico' programs, in that order.
-
-=cut
-
- $Conf->{'program'}->{'editor'} = do {
- $ENV{'EDITOR'} || $ENV{'VISUAL'} ||
- can_run('vi') || can_run('pico')
- };
-
-=item make
-
-A string holding the path to your C<make> binary. Looks for the C<make>
-program used to build perl or failing that, a C<make> in your path.
-
-=cut
-
- $Conf->{'program'}->{'make'} =
- can_run($Config{'make'}) || can_run('make');
-
-=item pager
-
-A string holding the path to your pager of choice. Defaults to your
-$ENV{PAGER}, 'less' or 'more' programs, in that order.
-
-=cut
-
- $Conf->{'program'}->{'pager'} =
- $ENV{'PAGER'} || can_run('less') || can_run('more');
-
- ### no one uses this feature anyway, and it's only working for EU::MM
- ### and not for module::build
- #'perl' => '',
-
-=item shell
-
-A string holding the path to your login shell of choice. Defaults to your
-$ENV{SHELL} setting, or $ENV{COMSPEC} on Windows.
-
-=cut
-
- $Conf->{'program'}->{'shell'} = $^O eq 'MSWin32'
- ? $ENV{COMSPEC}
- : $ENV{SHELL};
-
-=item sudo
-
-A string holding the path to your C<sudo> binary if your install path
-requires super user permissions. Looks for C<sudo> in your path, or
-remains empty if you do not require super user permissions to install.
-
-=cut
-
- $Conf->{'program'}->{'sudo'} = do {
- ### let's assume you dont need sudo,
- ### unless one of the below criteria tells us otherwise
- my $sudo = undef;
-
- ### you're a normal user, you might need sudo
- if( $> ) {
-
- ### check for all install dirs!
- ### you have write permissions to the installdir,
- ### you don't need sudo
- if( -w $Config{'installsitelib'} && -w $Config{'installsitebin'} ) {
-
- ### installsiteman3dir is a 5.8'ism.. don't check
- ### it on 5.6.x...
- if( defined $Config{'installsiteman3dir'} ) {
- $sudo = -w $Config{'installsiteman3dir'}
- ? undef
- : can_run('sudo');
- } else {
- $sudo = undef;
- }
-
- ### you have PERL_MM_OPT set to some alternate
- ### install place. You probably have write permissions
- ### to that
- } elsif ( $ENV{'PERL_MM_OPT'} and
- $ENV{'PERL_MM_OPT'} =~ /INSTALL|LIB|PREFIX/
- ) {
- $sudo = undef;
-
- ### you probably don't have write permissions
- } else {
- $sudo = can_run('sudo');
- }
- }
-
- ### and return the value
- $sudo;
- };
-
-=item perlwrapper
-
-B<DEPRECATED>
-
-A string holding the path to the C<cpanp-run-perl> utility bundled
-with CPANPLUS, which is used to enable autoflushing in spawned processes.
-
-=cut
-
- ### perlwrapper that allows us to turn on autoflushing
- $Conf->{'program'}->{'perlwrapper'} = sub {
- my $name = 'cpanp-run-perl';
-
- my @bins = do{
- require Config;
- my $ver = $Config::Config{version};
-
- ### if we are running with 'versiononly' enabled,
- ### all binaries will have the perlversion appended
- ### ie, cpanp will become cpanp5.9.5
- ### so prefer the versioned binary in that case
- $Config::Config{versiononly}
- ? ($name.$ver, $name)
- : ($name, $name.$ver);
- };
-
- ### patch from Steve Hay Fri 29 Jun 2007 14:26:02 GMT+02:00
- ### Msg-Id: <4684FA5A.7030506@uk.radan.com>
- ### look for files with a ".bat" extension as well on Win32
- @bins = map { $_, "$_.bat" } @bins if $^O eq 'MSWin32';
-
- my $path;
- BIN: for my $bin (@bins) {
-
- ### parallel to your cpanp/cpanp-boxed
- my $maybe = File::Spec->rel2abs(
- File::Spec->catfile( dirname($0), $bin )
- );
- $path = $maybe and last BIN if -f $maybe;
-
- ### parallel to your CPANPLUS.pm:
- ### $INC{cpanplus}/../bin/cpanp-run-perl
- $maybe = File::Spec->rel2abs(
- File::Spec->catfile(
- dirname($INC{'CPANPLUS.pm'}),
- '..', # lib dir
- 'bin', # bin dir
- $bin, # script
- )
- );
- $path = $maybe and last BIN if -f $maybe;
-
- ### you installed CPANPLUS in a custom prefix,
- ### so go parallel to /that/. PREFIX=/tmp/cp
- ### would put cpanp-run-perl in /tmp/cp/bin and
- ### CPANPLUS.pm in
- ### /tmp/cp/lib/perl5/site_perl/5.8.8
- $maybe = File::Spec->rel2abs(
- File::Spec->catfile(
- dirname( $INC{'CPANPLUS.pm'} ),
- '..', '..', '..', '..', # 4x updir
- 'bin', # bin dir
- $bin, # script
- )
- );
- $path = $maybe and last BIN if -f $maybe;
-
- ### in your path -- take this one last, the
- ### previous two assume extracted tarballs
- ### or user installs
- ### note that we don't use 'can_run' as it's
- ### not an executable, just a wrapper...
- ### prefer anything that's found in the path paralel to your $^X
- for my $dir (File::Spec->rel2abs( dirname($^X) ),
- split(/\Q$Config::Config{path_sep}\E/, $ENV{PATH}),
- File::Spec->curdir,
- ) {
-
- ### On VMS the path could be in UNIX format, and we
- ### currently need it to be in VMS format
- $dir = VMS::Filespec::vmspath($dir) if ON_VMS;
-
- $maybe = File::Spec->catfile( $dir, $bin );
- $path = $maybe and last BIN if -f $maybe;
- }
- }
-
- ### we should have a $path by now ideally, if so return it
- return $path if defined $path;
-
- ### CPANPLUS::Dist::MM doesn't require this anymore
- ### but CPANPLUS::Dist::Build might if it is less than 0.60
- my $cpdb = check_install( module => INSTALLER_BUILD );
- return '' unless
- $cpdb and eval { version->parse($cpdb->{version}) < version->parse('0.60') };
-
- ### if not, warn about it and give sensible default.
- ### XXX try to be a no-op instead then..
- ### cross your fingers...
- ### pass '-P' to perl: "run program through C
- ### preprocessor before compilation"
- ### XXX using -P actually changes the way some Makefile.PLs
- ### are executed, so don't do that... --kane
- error(loc(
- "Could not find the '%1' binary in your path".
- "--this may be a problem.\n".
- "Please locate this program and set ".
- "your '%2' config entry to its path.\n".
- "From the default shell, you can do this by typing:\n\n".
- " %3\n".
- " %4\n",
- $name, 'perlwrapper',
- 's program perlwrapper FULL_PATH_TO_CPANP_RUN_PERL',
- 's save'
- ));
- return '';
- }->();
-
-=back
-
-=cut
-
-sub new {
- my $class = shift;
- my $obj = $class->SUPER::new;
-
- $obj->mk_accessors( keys %$Conf );
-
- for my $acc ( keys %$Conf ) {
- my $subobj = Object::Accessor->new;
- $subobj->mk_accessors( keys %{$Conf->{$acc}} );
-
- ### read in all the settings from the sub accessors;
- for my $subacc ( $subobj->ls_accessors ) {
- $subobj->$subacc( $Conf->{$acc}->{$subacc} );
- }
-
- ### now store it in the parent object
- $obj->$acc( $subobj );
- }
-
- $obj->_clean_up_paths;
-
- ### shut up IPC::Cmd warning about not findin IPC::Run on win32
- $IPC::Cmd::WARN = 0;
-
- return $obj;
-}
-
-sub _clean_up_paths {
- my $self = shift;
-
- ### clean up paths if we are on win32
- if( $^O eq 'MSWin32' ) {
- for my $pgm ( $self->program->ls_accessors ) {
- my $path = $self->program->$pgm;
-
- ### paths with whitespace needs to be shortened
- ### for shell outs.
- if ($path and $path =~ /\s+/) {
- my($prog, $args);
-
- ### patch from Steve Hay, 13nd of June 2007
- ### msg-id: <467012A4.6060705@uk.radan.com>
- ### windows directories are not allowed to end with
- ### a space, so any occurrence of '\w\s+/\w+' means
- ### we're dealing with arguments, not directory
- ### names.
- if ($path =~ /^(.*?)(\s+\/.*$)/) {
- ($prog, $args) = ($1, $2);
-
- ### otherwise, there are no arguments
- } else {
- ($prog, $args) = ($path, '');
- }
-
- $prog = Win32::GetShortPathName( $prog );
- $self->program->$pgm( $prog . $args );
- }
- }
- }
-
- return 1;
-}
-
-1;
-
-=pod
-
-=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.
-
-=head1 SEE ALSO
-
-L<CPANPLUS::Backend>, L<CPANPLUS::Configure::Setup>, L<CPANPLUS::Configure>
-
-=cut
-
-# Local variables:
-# c-indentation-style: bsd
-# c-basic-offset: 4
-# indent-tabs-mode: nil
-# End:
-# vim: expandtab shiftwidth=4:
+++ /dev/null
-package CPANPLUS::Config::HomeEnv;
-use deprecate;
-
-use strict;
-use File::Spec;
-use vars qw($VERSION);
-
-$VERSION = "0.9135";
-
-sub setup {
- my $conf = shift;
- $conf->set_conf( base => File::Spec->catdir( $ENV{PERL5_CPANPLUS_HOME}, '.cpanplus' ) )
- if $ENV{PERL5_CPANPLUS_HOME};
- return 1;
-}
-
-qq'Wherever I hang my hat is home';
-
-__END__
-
-=head1 NAME
-
-CPANPLUS::Config::HomeEnv - Set the environment for the CPANPLUS base dir
-
-=head1 SYNOPSIS
-
- export PERL5_CPANPLUS_HOME=/home/moo/perls/conf/perl-5.8.9/
-
-=head1 DESCRIPTION
-
-CPANPLUS::Config::HomeEnv is a L<CPANPLUS::Config> file that allows the CPANPLUS user to
-specify where L<CPANPLUS> gets its configuration from.
-
-Setting the environment variable C<PERL5_CPANPLUS_HOME> to a path location, determines
-where the C<.cpanplus> directory will be located.
-
-=head1 METHODS
-
-=over
-
-=item C<setup>
-
-Called by L<CPANPLUS::Configure>.
-
-=back
-
-=head1 AUTHOR
-
-Chris C<BinGOs> Williams <chris@bingosnet.co.uk>
-
-Contributions and patience from Jos Boumans the L<CPANPLUS> guy!
-
-=head1 LICENSE
-
-Copyright E<copy> Chris Williams and Jos Boumans.
-
-This module may be used, modified, and distributed under the same terms as Perl itself. Please see the license that came with your Perl distribution for details.
-
-=head1 SEE ALSO
-
-L<CPANPLUS>
-
-=cut
+++ /dev/null
-package CPANPLUS::Configure;
-use deprecate;
-use strict;
-
-
-use CPANPLUS::Internals::Constants;
-use CPANPLUS::Error;
-use CPANPLUS::Config;
-
-use Log::Message;
-use Module::Load qw[load];
-use Params::Check qw[check];
-use File::Basename qw[dirname];
-use Module::Loaded ();
-use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';
-
-use vars qw[$AUTOLOAD $VERSION $MIN_CONFIG_VERSION];
-use base qw[CPANPLUS::Internals::Utils];
-
-local $Params::Check::VERBOSE = 1;
-
-### require, avoid circular use ###
-require CPANPLUS::Internals;
-$VERSION = "0.9135";
-
-### can't use O::A as we're using our own AUTOLOAD to get to
-### the config options.
-for my $meth ( qw[conf _lib _perl5lib]) {
- no strict 'refs';
-
- *$meth = sub {
- my $self = shift;
- $self->{'_'.$meth} = $_[0] if @_;
- return $self->{'_'.$meth};
- }
-}
-
-
-=pod
-
-=head1 NAME
-
-CPANPLUS::Configure - configuration for CPANPLUS
-
-=head1 SYNOPSIS
-
- $conf = CPANPLUS::Configure->new( );
-
- $bool = $conf->can_save;
- $bool = $conf->save( $where );
-
- @opts = $conf->options( $type );
-
- $make = $conf->get_program('make');
- $verbose = $conf->set_conf( verbose => 1 );
-
-=head1 DESCRIPTION
-
-This module deals with all the configuration issues for CPANPLUS.
-Users can use objects created by this module to alter the behaviour
-of CPANPLUS.
-
-Please refer to the C<CPANPLUS::Backend> documentation on how to
-obtain a C<CPANPLUS::Configure> object.
-
-=head1 METHODS
-
-=head2 $Configure = CPANPLUS::Configure->new( load_configs => BOOL )
-
-This method returns a new object. Normal users will never need to
-invoke the C<new> method, but instead retrieve the desired object via
-a method call on a C<CPANPLUS::Backend> object.
-
-=over 4
-
-=item load_configs
-
-Controls whether or not additional user configurations are to be loaded
-or not. Defaults to C<true>.
-
-=back
-
-=cut
-
-### store the CPANPLUS::Config object in a closure, so we only
-### initialize it once.. otherwise, on a 2nd ->new, settings
-### from configs on top of this one will be reset
-{ my $Config;
-
- sub new {
- my $class = shift;
- my %hash = @_;
-
- ### XXX pass on options to ->init() like rescan?
- my ($load);
- my $tmpl = {
- load_configs => { default => 1, store => \$load },
- };
-
- check( $tmpl, \%hash ) or (
- warn Params::Check->last_error, return
- );
-
- $Config ||= CPANPLUS::Config->new;
- my $self = bless {}, $class;
- $self->conf( $Config );
-
- ### you want us to load other configs?
- ### these can override things in the default config
- $self->init if $load;
-
- ### after processing the config files, check what
- ### @INC and PERL5LIB are set to.
- $self->_lib( \@INC );
- $self->_perl5lib( $ENV{'PERL5LIB'} );
-
- return $self;
- }
-}
-
-=head2 $bool = $Configure->init( [rescan => BOOL])
-
-Initialize the configure with other config files than just
-the default 'CPANPLUS::Config'.
-
-Called from C<new()> to load user/system configurations
-
-If the C<rescan> option is provided, your disk will be
-examined again to see if there are new config files that
-could be read. Defaults to C<false>.
-
-Returns true on success, false on failure.
-
-=cut
-
-### move the Module::Pluggable detection to runtime, rather
-### than compile time, so that a simple 'require CPANPLUS'
-### doesn't start running over your filesystem for no good
-### reason. Make sure we only do the M::P call once though.
-### we use $loaded to mark it
-{ my $loaded;
- my $warned;
- sub init {
- my $self = shift;
- my $obj = $self->conf;
- my %hash = @_;
-
- my ($rescan);
- my $tmpl = {
- rescan => { default => 0, store => \$rescan },
- };
-
- check( $tmpl, \%hash ) or (
- warn Params::Check->last_error, return
- );
-
- ### if the base dir is changed, we have to rescan it
- ### for any CPANPLUS::Config::* files as well, so keep
- ### track of it
- my $cur_base = $self->get_conf('base');
-
- ### warn if we find an old style config specified
- ### via environment variables
- { my $env = ENV_CPANPLUS_CONFIG;
- if( $ENV{$env} and not $warned ) {
- $warned++;
- error(loc("Specifying a config file in your environment " .
- "using %1 is obsolete.\nPlease follow the ".
- "directions outlined in %2 or use the '%3' command\n".
- "in the default shell to use custom config files.",
- $env, "CPANPLUS::Configure->save", 's save'));
- }
- }
-
- { ### make sure that the homedir is included now
- local @INC = ( LIB_DIR->($cur_base), @INC );
-
- ### only set it up once
- if( !$loaded++ or $rescan ) {
- ### find plugins & extra configs
- ### check $home/.cpanplus/lib as well
- require Module::Pluggable;
-
- Module::Pluggable->import(
- search_path => ['CPANPLUS::Config'],
- search_dirs => [ LIB_DIR->($cur_base) ],
- except => qr/::SUPER$/,
- sub_name => 'configs'
- );
- }
-
-
- ### do system config, user config, rest.. in that order
- ### apparently, on a 2nd invocation of -->configs, a
- ### ::ISA::CACHE package can appear.. that's bad...
- my %confs = map { $_ => $_ }
- grep { $_ !~ /::ISA::/ } __PACKAGE__->configs;
- my @confs = grep { defined }
- map { delete $confs{$_} } CONFIG_SYSTEM, CONFIG_USER;
- push @confs, sort keys %confs;
-
- for my $plugin ( @confs ) {
- msg(loc("Found config '%1'", $plugin),0);
-
- ### if we already did this the /last/ time around dont
- ### run the setup agian.
- if( my $loc = Module::Loaded::is_loaded( $plugin ) ) {
- msg(loc(" Already loaded '%1' (%2)", $plugin, $loc), 0);
- next;
- } else {
- msg(loc(" Loading config '%1'", $plugin),0);
-
- if( eval { load $plugin; 1 } ) {
- msg(loc(" Loaded '%1' (%2)",
- $plugin, Module::Loaded::is_loaded( $plugin ) ), 0);
- } else {
- error(loc(" Error loading '%1': %2", $plugin, $@));
- }
- }
-
- if( $@ ) {
- error(loc("Could not load '%1': %2", $plugin, $@));
- next;
- }
-
- my $sub = $plugin->can('setup');
- $sub->( $self ) if $sub;
- }
- }
-
- ### did one of the plugins change the base dir? then we should
- ### scan the dirs again
- if( $cur_base ne $self->get_conf('base') ) {
- msg(loc("Base dir changed from '%1' to '%2', rescanning",
- $cur_base, $self->get_conf('base')), 0);
- $self->init( @_, rescan => 1 );
- }
-
- ### clean up the paths once more, just in case
- $obj->_clean_up_paths;
-
- ### XXX in case the 'lib' param got changed, we need to
- ### add that now, or it's not propagating ;(
- { my $lib = $self->get_conf('lib');
- my %inc = map { $_ => $_ } @INC;
- for my $l ( @$lib ) {
- push @INC, $l unless $inc{$l};
- }
- $self->_lib( \@INC );
- }
-
- return 1;
- }
-}
-=pod
-
-=head2 can_save( [$config_location] )
-
-Check if we can save the configuration to the specified file.
-If no file is provided, defaults to your personal config.
-
-Returns true if the file can be saved, false otherwise.
-
-=cut
-
-sub can_save {
- my $self = shift;
- my $file = shift || CONFIG_USER_FILE->();
-
- return 1 unless -e $file;
-
- chmod 0644, $file;
- return (-w $file);
-}
-
-=pod
-
-=head2 $file = $conf->save( [$package_name] )
-
-Saves the configuration to the package name you provided.
-If this package is not C<CPANPLUS::Config::System>, it will
-be saved in your C<.cpanplus> directory, otherwise it will
-be attempted to be saved in the system wide directory.
-
-If no argument is provided, it will default to your personal
-config.
-
-Returns the full path to the file if the config was saved,
-false otherwise.
-
-=cut
-
-sub _config_pm_to_file {
- my $self = shift;
- my $pm = shift or return;
- my $dir = shift || CONFIG_USER_LIB_DIR->();
-
- ### only 3 types of files know: home, system and 'other'
- ### so figure out where to save them based on their type
- my $file;
- if( $pm eq CONFIG_USER ) {
- $file = CONFIG_USER_FILE->();
-
- } elsif ( $pm eq CONFIG_SYSTEM ) {
- $file = CONFIG_SYSTEM_FILE->();
-
- ### third party file
- } else {
- my $cfg_pkg = CONFIG . '::';
- unless( $pm =~ /^$cfg_pkg/ ) {
- error(loc(
- "WARNING: Your config package '%1' is not in the '%2' ".
- "namespace and will not be automatically detected by %3",
- $pm, $cfg_pkg, 'CPANPLUS'
- ));
- }
-
- $file = File::Spec->catfile(
- $dir,
- split( '::', $pm )
- ) . '.pm';
- }
-
- return $file;
-}
-
-
-sub save {
- my $self = shift;
- my $pm = shift || CONFIG_USER;
- my $savedir = shift || '';
-
- my $file = $self->_config_pm_to_file( $pm, $savedir ) or return;
- my $dir = dirname( $file );
-
- unless( -d $dir ) {
- $self->_mkdir( dir => $dir ) or (
- error(loc("Can not create directory '%1' to save config to",$dir)),
- return
- )
- }
- return unless $self->can_save($file);
-
- ### find only accessors that are not private
- my @acc = sort grep { $_ !~ /^_/ } $self->conf->ls_accessors;
-
- ### for dumping the values
- use Data::Dumper;
-
- my @lines;
- for my $acc ( @acc ) {
-
- push @lines, "### $acc section", $/;
-
- for my $key ( $self->conf->$acc->ls_accessors ) {
- my $val = Dumper( $self->conf->$acc->$key );
-
- $val =~ s/\$VAR1\s+=\s+//;
- $val =~ s/;\n//;
-
- push @lines, '$'. "conf->set_${acc}( $key => $val );", $/;
- }
- push @lines, $/,$/;
-
- }
-
- my $str = join '', map { " $_" } @lines;
-
- ### use a variable to make sure the pod parser doesn't snag it
- my $is = '=';
- my $time = gmtime;
-
-
- my $msg = <<_END_OF_CONFIG_;
-###############################################
-###
-### Configuration structure for $pm
-###
-###############################################
-
-#last changed: $time GMT
-
-### minimal pod, so you can find it with perldoc -l, etc
-${is}pod
-
-${is}head1 NAME
-
-$pm
-
-${is}head1 DESCRIPTION
-
-This is a CPANPLUS configuration file. Editing this
-config changes the way CPANPLUS will behave
-
-${is}cut
-
-package $pm;
-
-use strict;
-
-sub setup {
- my \$conf = shift;
-
-$str
-
- return 1;
-}
-
-1;
-
-_END_OF_CONFIG_
-
- $self->_move( file => $file, to => "$file~" ) if -f $file;
-
- my $fh = new FileHandle;
- $fh->open(">$file")
- or (error(loc("Could not open '%1' for writing: %2", $file, $!)),
- return );
-
- $fh->print($msg);
- $fh->close;
-
- return $file;
-}
-
-=pod
-
-=head2 options( type => TYPE )
-
-Returns a list of all valid config options given a specific type
-(like for example C<conf> of C<program>) or false if the type does
-not exist
-
-=cut
-
-sub options {
- my $self = shift;
- my $conf = $self->conf;
- my %hash = @_;
-
- my $type;
- my $tmpl = {
- type => { required => 1, default => '',
- strict_type => 1, store => \$type },
- };
-
- check($tmpl, \%hash) or return;
-
- my %seen;
- return sort grep { !$seen{$_}++ }
- map { $_->$type->ls_accessors if $_->can($type) }
- $self->conf;
- return;
-}
-
-=pod
-
-=head1 ACCESSORS
-
-Accessors that start with a C<_> are marked private -- regular users
-should never need to use these.
-
-See the C<CPANPLUS::Config> documentation for what items can be
-set and retrieved.
-
-=head2 get_SOMETHING( ITEM, [ITEM, ITEM, ... ] );
-
-The C<get_*> style accessors merely retrieves one or more desired
-config options.
-
-=head2 set_SOMETHING( ITEM => VAL, [ITEM => VAL, ITEM => VAL, ... ] );
-
-The C<set_*> style accessors set the current value for one
-or more config options and will return true upon success, false on
-failure.
-
-=head2 add_SOMETHING( ITEM => VAL, [ITEM => VAL, ITEM => VAL, ... ] );
-
-The C<add_*> style accessor adds a new key to a config key.
-
-Currently, the following accessors exist:
-
-=over 4
-
-=item set|get_conf
-
-Simple configuration directives like verbosity and favourite shell.
-
-=item set|get_program
-
-Location of helper programs.
-
-=item _set|_get_build
-
-Locations of where to put what files for CPANPLUS.
-
-=item _set|_get_source
-
-Locations and names of source files locally.
-
-=item _set|_get_mirror
-
-Locations and names of source files remotely.
-
-=item _set|_get_fetch
-
-Special settings pertaining to the fetching of files.
-
-=back
-
-=cut
-
-sub AUTOLOAD {
- my $self = shift;
- my $conf = $self->conf;
-
- my $name = $AUTOLOAD;
- $name =~ s/.+:://;
-
- my ($private, $action, $field) =
- $name =~ m/^(_)?((?:[gs]et|add))_([a-z]+)$/;
-
- my $type = '';
- $type .= '_' if $private;
- $type .= $field if $field;
-
- my $type_code = $conf->can($type);
- unless ( $type_code ) {
- error( loc("Invalid method type: '%1'", $name) );
- return;
- }
- my $type_obj = $type_code->();
-
- unless( scalar @_ ) {
- error( loc("No arguments provided!") );
- return;
- }
-
- ### retrieve a current value for an existing key ###
- if( $action eq 'get' ) {
- for my $key (@_) {
- my @list = ();
-
- ### get it from the user config first
- if( my $code = $type_obj->can($key) ) {
- push @list, $code->();
-
- ### XXX EU::AI compatibility hack to provide lookups like in
- ### cpanplus 0.04x; we renamed ->_get_build('base') to
- ### ->get_conf('base')
- } elsif ( $type eq '_build' and $key eq 'base' ) {
- return $self->get_conf($key);
-
- } else {
- error( loc(q[No such key '%1' in field '%2'], $key, $type) );
- return;
- }
-
- return wantarray ? @list : $list[0];
- }
-
- ### set an existing key to a new value ###
- } elsif ( $action eq 'set' ) {
- my %args = @_;
-
- while( my($key,$val) = each %args ) {
-
- if( my $code = $type_obj->can($key) ) {
- $code->( $val );
-
- } else {
- error( loc(q[No such key '%1' in field '%2'], $key, $type) );
- return;
- }
- }
-
- return 1;
-
- ### add a new key to the config ###
- } elsif ( $action eq 'add' ) {
- my %args = @_;
-
- while( my($key,$val) = each %args ) {
-
- if( $type_obj->can($key) ) {
- error( loc( q[Key '%1' already exists for field '%2'],
- $key, $type));
- return;
- } else {
- $type_obj->mk_accessors( $key );
- $type_obj->$key( $val );
- }
- }
- return 1;
-
- } else {
-
- error( loc(q[Unknown action '%1'], $action) );
- return;
- }
-}
-
-sub DESTROY { 1 };
-
-1;
-
-=pod
-
-=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.
-
-=head1 SEE ALSO
-
-L<CPANPLUS::Backend>, L<CPANPLUS::Configure::Setup>, L<CPANPLUS::Config>
-
-=cut
-
-# Local variables:
-# c-indentation-style: bsd
-# c-basic-offset: 4
-# indent-tabs-mode: nil
-# End:
-# vim: expandtab shiftwidth=4:
-
+++ /dev/null
-package CPANPLUS::Configure::Setup;
-use deprecate;
-
-use strict;
-use vars qw[@ISA $VERSION];
-$VERSION = "0.9135";
-
-use base qw[CPANPLUS::Internals::Utils];
-use base qw[Object::Accessor];
-
-use Config;
-use Term::UI;
-use Module::Load;
-use Term::ReadLine;
-
-use CPANPLUS::Internals::Utils;
-use CPANPLUS::Internals::Constants;
-use CPANPLUS::Error;
-
-use IPC::Cmd qw[can_run];
-use Params::Check qw[check];
-use Module::Load::Conditional qw[check_install];
-use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';
-
-### silence Term::UI
-$Term::UI::VERBOSE = 0;
-
-#Can't ioctl TIOCGETP: Unknown error
-#Consider installing Term::ReadKey from CPAN site nearby
-# at http://www.perl.com/CPAN
-#Or use
-# perl -MCPAN -e shell
-#to reach CPAN. Falling back to 'stty'.
-# If you do not want to see this warning, set PERL_READLINE_NOWARN
-#in your environment.
-#'stty' is not recognized as an internal or external command,
-#operable program or batch file.
-#Cannot call `stty': No such file or directory at C:/Perl/site/lib/Term/ReadLine/
-
-### setting this var in the meantime to avoid this warning ###
-$ENV{PERL_READLINE_NOWARN} = 1;
-
-
-sub new {
- my $class = shift;
- my %hash = @_;
-
- my $tmpl = {
- configure_object => { },
- term => { },
- backend => { },
- autoreply => { default => 0, },
- skip_mirrors => { default => 0, },
- use_previous => { default => 1, },
- config_type => { default => CONFIG_USER },
- };
-
- my $args = check( $tmpl, \%hash ) or return;
-
- ### initialize object
- my $obj = $class->SUPER::new( keys %$tmpl );
- for my $acc ( $obj->ls_accessors ) {
- $obj->$acc( $args->{$acc} );
- }
-
- ### otherwise there's a circular use ###
- load CPANPLUS::Configure;
- load CPANPLUS::Backend;
-
- $obj->configure_object( CPANPLUS::Configure->new() )
- unless $obj->configure_object;
-
- $obj->backend( CPANPLUS::Backend->new( $obj->configure_object ) )
- unless $obj->backend;
-
- ### use empty string in case user only has T::R::Stub -- it complains
- $obj->term( Term::ReadLine->new('') )
- unless $obj->term;
-
- ### enable autoreply if that was passed ###
- $Term::UI::AUTOREPLY = $obj->autoreply;
-
- return $obj;
-}
-
-sub init {
- my $self = shift;
- my $term = $self->term;
-
- ### default setting, unless changed
- $self->config_type( CONFIG_USER ) unless $self->config_type;
-
- my $save = loc('Save & exit');
- my $exit = loc('Quit without saving');
- my @map = (
- # key on the display # method to dispatch to
- [ loc('Select Configuration file') => '_save_where' ],
- [ loc('Setup CLI Programs') => '_setup_program' ],
- [ loc('Setup CPANPLUS Home directory') => '_setup_base' ],
- [ loc('Setup FTP/Email settings') => '_setup_ftp' ],
- [ loc('Setup basic preferences') => '_setup_conf' ],
- [ loc('Setup installer settings') => '_setup_installer' ],
- [ loc('Select mirrors'), => '_setup_hosts' ],
- [ loc('Edit configuration file') => '_edit' ],
- [ $save => '_save' ],
- [ $exit => 1 ],
- );
-
- my @keys = map { $_->[0] } @map; # sorted keys
- my %map = map { @$_ } @map; # lookup hash
-
- PICK_SECTION: {
- print loc("
-=================> MAIN MENU <=================
-
-Welcome to the CPANPLUS configuration. Please select which
-parts you wish to configure
-
-Defaults are taken from your current configuration.
-If you would save now, your settings would be written to:
-
- %1
-
- ", $self->config_type );
-
- my $choice = $term->get_reply(
- prompt => "Section to configure:",
- choices => \@keys,
- default => $keys[0]
- );
-
- ### exit configuration?
- if( $choice eq $exit ) {
- print loc("
-Quitting setup, changes will not be saved.
- ");
- return 1;
- }
-
- my $method = $map{$choice};
-
- my $rv = $self->$method or print loc("
-There was an error setting up this section. You might want to try again
- ");
-
- ### was it save & exit?
- if( $choice eq $save and $rv ) {
- print loc("
-Quitting setup, changes are saved to '%1'
- ", $self->config_type
- );
- return 1;
- }
-
- ### otherwise, present choice again
- redo PICK_SECTION;
- }
-
- return 1;
-}
-
-
-
-### sub that figures out what kind of config type the user wants
-sub _save_where {
- my $self = shift;
- my $term = $self->term;
- my $conf = $self->configure_object;
-
-
- ASK_CONFIG_TYPE: {
-
- print loc( q[
-Where would you like to save your CPANPLUS Configuration file?
-
-If you want to configure CPANPLUS for this user only,
-select the '%1' option.
-The file will then be saved in your homedirectory.
-
-If you are the system administrator of this machine,
-and would like to make this config available globally,
-select the '%2' option.
-The file will be then be saved in your CPANPLUS
-installation directory.
-
- ], CONFIG_USER, CONFIG_SYSTEM );
-
-
- ### ask what config type we should save to
- my $type = $term->get_reply(
- prompt => loc("Type of configuration file"),
- default => $self->config_type || CONFIG_USER,
- choices => [CONFIG_USER, CONFIG_SYSTEM],
- );
-
- my $file = $conf->_config_pm_to_file( $type );
-
- ### can we save to this file?
- unless( $conf->can_save( $file ) ) {
- error(loc(
- "Can not save to file '%1'-- please check permissions " .
- "and try again", $file
- ));
-
- redo ASK_CONFIG_FILE;
- }
-
- ### you already have the file -- are we allowed to overwrite
- ### or should we try again?
- if ( -e $file and -w _ ) {
- print loc(q[
-I see you already have this file:
- %1
-
-The file will not be overwritten until you explicitly save it.
-
- ], $file );
-
- redo ASK_CONFIG_TYPE
- unless $term->ask_yn(
- prompt => loc( "Do you wish to use this file?"),
- default => 'n',
- );
- }
-
- print $/, loc("Using '%1' as your configuration type", $type);
-
- return $self->config_type($type);
- }
-}
-
-
-### setup the build & cache dirs
-sub _setup_base {
- my $self = shift;
- my $term = $self->term;
- my $conf = $self->configure_object;
-
- my $base = $conf->get_conf('base');
- my $home = File::Spec->catdir( $self->_home_dir, DOT_CPANPLUS );
-
- print loc("
-CPANPLUS needs a directory of its own to cache important index
-files and maybe keep a temporary mirror of CPAN files.
-This may be a site-wide directory or a personal directory.
-
-For a single-user installation, we suggest using your home directory.
-
-");
-
- my $where;
- ASK_HOME_DIR: {
- my $other = loc('Somewhere else');
- if( $base and ($base ne $home) ) {
- print loc("You have several choices:");
-
- $where = $term->get_reply(
- prompt => loc('Please pick one'),
- choices => [$home, $base, $other],
- default => $home,
- );
- } else {
- $where = $base;
- }
-
- if( $where and -d $where ) {
- print loc("
-I see you already have a directory:
- %1
-
- "), $where;
-
- my $yn = $term->ask_yn(
- prompt => loc('Should I use it?'),
- default => 'y',
- );
- $where = '' unless $yn;
- }
-
- if( $where and ($where ne $other) and not -d $where ) {
- if (!$self->_mkdir( dir => $where ) ) {
- print "\n", loc("Unable to create directory '%1'", $where);
- redo ASK_HOME_DIR;
- }
-
- } elsif( not $where or ($where eq $other) ) {
- print loc("
-First of all, I'd like to create this directory.
-
- ");
-
- NEW_HOME: {
- $where = $term->get_reply(
- prompt => loc('Where shall I create it?'),
- default => $home,
- );
-
- my $again;
- if( -d $where and not -w _ ) {
- print "\n", loc("I can't seem to write in this directory");
- $again++;
- } elsif (!$self->_mkdir( dir => $where ) ) {
- print "\n", loc("Unable to create directory '%1'", $where);
- $again++;
- }
-
- if( $again ) {
- print "\n", loc('Please select another directory'), "\n\n";
- redo NEW_HOME;
- }
- }
- }
- }
-
- ### tidy up the path and store it
- $where = File::Spec->rel2abs($where);
- $conf->set_conf( base => $where );
-
- ### create subdirectories ###
- my @dirs =
- File::Spec->catdir( $where, $self->_perl_version(perl => $^X),
- $conf->_get_build('moddir') ),
- map {
- File::Spec->catdir( $where, $conf->_get_build($_) )
- } qw[autdir distdir];
-
- for my $dir ( @dirs ) {
- unless( $self->_mkdir( dir => $dir ) ) {
- warn loc("I wasn't able to create '%1'", $dir), "\n";
- }
- }
-
- ### clear away old storable images before 0.031
- for my $src (qw[dslip mailrc packages]) {
- 1 while unlink File::Spec->catfile( $where, $src );
-
- }
-
- print loc(q[
-Your CPANPLUS build and cache directory has been set to:
- %1
-
- ], $where);
-
- return 1;
-}
-
-sub _setup_ftp {
- my $self = shift;
- my $term = $self->term;
- my $conf = $self->configure_object;
-
- #########################
- ## are you a pacifist? ##
- #########################
-
- print loc("
-If you are connecting through a firewall or proxy that doesn't handle
-FTP all that well you can use passive FTP.
-
-");
-
- my $yn = $term->ask_yn(
- prompt => loc("Use passive FTP?"),
- default => $conf->get_conf('passive'),
- );
-
- $conf->set_conf(passive => $yn);
-
- ### set the ENV var as well, else it won't get set till AFTER
- ### the configuration is saved. but we fetch files BEFORE that.
- $ENV{FTP_PASSIVE} = $yn;
-
- print "\n";
- print $yn
- ? loc("I will use passive FTP.")
- : loc("I won't use passive FTP.");
- print "\n";
-
- #############################
- ## should fetches timeout? ##
- #############################
-
- print loc("
-CPANPLUS can specify a network timeout for downloads (in whole seconds).
-If none is desired (or to skip this question), enter '0'.
-
-");
-
- my $timeout = 0 + $term->get_reply(
- prompt => loc("Network timeout for downloads"),
- default => $conf->get_conf('timeout') || 0,
- allow => qr/(?!\D)/, ### whole numbers only
- );
-
- $conf->set_conf(timeout => $timeout);
-
- print "\n";
- print $timeout
- ? loc("The network timeout for downloads is %1 seconds.", $timeout)
- : loc("The network timeout for downloads is not set.");
- print "\n";
-
- ############################
- ## where can I reach you? ##
- ############################
-
- print loc("
-What email address should we send as our anonymous password when
-fetching modules from CPAN servers? Some servers will NOT allow you to
-connect without a valid email address, or at least something that looks
-like one.
-Also, if you choose to report test results at some point, a valid email
-is required for the 'from' field, so choose wisely.
-
- ");
-
- my $other = 'Something else';
- my @choices = (DEFAULT_EMAIL, $Config{cf_email}, $other);
- my $current = $conf->get_conf('email');
-
- ### if your current address is not in the list, add it to the choices
- unless (grep { $_ eq $current } @choices) {
- unshift @choices, $current;
- }
-
- my $email = $term->get_reply(
- prompt => loc('Which email address shall I use?'),
- default => $current || $choices[0],
- choices => \@choices,
- );
-
- if( $email eq $other ) {
- EMAIL: {
- $email = $term->get_reply(
- prompt => loc('Email address: '),
- );
-
- unless( $self->_valid_email($email) ) {
- print loc("
-You did not enter a valid email address, please try again!
- ") if length $email;
-
- redo EMAIL;
- }
- }
- }
-
- print loc("
-Your 'email' is now:
- %1
-
- ", $email);
-
- $conf->set_conf( email => $email );
-
- return 1;
-}
-
-
-### commandline programs
-sub _setup_program {
- my $self = shift;
- my $term = $self->term;
- my $conf = $self->configure_object;
-
- print loc("
-CPANPLUS can use command line utilities to do certain
-tasks, rather than use perl modules.
-
-If you wish to use a certain command utility, just enter
-the full path (or accept the default). If you do not wish
-to use it, enter a single space.
-
-Note that the paths you provide should not contain spaces, which is
-needed to make a distinction between program name and options to that
-program. For Win32 machines, you can use the short name for a path,
-like '%1'.
-", 'c:\Progra~1\prog.exe' );
-
- for my $prog ( sort $conf->options( type => 'program') ) {
- PROGRAM: {
- print "\n", loc("Where can I find your '%1' utility? ".
- "(Enter a single space to disable)", $prog ), "\n";
-
- my $loc = $term->get_reply(
- prompt => "Path to your '$prog'",
- default => $conf->get_program( $prog ),
- );
-
- ### empty line clears it
- my $cmd = $loc =~ /^\s*$/ ? undef : $loc;
- my ($bin) = $cmd =~ /^(\S+)/;
-
- ### did you provide a valid program ?
- if( $bin and not can_run( $bin ) ) {
- print "\n";
- print loc("Can not find the binary '%1' in your path!", $bin);
- redo PROGRAM;
- }
-
- ### make is special -- we /need/ it!
- if( $prog eq 'make' and not $bin ) {
- print loc(
- "==> Without your '%1' utility, I can not function! <==",
- 'make'
- );
- print loc("Please provide one!");
-
- ### show win32 where to download
- if ( $^O eq 'MSWin32' ) {
- print loc("You can get '%1' from:", NMAKE);
- print "\t". NMAKE_URL ."\n";
- }
- print "\n";
- redo PROGRAM;
- }
-
- $conf->set_program( $prog => $cmd );
- print $cmd
- ? loc( "Your '%1' utility has been set to '%2'.",
- $prog, $cmd )
- : loc( "Your '%1' has been disabled.", $prog );
- print "\n";
- }
- }
-
- return 1;
-}
-
-sub _setup_installer {
- my $self = shift;
- my $term = $self->term;
- my $conf = $self->configure_object;
-
- my $none = 'None';
- {
- print loc("
-CPANPLUS uses binary programs as well as Perl modules to accomplish
-various tasks. Normally, CPANPLUS will prefer the use of Perl modules
-over binary programs.
-
-You can change this setting by making CPANPLUS prefer the use of
-certain binary programs if they are available.
-
- ");
-
- ### default to using binaries if we don't have compress::zlib only
- ### -- it'll get very noisy otherwise
- my $type = 'prefer_bin';
- my $yn = $term->ask_yn(
- prompt => loc("Should I prefer the use of binary programs?"),
- default => $conf->get_conf( $type ),
- );
-
- print $yn
- ? loc("Ok, I will prefer to use binary programs if possible.")
- : loc("Ok, I will prefer to use Perl modules if possible.");
- print "\n\n";
-
-
- $conf->set_conf( $type => $yn );
- }
-
- {
- print loc("
-Makefile.PL is run by perl in a separate process, and accepts various
-flags that controls the module's installation. For instance, if you
-would like to install modules to your private user directory, set
-'makemakerflags' to:
-
-LIB=~/perl/lib INSTALLMAN1DIR=~/perl/man/man1 INSTALLMAN3DIR=~/perl/man/man3
-
-and be sure that you do NOT set UNINST=1 in 'makeflags' below.
-
-Enter a name=value list separated by whitespace, but quote any embedded
-spaces that you want to preserve. (Enter a space to clear any existing
-settings.)
-
-If you don't understand this question, just press ENTER.
-
- ");
-
- my $type = 'makemakerflags';
- my $flags = $term->get_reply(
- prompt => 'Makefile.PL flags?',
- default => $conf->get_conf($type),
- );
-
- $flags = '' if $flags eq $none || $flags !~ /\S/;
-
- print "\n", loc("Your '%1' have been set to:", 'Makefile.PL flags'),
- "\n ", ( $flags ? $flags : loc('*nothing entered*')),
- "\n\n";
-
- $conf->set_conf( $type => $flags );
- }
-
- {
- print loc("
-Like Makefile.PL, we run 'make' and 'make install' as separate processes.
-If you have any parameters (e.g. '-j3' in dual processor systems) you want
-to pass to the calls, please specify them here.
-
-In particular, 'UNINST=1' is recommended for root users, unless you have
-fine-tuned ideas of where modules should be installed in the \@INC path.
-
-Enter a name=value list separated by whitespace, but quote any embedded
-spaces that you want to preserve. (Enter a space to clear any existing
-settings.)
-
-Again, if you don't understand this question, just press ENTER.
-
- ");
- my $type = 'makeflags';
- my $flags = $term->get_reply(
- prompt => 'make flags?',
- default => $conf->get_conf($type),
- );
-
- $flags = '' if $flags eq $none || $flags !~ /\S/;
-
- print "\n", loc("Your '%1' have been set to:", $type),
- "\n ", ( $flags ? $flags : loc('*nothing entered*')),
- "\n\n";
-
- $conf->set_conf( $type => $flags );
- }
-
- {
- print loc("
-An alternative to ExtUtils::MakeMaker and Makefile.PL there's a module
-called Module::Build which uses a Build.PL.
-
-If you would like to specify any flags to pass when executing the
-Build.PL (and Build) script, please enter them below.
-
-For instance, if you would like to install modules to your private
-user directory, you could enter:
-
- install_base=/my/private/path
-
-Or to uninstall old copies of modules before updating, you might
-want to enter:
-
- uninst=1
-
-Again, if you don't understand this question, just press ENTER.
-
- ");
-
- my $type = 'buildflags';
- my $flags = $term->get_reply(
- prompt => 'Build.PL and Build flags?',
- default => $conf->get_conf($type),
- );
-
- $flags = '' if $flags eq $none || $flags !~ /\S/;
-
- print "\n", loc("Your '%1' have been set to:",
- 'Build.PL and Build flags'),
- "\n ", ( $flags ? $flags : loc('*nothing entered*')),
- "\n\n";
-
- $conf->set_conf( $type => $flags );
- }
-
- ### use EU::MM or module::build? ###
- {
- print loc("
-Some modules provide both a Build.PL (Module::Build) and a Makefile.PL
-(ExtUtils::MakeMaker). By default, CPANPLUS prefers Makefile.PL.
-
-Module::Build support is not bundled standard with CPANPLUS, but
-requires you to install 'CPANPLUS::Dist::Build' from CPAN.
-
-Although Module::Build is a pure perl solution, which means you will
-not need a 'make' binary, it does have some limitations. The most
-important is that CPANPLUS is unable to uninstall any modules installed
-by Module::Build.
-
-Again, if you don't understand this question, just press ENTER.
-
- ");
- my $type = 'prefer_makefile';
- my $yn = $term->ask_yn(
- prompt => loc("Prefer Makefile.PL over Build.PL?"),
- default => $conf->get_conf($type),
- );
-
- $conf->set_conf( $type => $yn );
- }
-
- {
- print loc('
-If you like, CPANPLUS can add extra directories to your @INC list during
-startup. These will just be used by CPANPLUS and will not change your
-external environment or perl interpreter. Enter a space separated list of
-pathnames to be added to your @INC, quoting any with embedded whitespace.
-(To clear the current value enter a single space.)
-
- ');
-
- my $type = 'lib';
- my $flags = $term->get_reply(
- prompt => loc('Additional @INC directories to add?'),
- default => (join " ", @{$conf->get_conf($type) || []} ),
- );
-
- my $lib;
- unless( $flags =~ /\S/ ) {
- $lib = [];
- } else {
- (@$lib) = $flags =~ m/\s*("[^"]+"|'[^']+'|[^\s]+)/g;
- }
-
- print "\n", loc("Your additional libs are now:"), "\n";
-
- print scalar @$lib
- ? map { " $_\n" } @$lib
- : " ", loc("*nothing entered*"), "\n";
- print "\n\n";
-
- $conf->set_conf( $type => $lib );
- }
-
- return 1;
-}
-
-
-sub _setup_conf {
- my $self = shift;
- my $term = $self->term;
- my $conf = $self->configure_object;
-
- my $none = 'None';
- {
- ############
- ## noisy? ##
- ############
-
- print loc("
-In normal operation I can just give you basic information about what I
-am doing, or I can be more verbose and give you every little detail.
-
- ");
-
- my $type = 'verbose';
- my $yn = $term->ask_yn(
- prompt => loc("Should I be verbose?"),
- default => $conf->get_conf( $type ), );
-
- print "\n";
- print $yn
- ? loc("You asked for it!")
- : loc("I'll try to be quiet");
-
- $conf->set_conf( $type => $yn );
- }
-
- {
- #######################
- ## flush you animal! ##
- #######################
-
- print loc("
-In the interest of speed, we keep track of what modules were installed
-successfully and which failed in the current session. We can flush this
-data automatically, or you can explicitly issue a 'flush' when you want
-to purge it.
-
- ");
-
- my $type = 'flush';
- my $yn = $term->ask_yn(
- prompt => loc("Flush automatically?"),
- default => $conf->get_conf( $type ),
- );
-
- print "\n";
- print $yn
- ? loc("I'll flush after every full module install.")
- : loc("I won't flush until you tell me to.");
-
- $conf->set_conf( $type => $yn );
- }
-
- {
- #####################
- ## force installs? ##
- #####################
-
- print loc("
-Usually, when a test fails, I won't install the module, but if you
-prefer, I can force the install anyway.
-
- ");
-
- my $type = 'force';
- my $yn = $term->ask_yn(
- prompt => loc("Force installs?"),
- default => $conf->get_conf( $type ),
- );
-
- print "\n";
- print $yn
- ? loc("I will force installs.")
- : loc("I won't force installs.");
-
- $conf->set_conf( $type => $yn );
- }
-
- {
- ###################
- ## about prereqs ##
- ###################
-
- print loc("
-Sometimes a module will require other modules to be installed before it
-will work. CPANPLUS can attempt to install these for you automatically
-if you like, or you can do the deed yourself.
-
-If you would prefer that we NEVER try to install extra modules
-automatically, select NO. (Usually you will want this set to YES.)
-
-If you would like to build modules to satisfy testing or prerequisites,
-but not actually install them, select BUILD.
-
-NOTE: This feature requires you to flush the 'lib' cache for longer
-running programs (refer to the CPANPLUS::Backend documentations for
-more details).
-
-Otherwise, select ASK to have us ask your permission to install them.
-
- ");
-
- my $type = 'prereqs';
-
- my @map = (
- [ PREREQ_IGNORE, # conf value
- loc('No, do not install prerequisites'), # UI Value
- loc("I won't install prerequisites") # diag message
- ],
- [ PREREQ_INSTALL,
- loc('Yes, please install prerequisites'),
- loc("I will install prerequisites")
- ],
- [ PREREQ_ASK,
- loc('Ask me before installing a prerequisite'),
- loc("I will ask permission to install")
- ],
- [ PREREQ_BUILD,
- loc('Build prerequisites, but do not install them'),
- loc( "I will only build, but not install prerequisites" )
- ],
- );
-
- my %reply = map { $_->[1] => $_->[0] } @map; # choice => value
- my %diag = map { $_->[1] => $_->[2] } @map; # choice => diag message
- my %conf = map { $_->[0] => $_->[1] } @map; # value => ui choice
-
- my $reply = $term->get_reply(
- prompt => loc('Follow prerequisites?'),
- default => $conf{ $conf->get_conf( $type ) },
- choices => [ @conf{ sort keys %conf } ],
- );
- print "\n";
-
- my $value = $reply{ $reply };
- my $diag = $diag{ $reply };
-
- $conf->set_conf( $type => $value );
- print $diag, "\n";
- }
-
- { print loc("
-Modules in the CPAN archives are protected with md5 checksums.
-
-This requires the Perl module Digest::MD5 to be installed (which
-CPANPLUS can do for you later);
-
- ");
- my $type = 'md5';
-
- my $yn = $term->ask_yn(
- prompt => loc("Shall I use the MD5 checksums?"),
- default => $conf->get_conf( $type ),
- );
-
- print $yn
- ? loc("I will use the MD5 checksums if you have it")
- : loc("I won't use the MD5 checksums");
-
- $conf->set_conf( $type => $yn );
-
- }
-
-
- { ###########################################
- ## sally sells seashells by the seashore ##
- ###########################################
-
- print loc("
-By default CPANPLUS uses its own shell when invoked. If you would prefer
-a different shell, such as one you have written or otherwise acquired,
-please enter the full name for your shell module.
-
- ");
-
- my $type = 'shell';
- my $other = 'Other';
- my @choices = (qw| CPANPLUS::Shell::Default
- CPANPLUS::Shell::Classic |,
- $other );
- my $default = $conf->get_conf($type);
-
- unshift @choices, $default unless grep { $_ eq $default } @choices;
-
- my $reply = $term->get_reply(
- prompt => loc('Which CPANPLUS shell do you want to use?'),
- default => $default,
- choices => \@choices,
- );
-
- if( $reply eq $other ) {
- SHELL: {
- $reply = $term->get_reply(
- prompt => loc( 'Please enter the name of the shell '.
- 'you wish to use: '),
- );
-
- unless( check_install( module => $reply ) ) {
- print "\n",
- loc("Could not find '$reply' in your path " .
- "-- please try again"),
- "\n";
- redo SHELL;
- }
- }
- }
-
- print "\n", loc("Your shell is now: %1", $reply), "\n\n";
-
- $conf->set_conf( $type => $reply );
- }
-
- {
- ###################
- ## use storable? ##
- ###################
-
- print loc("
-To speed up the start time of CPANPLUS, and maintain a cache over
-multiple runs, we can use Storable to freeze some information.
-Would you like to do this?
-
-");
- my $type = 'storable';
- my $yn = $term->ask_yn(
- prompt => loc("Use Storable?"),
- default => $conf->get_conf( $type ) ? 1 : 0,
- );
- print "\n";
- print $yn
- ? loc("I will use Storable if you have it")
- : loc("I will not use Storable");
-
- $conf->set_conf( $type => $yn );
- }
-
- {
- ###################
- ## use sqlite ? ##
- ###################
-
- print loc("
-
-To limit the amount of RAM used by CPANPLUS, you can use the SQLite
-source backend instead. Note that it is currently still experimental.
-Would you like to do this?
-
-");
- my $type = 'source_engine';
- my $class = 'CPANPLUS::Internals::Source::SQLite';
- my $yn = $term->ask_yn(
- prompt => loc("Use SQLite?"),
- default => $conf->get_conf( $type ) eq $class ? 1 : 0,
- );
- print "\n";
- print $yn
- ? loc("I will use SQLite")
- : loc("I will not use SQLite");
-
- $conf->set_conf( $type => $class );
- }
-
- {
- ###################
- ## use cpantest? ##
- ###################
-
- print loc("
-CPANPLUS has support for the Test::Reporter module, which can be utilized
-to report success and failures of modules installed by CPANPLUS. Would
-you like to do this? Note that you will still be prompted before
-sending each report.
-
-If you don't have all the required modules installed yet, you should
-consider installing '%1'
-
-This package bundles all the required modules to enable test reporting
-and querying from CPANPLUS.
-You can do so straight after this installation.
-
- ", 'Bundle::CPANPLUS::Test::Reporter');
-
- my $type = 'cpantest';
- my $yn = $term->ask_yn(
- prompt => loc('Report test results?'),
- default => $conf->get_conf( $type ) ? 1 : 0,
- );
-
- print "\n";
- print $yn
- ? loc("I will prompt you to report test results")
- : loc("I won't prompt you to report test results");
-
- $conf->set_conf( $type => $yn );
- }
-
- {
- ###################################
- ## use cryptographic signatures? ##
- ###################################
-
- print loc("
-The Module::Signature extension allows CPAN authors to sign their
-distributions using PGP signatures. Would you like to check for
-module's cryptographic integrity before attempting to install them?
-Note that this requires either the 'gpg' utility or Crypt::OpenPGP
-to be installed.
-
- ");
- my $type = 'signature';
-
- my $yn = $term->ask_yn(
- prompt => loc('Shall I check module signatures?'),
- default => $conf->get_conf($type) ? 1 : 0,
- );
-
- print "\n";
- print $yn
- ? loc("Ok, I will attempt to check module signatures.")
- : loc("Ok, I won't attempt to check module signatures.");
-
- $conf->set_conf( $type => $yn );
- }
-
- return 1;
-}
-
-sub _setup_hosts {
- my $self = shift;
- my $term = $self->term;
- my $conf = $self->configure_object;
-
-
- if( scalar @{ $conf->get_conf('hosts') } ) {
-
- my $hosts;
- for my $href ( @{$conf->get_conf('hosts')} ) {
- $hosts .= "\t$href->{scheme}://$href->{host}$href->{path}\n";
- }
-
- print loc("
-I see you already have some hosts selected:
-
-$hosts
-
-If you'd like to stick with your current settings, just select 'Yes'.
-Otherwise, select 'No' and you can reconfigure your hosts
-
-");
- my $yn = $term->ask_yn(
- prompt => loc("Would you like to keep your current hosts?"),
- default => 'y',
- );
- return 1 if $yn;
- }
-
- my @hosts;
- MAIN: {
-
- print loc("
-Now we need to know where your favorite CPAN sites are located. Make a
-list of a few sites (just in case the first on the array won't work).
-
-If you are mirroring CPAN to your local workstation, specify a file:
-URI by picking the CUSTOM option.
-
-Otherwise, let us fetch the official CPAN mirror list and you can pick
-the mirror that suits you best from a list by using the MIRROR option;
-First, pick a nearby continent and country. Then, you will be presented
-with a list of URLs of CPAN mirrors in the country you selected. Select
-one or more of those URLs.
-
-Note, the latter option requires a working net connection.
-
-You can select VIEW to see your current selection and QUIT when you
-are done.
-
-");
-
- my $reply = $term->get_reply(
- prompt => loc('Please choose an option'),
- choices => [qw|Mirror Custom View Quit|],
- default => 'Mirror',
- );
-
- goto MIRROR if $reply eq 'Mirror';
- goto CUSTOM if $reply eq 'Custom';
- goto QUIT if $reply eq 'Quit';
-
- $self->_view_hosts(@hosts) if $reply eq 'View';
- redo MAIN;
- }
-
- my $mirror_file;
- my $hosts;
- MIRROR: {
- $mirror_file ||= $self->_get_mirrored_by or return;
- $hosts ||= $self->_parse_mirrored_by($mirror_file) or return;
-
- my ($continent, $country, $host) = $self->_guess_from_timezone( $hosts );
-
- CONTINENT: {
- my %seen;
- my @choices = sort map {
- $_->{'continent'}
- } grep {
- not $seen{$_->{'continent'}}++
- } values %$hosts;
- push @choices, qw[Custom Up Quit];
-
- my $reply = $term->get_reply(
- prompt => loc('Pick a continent'),
- default => $continent,
- choices => \@choices,
- );
-
- goto MAIN if $reply eq 'Up';
- goto CUSTOM if $reply eq 'Custom';
- goto QUIT if $reply eq 'Quit';
-
- $continent = $reply;
- }
-
- COUNTRY: {
- my %seen;
- my @choices = sort map {
- $_->{'country'}
- } grep {
- not $seen{$_->{'country'}}++
- } grep {
- ($_->{'continent'} eq $continent)
- } values %$hosts;
- push @choices, qw[Custom Up Quit];
-
- my $reply = $term->get_reply(
- prompt => loc('Pick a country'),
- default => $country,
- choices => \@choices,
- );
-
- goto CONTINENT if $reply eq 'Up';
- goto CUSTOM if $reply eq 'Custom';
- goto QUIT if $reply eq 'Quit';
-
- $country = $reply;
- }
-
- HOST: {
- my @list = grep {
- $_->{'continent'} eq $continent and
- $_->{'country'} eq $country
- } values %$hosts;
-
- my %map; my $default;
- for my $href (@list) {
- for my $con ( @{$href->{'connections'}} ) {
- next unless length $con->{'host'};
-
- my $entry = $con->{'scheme'} . '://' . $con->{'host'};
- $default = $entry if $con->{'host'} eq $host;
-
- $map{$entry} = $con;
- }
- }
-
- CHOICE: {
-
- ### doesn't play nice with Term::UI :(
- ### should make t::ui figure out pager opens
- #$self->_pager_open; # host lists might be long
-
- print loc("
-You can enter multiple sites by separating them by a space.
-For example:
- 1 4 2 5
- ");
-
- my @reply = $term->get_reply(
- prompt => loc('Please pick a site: '),
- choices => [sort(keys %map),
- qw|Custom View Up Quit|],
- default => $default,
- multi => 1,
- );
- #$self->_pager_close;
-
-
- goto COUNTRY if grep { $_ eq 'Up' } @reply;
- goto CUSTOM if grep { $_ eq 'Custom' } @reply;
- goto QUIT if grep { $_ eq 'Quit' } @reply;
-
- ### add the host, but only if it's not on the stack already ###
- unless( grep { $_ eq 'View' } @reply ) {
- for my $reply (@reply) {
- if( grep { $_ eq $map{$reply} } @hosts ) {
- print loc("Host '%1' already selected", $reply);
- print "\n\n";
- } else {
- push @hosts, $map{$reply}
- }
- }
- }
-
- $self->_view_hosts(@hosts);
-
- goto QUIT if $self->autoreply;
- redo CHOICE;
- }
- }
- }
-
- CUSTOM: {
- print loc("
-If there are any additional URLs you would like to use, please add them
-now. You may enter them separately or as a space delimited list.
-
-We provide a default fall-back URL, but you are welcome to override it
-with e.g. 'http://www.cpan.org/' if LWP, wget or curl is installed.
-
-(Enter a single space when you are done, or to simply skip this step.)
-
-Note that if you want to use a local depository, you will have to enter
-as follows:
-
-file://server/path/to/cpan
-
-if the file is on a server on your local network or as:
-
-file:///path/to/cpan
-
-if the file is on your local disk. Note the three /// after the file: bit
-
-");
-
- CHOICE: {
- my $reply = $term->get_reply(
- prompt => loc("Additionals host(s) to add: "),
- default => '',
- );
-
- last CHOICE unless $reply =~ /\S/;
-
- my $href = $self->_parse_host($reply);
-
- if( $href ) {
- push @hosts, $href
- unless grep {
- $href->{'scheme'} eq $_->{'scheme'} and
- $href->{'host'} eq $_->{'host'} and
- $href->{'path'} eq $_->{'path'}
- } @hosts;
-
- last CHOICE if $self->autoreply;
- } else {
- print loc("Invalid uri! Please try again!");
- }
-
- $self->_view_hosts(@hosts);
-
- redo CHOICE;
- }
-
- DONE: {
-
- print loc("
-Where would you like to go now?
-
-Please pick one of the following options or Quit when you are done
-
-");
- my $answer = $term->get_reply(
- prompt => loc("Where to now?"),
- default => 'Quit',
- choices => [qw|Mirror Custom View Quit|],
- );
-
- if( $answer eq 'View' ) {
- $self->_view_hosts(@hosts);
- redo DONE;
- }
-
- goto MIRROR if $answer eq 'Mirror';
- goto CUSTOM if $answer eq 'Custom';
- goto QUIT if $answer eq 'Quit';
- }
- }
-
- QUIT: {
- $conf->set_conf( hosts => \@hosts );
-
- print loc("
-Your host configuration has been saved
-
-");
- }
-
- return 1;
-}
-
-sub _view_hosts {
- my $self = shift;
- my @hosts = @_;
-
- print "\n\n";
-
- if( scalar @hosts ) {
- my $i = 1;
- for my $host (@hosts) {
-
- ### show full path on file uris, otherwise, just show host
- my $path = join '', (
- $host->{'scheme'} eq 'file'
- ? ( ($host->{'host'} || '[localhost]'),
- $host->{path} )
- : $host->{'host'}
- );
-
- printf "%-40s %30s\n",
- loc("Selected %1",$host->{'scheme'} . '://' . $path ),
- loc("%quant(%2,host) selected thus far.", $i);
- $i++;
- }
- } else {
- print loc("No hosts selected so far.");
- }
-
- print "\n\n";
-
- return 1;
-}
-
-sub _get_mirrored_by {
- my $self = shift;
- my $cpan = $self->backend;
- my $conf = $self->configure_object;
-
- print loc("
-Now, we are going to fetch the mirror list for first-time configurations.
-This may take a while...
-
-");
-
- ### use the new configuration ###
- $cpan->configure_object( $conf );
-
- load CPANPLUS::Module::Fake;
- load CPANPLUS::Module::Author::Fake;
-
- my $mb = CPANPLUS::Module::Fake->new(
- module => $conf->_get_source('hosts'),
- path => '',
- package => $conf->_get_source('hosts'),
- author => CPANPLUS::Module::Author::Fake->new(
- _id => $cpan->_id ),
- _id => $cpan->_id,
- );
-
- my $file = $cpan->_fetch( fetchdir => $conf->get_conf('base'),
- module => $mb );
-
- return $file if $file;
- return;
-}
-
-sub _parse_mirrored_by {
- my $self = shift;
- my $file = shift;
-
- -s $file or return;
-
- my $fh = new FileHandle;
- $fh->open("$file")
- or (
- warn(loc('Could not open file "%1": %2', $file, $!)),
- return
- );
-
- ### slurp the file in ###
- { local $/; $file = <$fh> }
-
- ### remove comments ###
- $file =~ s/#.*$//gm;
-
- $fh->close;
-
- ### sample host entry ###
- # ftp.sun.ac.za:
- # frequency = "daily"
- # dst_ftp = "ftp://ftp.sun.ac.za/CPAN/CPAN/"
- # dst_location = "Stellenbosch, South Africa, Africa (-26.1992 28.0564)"
- # dst_organisation = "University of Stellenbosch"
- # dst_timezone = "+2"
- # dst_contact = "ftpadm@ftp.sun.ac.za"
- # dst_src = "ftp.funet.fi"
- #
- # # dst_dst = "ftp://ftp.sun.ac.za/CPAN/CPAN/"
- # # dst_contact = "mailto:ftpadm@ftp.sun.ac.za
- # # dst_src = "ftp.funet.fi"
-
- ### host name as key, rest of the entry as value ###
- my %hosts = $file =~ m/([a-zA-Z0-9\-\.]+):\s+((?:\w+\s+=\s+".*?"\s+)+)/gs;
-
- while (my($host,$data) = each %hosts) {
-
- my $href;
- map {
- s/^\s*//;
- my @a = split /\s*=\s*/;
- $a[1] =~ s/^"(.+?)"$/$1/g;
- $href->{ pop @a } = pop @a;
- } grep /\S/, split /\n/, $data;
-
- ($href->{city_area}, $href->{country}, $href->{continent},
- $href->{latitude}, $href->{longitude} ) =
- $href->{dst_location} =~
- m/
- #Aizu-Wakamatsu, Tohoku-chiho, Fukushima
- ^"?(
- (?:[^,]+?)\s* # city
- (?:
- (?:,\s*[^,]+?)\s* # optional area
- )*? # some have multiple areas listed
- )
-
- #Japan
- ,\s*([^,]+?)\s* # country
-
- #Asia
- ,\s*([^,]+?)\s* # continent
-
- # (37.4333 139.9821)
- \((\S+)\s+(\S+?)\)"?$ # (latitude longitude)
- /sx;
-
- ### parse the different hosts, store them in config format ###
- my @list;
-
- for my $type (qw[dst_ftp dst_rsync dst_http]) {
- my $path = $href->{$type};
- next unless $path =~ /\w/;
- if ($type eq 'dst_rsync' && $path !~ /^rsync:/) {
- $path =~ s{::}{/};
- $path = "rsync://$path/";
- }
- my $parts = $self->_parse_host($path);
- push @list, $parts;
- }
-
- $href->{connections} = \@list;
- $hosts{$host} = $href;
- }
-
- return \%hosts;
-}
-
-sub _parse_host {
- my $self = shift;
- my $host = shift;
-
- my @parts = $host =~ m|^(\w*)://([^/]*)(/.*)$|s;
-
- my $href;
- for my $key (qw[scheme host path]) {
- $href->{$key} = shift @parts;
- }
-
- return if lc($href->{'scheme'}) ne 'file' and !$href->{'host'};
- return if !$href->{'path'};
-
- return $href;
-}
-
-## tries to figure out close hosts based on your timezone
-##
-## Currently can only report on unique items for each of zones, countries, and
-## sites. In the future this will be combined with something else (perhaps a
-## ping?) to narrow down multiple choices.
-##
-## Tries to return the best zone, country, and site for your location. Any non-
-## unique items will be set to undef instead.
-##
-## (takes hashref, returns array)
-##
-sub _guess_from_timezone {
- my $self = shift;
- my $hosts = shift;
- my (%zones, %countries, %sites);
-
- ### autrijus - build time zone table
- my %freq_weight = (
- 'hourly' => 2400,
- '4 times a day' => 400,
- '4x daily' => 400,
- 'daily' => 100,
- 'twice daily' => 50,
- 'weekly' => 15,
- );
-
- while (my ($site, $host) = each %{$hosts}) {
- my ($zone, $continent, $country, $frequency) =
- @{$host}{qw/dst_timezone continent country frequency/};
-
-
- # skip non-well-formed ones
- next unless $continent and $country and $zone =~ /^[-+]?\d+(?::30)?/;
- ### fix style
- chomp $zone;
- $zone =~ s/:30/.5/;
- $zone =~ s/^\+//;
- $zone =~ s/"//g;
-
- $zones{$zone}{$continent}++;
- $countries{$zone}{$continent}{$country}++;
- $sites{$zone}{$continent}{$country}{$site} = $freq_weight{$frequency};
- }
-
- use Time::Local;
- my $offset = ((timegm(localtime) - timegm(gmtime)) / 3600);
-
- local $_;
-
- ## pick the entry with most country/site/frequency, one level each;
- ## note it has to be sorted -- otherwise we're depending on the hash order.
- ## also, the list context assignment (pick first one) is deliberate.
-
- my ($continent) = map {
- (sort { ($_->{$b} <=> $_->{$a}) or $b cmp $a } keys(%{$_}))
- } $zones{$offset};
-
- my ($country) = map {
- (sort { ($_->{$b} <=> $_->{$a}) or $b cmp $a } keys(%{$_}))
- } $countries{$offset}{$continent};
-
- my ($site) = map {
- (sort { ($_->{$b} <=> $_->{$a}) or $b cmp $a } keys(%{$_}))
- } $sites{$offset}{$continent}{$country};
-
- return ($continent, $country, $site);
-} # _guess_from_timezone
-
-
-### big big regex, stolen to check if you enter a valid address
-{
- my $RFC822PAT; # RFC pattern to match for valid email address
-
- sub _valid_email {
- my $self = shift;
- if (!$RFC822PAT) {
- my $esc = '\\\\'; my $Period = '\.'; my $space = '\040';
- my $tab = '\t'; my $OpenBR = '\['; my $CloseBR = '\]';
- my $OpenParen = '\('; my $CloseParen = '\)'; my $NonASCII = '\x80-\xff';
- my $ctrl = '\000-\037'; my $CRlist = '\012\015';
-
- my $qtext = qq/[^$esc$NonASCII$CRlist\"]/;
- my $dtext = qq/[^$esc$NonASCII$CRlist$OpenBR$CloseBR]/;
- my $quoted_pair = qq< $esc [^$NonASCII] >; # an escaped character
- my $ctext = qq< [^$esc$NonASCII$CRlist()] >;
- my $Cnested = qq< $OpenParen $ctext* (?: $quoted_pair $ctext* )* $CloseParen >;
- my $comment = qq< $OpenParen $ctext* (?: (?: $quoted_pair | $Cnested ) $ctext* )* $CloseParen >;
- my $X = qq< [$space$tab]* (?: $comment [$space$tab]* )* >;
- my $atom_char = qq/[^($space)<>\@,;:\".$esc$OpenBR$CloseBR$ctrl$NonASCII]/;
- my $atom = qq< $atom_char+ (?!$atom_char) >;
- my $quoted_str = qq< \" $qtext * (?: $quoted_pair $qtext * )* \" >;
- my $word = qq< (?: $atom | $quoted_str ) >;
- my $domain_ref = $atom;
- my $domain_lit = qq< $OpenBR (?: $dtext | $quoted_pair )* $CloseBR >;
- my $sub_domain = qq< (?: $domain_ref | $domain_lit) $X >;
- my $domain = qq< $sub_domain (?: $Period $X $sub_domain)* >;
- my $route = qq< \@ $X $domain (?: , $X \@ $X $domain )* : $X >;
- my $local_part = qq< $word $X (?: $Period $X $word $X )* >;
- my $addr_spec = qq< $local_part \@ $X $domain >;
- my $route_addr = qq[ < $X (?: $route )? $addr_spec > ];
- my $phrase_ctrl = '\000-\010\012-\037'; # like ctrl, but without tab
- my $phrase_char = qq/[^()<>\@,;:\".$esc$OpenBR$CloseBR$NonASCII$phrase_ctrl]/;
- my $phrase = qq< $word $phrase_char * (?: (?: $comment | $quoted_str ) $phrase_char * )* >;
- $RFC822PAT = qq< $X (?: $addr_spec | $phrase $route_addr) >;
- }
-
- return scalar ($_[0] =~ /$RFC822PAT/ox);
- }
-}
-
-
-
-
-
-
-1;
-
-
-sub _edit {
- my $self = shift;
- my $conf = $self->configure_object;
- my $file = shift || $conf->_config_pm_to_file( $self->config_type );
- my $editor = shift || $conf->get_program('editor');
- my $term = $self->term;
-
- unless( $editor ) {
- print loc("
-I'm sorry, I can't find a suitable editor, so I can't offer you
-post-configuration editing of the config file
-
-");
- return 1;
- }
-
- ### save the thing first, so there's something to edit
- $self->_save;
-
- return !system("$editor $file");
-}
-
-sub _save {
- my $self = shift;
- my $conf = $self->configure_object;
-
- return $conf->save( $self->config_type );
-}
-
-1;
+++ /dev/null
-package CPANPLUS::Dist;
-use deprecate;
-
-use strict;
-
-use CPANPLUS::Error;
-use CPANPLUS::Internals::Constants;
-
-use Cwd ();
-use Object::Accessor;
-use Parse::CPAN::Meta;
-
-use IPC::Cmd qw[run];
-use Params::Check qw[check];
-use Module::Load::Conditional qw[can_load check_install];
-use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';
-
-use vars qw[$VERSION];
-$VERSION = "0.9135";
-
-use base 'Object::Accessor';
-
-local $Params::Check::VERBOSE = 1;
-
-=pod
-
-=head1 NAME
-
-CPANPLUS::Dist - base class for plugins
-
-=head1 SYNOPSIS
-
- my $dist = CPANPLUS::Dist::YOUR_DIST_TYPE_HERE->new(
- module => $modobj,
- );
-
-=head1 DESCRIPTION
-
-C<CPANPLUS::Dist> is a base class for C<CPANPLUS::Dist::MM>
-and C<CPANPLUS::Dist::Build>. Developers of other C<CPANPLUS::Dist::*>
-plugins should look at C<CPANPLUS::Dist::Base>.
-
-=head1 ACCESSORS
-
-=over 4
-
-=item parent()
-
-Returns the C<CPANPLUS::Module> object that parented this object.
-
-=item status()
-
-Returns the C<Object::Accessor> object that keeps the status for
-this module.
-
-=back
-
-=head1 STATUS ACCESSORS
-
-All accessors can be accessed as follows:
- $deb->status->ACCESSOR
-
-=over 4
-
-=item created()
-
-Boolean indicating whether the dist was created successfully.
-Explicitly set to C<0> when failed, so a value of C<undef> may be
-interpreted as C<not yet attempted>.
-
-=item installed()
-
-Boolean indicating whether the dist was installed successfully.
-Explicitly set to C<0> when failed, so a value of C<undef> may be
-interpreted as C<not yet attempted>.
-
-=item uninstalled()
-
-Boolean indicating whether the dist was uninstalled successfully.
-Explicitly set to C<0> when failed, so a value of C<undef> may be
-interpreted as C<not yet attempted>.
-
-=item dist()
-
-The location of the final distribution. This may be a file or
-directory, depending on how your distribution plug in of choice
-works. This will be set upon a successful create.
-
-=cut
-
-=back
-
-=head2 $dist = CPANPLUS::Dist::YOUR_DIST_TYPE_HERE->new( module => MODOBJ );
-
-Create a new C<CPANPLUS::Dist::YOUR_DIST_TYPE_HERE> object based on the
-provided C<MODOBJ>.
-
-*** DEPRECATED ***
-The optional argument C<format> is used to indicate what type of dist
-you would like to create (like C<CPANPLUS::Dist::MM> or
-C<CPANPLUS::Dist::Build> and so on ).
-
-C<< CPANPLUS::Dist->new >> is exclusively meant as a method to be
-inherited by C<CPANPLUS::Dist::MM|Build>.
-
-Returns a C<CPANPLUS::Dist::YOUR_DIST_TYPE_HERE> object on success
-and false on failure.
-
-=cut
-
-sub new {
- my $self = shift;
- my $class = ref $self || $self;
- my %hash = @_;
-
- ### first verify we got a module object ###
- my( $mod, $format );
- my $tmpl = {
- module => { required => 1, allow => IS_MODOBJ, store => \$mod },
- ### for backwards compatibility
- format => { default => $class, store => \$format,
- allow => [ __PACKAGE__->dist_types ],
- },
- };
- check( $tmpl, \%hash ) or return;
-
- unless( can_load( modules => { $format => '0.0' }, verbose => 1 ) ) {
- error(loc("'%1' not found -- you need '%2' version '%3' or higher ".
- "to detect plugins", $format, 'Module::Pluggable','2.4'));
- return;
- }
-
- ### get an empty o::a object for this class
- my $obj = $format->SUPER::new;
-
- $obj->mk_accessors( qw[parent status] );
-
- ### set the parent
- $obj->parent( $mod );
-
- ### create a status object ###
- { my $acc = Object::Accessor->new;
- $obj->status($acc);
-
- ### add minimum supported accessors
- $acc->mk_accessors( qw[prepared created installed uninstalled
- distdir dist] );
- }
-
- ### get the conf object ###
- my $conf = $mod->parent->configure_object();
-
- ### check if the format is available in this environment ###
- if( $conf->_get_build('sanity_check') and not $obj->format_available ) {
- error( loc( "Format '%1' is not available", $format) );
- return;
- }
-
- ### now initialize it or admit failure
- unless( $obj->init ) {
- error(loc("Dist initialization of '%1' failed for '%2'",
- $format, $mod->module));
- return;
- }
-
- ### return the object
- return $obj;
-}
-
-=head2 @dists = CPANPLUS::Dist->dist_types;
-
-Returns a list of the CPANPLUS::Dist::* classes available
-
-=cut
-
-### returns a list of dist_types we support
-### will get overridden by Module::Pluggable if loaded
-### XXX add support for 'plugin' dir in config as well
-{ my $Loaded;
- my @Dists = (INSTALLER_MM);
- my @Ignore = ();
-
- ### backdoor method to add more dist types
- sub _add_dist_types { my $self = shift; push @Dists, @_ };
-
- ### backdoor method to exclude dist types
- sub _ignore_dist_types { my $self = shift; push @Ignore, @_ };
- sub _reset_dist_ignore { @Ignore = () };
-
- ### locally add the plugins dir to @INC, so we can find extra plugins
- #local @INC = @INC, File::Spec->catdir(
- # $conf->get_conf('base'),
- # $conf->_get_build('plugins') );
-
- ### load any possible plugins
- sub dist_types {
-
- if ( !$Loaded++ and check_install( module => 'Module::Pluggable',
- version => '2.4')
- ) {
- require Module::Pluggable;
-
- my $only_re = __PACKAGE__ . '::\w+$';
- my %except = map { $_ => 1 }
- INSTALLER_SAMPLE,
- INSTALLER_BASE;
-
- Module::Pluggable->import(
- sub_name => '_dist_types',
- search_path => __PACKAGE__,
- only => qr/$only_re/,
- require => 1,
- except => [ keys %except ]
- );
- my %ignore = map { $_ => $_ } @Ignore;
-
- push @Dists, grep { not $ignore{$_} and not $except{$_} }
- __PACKAGE__->_dist_types;
- }
-
- return @Dists;
- }
-
-=head2 $bool = CPANPLUS::Dist->rescan_dist_types;
-
-Rescans C<@INC> for available dist types. Useful if you've installed new
-C<CPANPLUS::Dist::*> classes and want to make them available to the
-current process.
-
-=cut
-
- sub rescan_dist_types {
- my $dist = shift;
- $Loaded = 0; # reset the flag;
- return $dist->dist_types;
- }
-}
-
-=head2 $bool = CPANPLUS::Dist->has_dist_type( $type )
-
-Returns true if distribution type C<$type> is loaded/supported.
-
-=cut
-
-sub has_dist_type {
- my $dist = shift;
- my $type = shift or return;
-
- return scalar grep { $_ eq $type } CPANPLUS::Dist->dist_types;
-}
-
-=head2 $bool = $dist->prereq_satisfied( modobj => $modobj, version => $version_spec )
-
-Returns true if this prereq is satisfied. Returns false if it's not.
-Also issues an error if it seems "unsatisfiable," i.e. if it can't be
-found on CPAN or the latest CPAN version doesn't satisfy it.
-
-=cut
-
-sub prereq_satisfied {
- my $dist = shift;
- my $cb = $dist->parent->parent;
- my %hash = @_;
-
- my($mod,$ver);
- my $tmpl = {
- version => { required => 1, store => \$ver },
- modobj => { required => 1, store => \$mod, allow => IS_MODOBJ },
- };
-
- check( $tmpl, \%hash ) or return;
-
- return 1 if $mod->is_uptodate( version => $ver );
-
- if ( $cb->_vcmp( $ver, $mod->version ) > 0 ) {
-
- error(loc(
- "This distribution depends on %1, but the latest version".
- " of %2 on CPAN (%3) doesn't satisfy the specific version".
- " dependency (%4). You may have to resolve this dependency ".
- "manually.",
- $mod->module, $mod->module, $mod->version, $ver ));
-
- }
-
- return;
-}
-
-=head2 $configure_requires = $dist->find_configure_requires( [file => /path/to/META.yml] )
-
-Reads the configure_requires for this distribution from the META.yml or META.json
-file in the root directory and returns a hashref with module names
-and versions required.
-
-=cut
-
-sub find_configure_requires {
- my $self = shift;
- my $mod = $self->parent;
- my %hash = @_;
-
- my ($meta);
- my $href = {};
-
- my $tmpl = {
- file => { store => \$meta },
- };
-
- check( $tmpl, \%hash ) or return;
-
- my $meth = 'configure_requires';
-
- {
-
- ### the prereqs as we have them now
- my @args = (
- defaults => $mod->status->$meth || {},
- );
-
- my @possibles = do { defined $mod->status->extract
- ? ( META_JSON->( $mod->status->extract ),
- META_YML->( $mod->status->extract ) )
- : ()
- };
-
- unshift @possibles, $meta if $meta;
-
- META: foreach my $mfile ( grep { -e } @possibles ) {
- push @args, ( file => $mfile );
- if ( $mfile =~ /\.json/ ) {
- $href = $self->_prereqs_from_meta_json( @args, keys => [ 'configure' ] );
- }
- else {
- $href = $self->_prereqs_from_meta_file( @args, keys => [ $meth ] );
- }
- last META;
- }
-
- }
-
- ### and store it in the module
- $mod->status->$meth( $href );
-
- return { %$href };
-}
-
-sub find_mymeta_requires {
- my $self = shift;
- my $mod = $self->parent;
- my %hash = @_;
-
- my ($meta);
- my $href = {};
-
- my $tmpl = {
- file => { store => \$meta },
- };
-
- check( $tmpl, \%hash ) or return;
-
- my $meth = 'prereqs';
-
- {
-
- ### the prereqs as we have them now
- my @args = (
- defaults => $mod->status->$meth || {},
- );
-
- my @possibles = do { defined $mod->status->extract
- ? ( MYMETA_JSON->( $mod->status->extract ),
- MYMETA_YML->( $mod->status->extract ) )
- : ()
- };
-
- unshift @possibles, $meta if $meta;
-
- META: foreach my $mfile ( grep { -e } @possibles ) {
- push @args, ( file => $mfile );
- if ( $mfile =~ /\.json/ ) {
- $href = $self->_prereqs_from_meta_json( @args,
- keys => [ qw|build test runtime| ] );
- }
- else {
- $href = $self->_prereqs_from_meta_file( @args,
- keys => [ qw|build_requires requires| ] );
- }
- last META;
- }
-
- }
-
- ### and store it in the module
- $mod->status->$meth( $href );
-
- return { %$href };
-}
-
-sub _prereqs_from_meta_file {
- my $self = shift;
- my $mod = $self->parent;
- my %hash = @_;
-
- my( $meta, $defaults, $keys );
- my $tmpl = { ### check if we have an extract path. if not, we
- ### get 'undef value' warnings from file::spec
- file => { default => do { defined $mod->status->extract
- ? META_YML->( $mod->status->extract )
- : '' },
- store => \$meta,
- },
- defaults => { required => 1, default => {}, strict_type => 1,
- store => \$defaults },
- keys => { required => 1, default => [], strict_type => 1,
- store => \$keys },
- };
-
- check( $tmpl, \%hash ) or return;
-
- ### if there's a meta file, we read it;
- if( -e $meta ) {
-
- ### Parse::CPAN::Meta uses exceptions for errors
- ### hash returned in list context!!!
-
- local $ENV{PERL_JSON_BACKEND};
-
- my ($doc) = eval { Parse::CPAN::Meta::LoadFile( $meta ) };
-
- unless( $doc ) {
- error(loc( "Could not read %1: '%2'", $meta, $@ ));
- return $defaults;
- }
-
- ### read the keys now, make sure not to throw
- ### away anything that was already added
- for my $key ( @$keys ) {
- $defaults = {
- %$defaults,
- %{ $doc->{$key} },
- } if $doc->{ $key };
- }
- }
-
- ### and return a copy
- return \%{ $defaults };
-}
-
-sub _prereqs_from_meta_json {
- my $self = shift;
- my $mod = $self->parent;
- my %hash = @_;
-
- my( $meta, $defaults, $keys );
- my $tmpl = { ### check if we have an extract path. if not, we
- ### get 'undef value' warnings from file::spec
- file => { default => do { defined $mod->status->extract
- ? META_JSON->( $mod->status->extract )
- : '' },
- store => \$meta,
- },
- defaults => { required => 1, default => {}, strict_type => 1,
- store => \$defaults },
- keys => { required => 1, default => [], strict_type => 1,
- store => \$keys },
- };
-
- check( $tmpl, \%hash ) or return;
-
- ### if there's a meta file, we read it;
- if( -e $meta ) {
-
- ### Parse::CPAN::Meta uses exceptions for errors
- ### hash returned in list context!!!
-
- local $ENV{PERL_JSON_BACKEND};
-
- my ($doc) = eval { Parse::CPAN::Meta->load_file( $meta ) };
-
- unless( $doc ) {
- error(loc( "Could not read %1: '%2'", $meta, $@ ));
- return $defaults;
- }
-
- ### read the keys now, make sure not to throw
- ### away anything that was already added
- #for my $key ( @$keys ) {
- # $defaults = {
- # %$defaults,
- # %{ $doc->{$key} },
- # } if $doc->{ $key };
- #}
- my $prereqs = $doc->{prereqs} || {};
- for my $key ( @$keys ) {
- $defaults = {
- %$defaults,
- %{ $prereqs->{$key}->{requires} },
- } if $prereqs->{ $key }->{requires};
- }
- }
-
- ### and return a copy
- return \%{ $defaults };
-}
-
-=head2 $bool = $dist->_resolve_prereqs( ... )
-
-Makes sure prerequisites are resolved
-
- format The dist class to use to make the prereqs
- (ie. CPANPLUS::Dist::MM)
-
- prereqs Hash of the prerequisite modules and their versions
-
- target What to do with the prereqs.
- create => Just build them
- install => Install them
- ignore => Ignore them
-
- prereq_build If true, always build the prereqs even if already
- resolved
-
- verbose Be verbose
-
- force Force the prereq to be built, even if already resolved
-
-=cut
-
-sub _resolve_prereqs {
- my $dist = shift;
- my $self = $dist->parent;
- my $cb = $self->parent;
- my $conf = $cb->configure_object;
- my %hash = @_;
-
- my ($prereqs, $format, $verbose, $target, $force, $prereq_build,$tolerant);
- my $tmpl = {
- ### XXX perhaps this should not be required, since it may not be
- ### packaged, just installed...
- ### Let it be empty as well -- that means the $modobj->install
- ### routine will figure it out, which is fine if we didn't have any
- ### very specific wishes (it will even detect the favourite
- ### dist_type).
- format => { required => 1, store => \$format,
- allow => ['',__PACKAGE__->dist_types], },
- prereqs => { required => 1, default => { },
- strict_type => 1, store => \$prereqs },
- verbose => { default => $conf->get_conf('verbose'),
- store => \$verbose },
- force => { default => $conf->get_conf('force'),
- store => \$force },
- ### make sure allow matches with $mod->install's list
- target => { default => '', store => \$target,
- allow => ['',qw[create ignore install]] },
- prereq_build => { default => 0, store => \$prereq_build },
- tolerant => { default => $conf->get_conf('allow_unknown_prereqs'),
- store => \$tolerant },
- };
-
- check( $tmpl, \%hash ) or return;
-
- ### so there are no prereqs? then don't even bother
- return 1 unless keys %$prereqs;
-
- ### Make sure we wound up where we started.
- my $original_wd = Cwd::cwd;
-
- ### so you didn't provide an explicit target.
- ### maybe your config can tell us what to do.
- $target ||= {
- PREREQ_ASK, TARGET_INSTALL, # we'll bail out if the user says no
- PREREQ_BUILD, TARGET_CREATE,
- PREREQ_IGNORE, TARGET_IGNORE,
- PREREQ_INSTALL, TARGET_INSTALL,
- }->{ $conf->get_conf('prereqs') } || '';
-
- ### XXX BIG NASTY HACK XXX FIXME at some point.
- ### when installing Bundle::CPANPLUS::Dependencies, we want to
- ### install all packages matching 'cpanplus' to be installed last,
- ### as all CPANPLUS' prereqs are being installed as well, but are
- ### being loaded for bootstrapping purposes. This means CPANPLUS
- ### can find them, but for example cpanplus::dist::build won't,
- ### which gets messy FAST. So, here we sort our prereqs only IF
- ### the parent module is Bundle::CPANPLUS::Dependencies.
- ### Really, we would wnat some sort of sorted prereq mechanism,
- ### but Bundle:: doesn't support it, and we flatten everything
- ### to a hash internally. A sorted hash *might* do the trick if
- ### we got a transparent implementation.. that would mean we would
- ### just have to remove the 'sort' here, and all will be well
- my @sorted_prereqs;
-
- ### use regex, could either be a module name, or a package name
- if( $self->module =~ /^Bundle(::|-)CPANPLUS(::|-)Dependencies/ ) {
- my (@first, @last);
- for my $mod ( sort keys %$prereqs ) {
- $mod =~ /CPANPLUS/
- ? push @last, $mod
- : push @first, $mod;
- }
- @sorted_prereqs = (@first, @last);
- } else {
- @sorted_prereqs = sort keys %$prereqs;
- }
-
- ### first, transfer this key/value pairing into a
- ### list of module objects + desired versions
- my @install_me;
-
- my $flag;
-
- for my $mod ( @sorted_prereqs ) {
- ( my $version = $prereqs->{$mod} ) =~ s#[^0-9\._]+##g;
-
- ### 'perl' is a special case, there's no mod object for it
- if( $mod eq PERL_CORE ) {
-
- unless( $cb->_vcmp( sprintf('v%vd',$^V), $version ) >= 0 ) {
- error(loc( "Module '%1' needs perl version '%2', but you ".
- "only have version '%3' -- can not proceed",
- $self->module, $version,
- $cb->_perl_version( perl => $^X ) ) );
- return;
- }
-
- next;
- }
-
- my $modobj = $cb->module_tree($mod);
-
- #### XXX we ignore the version, and just assume that the latest
- #### version from cpan will meet your requirements... dodgy =/
- unless( $modobj ) {
- # Check if it is a core module
- my $sub = CPANPLUS::Module->can(
- 'module_is_supplied_with_perl_core' );
- my $core = $sub->( $mod );
- unless ( defined $core ) {
- error( loc( "No such module '%1' found on CPAN", $mod ) );
- $flag++ unless $tolerant;
- next;
- }
- if ( $cb->_vcmp( $version, $core ) > 0 ) {
- error(loc( "Version of core module '%1' ('%2') is too low for ".
- "'%3' (needs '%4') -- carrying on but this may be a problem",
- $mod, $core,
- $self->module, $version ));
- }
- next;
- }
-
- ### it's not uptodate, we need to install it
- if( !$dist->prereq_satisfied(modobj => $modobj, version => $version)) {
- msg(loc("Module '%1' requires '%2' version '%3' to be installed ",
- $self->module, $modobj->module, $version), $verbose );
-
- push @install_me, [$modobj, $version];
-
- ### it's not an MM or Build format, that means it's a package
- ### manager... we'll need to install it as well, via the PM
- } elsif ( INSTALL_VIA_PACKAGE_MANAGER->($format) and
- !$modobj->package_is_perl_core and
- ($target ne TARGET_IGNORE)
- ) {
- msg(loc("Module '%1' depends on '%2', may need to build a '%3' ".
- "package for it as well", $self->module, $modobj->module,
- $format));
- push @install_me, [$modobj, $version];
- }
- }
-
-
-
- ### so you just want to ignore prereqs? ###
- if( $target eq TARGET_IGNORE ) {
-
- ### but you have modules you need to install
- if( @install_me ) {
- msg(loc("Ignoring prereqs, this may mean your install will fail"),
- $verbose);
- msg(loc("'%1' listed the following dependencies:", $self->module),
- $verbose);
-
- for my $aref (@install_me) {
- my ($mod,$version) = @$aref;
-
- my $str = sprintf "\t%-35s %8s\n", $mod->module, $version;
- msg($str,$verbose);
- }
-
- return;
-
- ### ok, no problem, you have all needed prereqs anyway
- } else {
- return 1;
- }
- }
-
- for my $aref (@install_me) {
- my($modobj,$version) = @$aref;
-
- ### another prereq may have already installed this one...
- ### so dont ask again if the module turns out to be uptodate
- ### see bug [#11840]
- ### if either force or prereq_build are given, the prereq
- ### should be built anyway
- next if (!$force and !$prereq_build) &&
- $dist->prereq_satisfied(modobj => $modobj, version => $version);
-
- ### either we're told to ignore the prereq,
- ### or the user wants us to ask him
- if( ( $conf->get_conf('prereqs') == PREREQ_ASK and not
- $cb->_callbacks->install_prerequisite->($self, $modobj)
- )
- ) {
- msg(loc("Will not install prerequisite '%1' -- Note " .
- "that the overall install may fail due to this",
- $modobj->module), $verbose);
- next;
- }
-
- ### value set and false -- means failure ###
- if( defined $modobj->status->installed
- && !$modobj->status->installed
- ) {
- error( loc( "Prerequisite '%1' failed to install before in " .
- "this session", $modobj->module ) );
- $flag++;
- last;
- }
-
- ### part of core?
- if( $modobj->package_is_perl_core ) {
- error(loc("Prerequisite '%1' is perl-core (%2) -- not ".
- "installing that. -- Note that the overall ".
- "install may fail due to this.",
- $modobj->module, $modobj->package ) );
- next;
- }
-
- ### circular dependency code ###
- my $pending = $cb->_status->pending_prereqs || {};
-
- ### recursive dependency ###
- if ( $pending->{ $modobj->module } ) {
- error( loc( "Recursive dependency detected (%1) -- skipping",
- $modobj->module ) );
- next;
- }
-
- ### register this dependency as pending ###
- $pending->{ $modobj->module } = $modobj;
- $cb->_status->pending_prereqs( $pending );
-
- ### call $modobj->install rather than doing
- ### CPANPLUS::Dist->new and the like ourselves,
- ### since ->install will take care of fetch &&
- ### extract as well
- my $pa = $dist->status->_prepare_args || {};
- my $ca = $dist->status->_create_args || {};
- my $ia = $dist->status->_install_args || {};
-
- unless( $modobj->install( %$pa, %$ca, %$ia,
- force => $force,
- verbose => $verbose,
- format => $format,
- target => $target )
- ) {
- error(loc("Failed to install '%1' as prerequisite " .
- "for '%2'", $modobj->module, $self->module ) );
- $flag++;
- }
-
- ### unregister the pending dependency ###
- $pending->{ $modobj->module } = 0;
- $cb->_status->pending_prereqs( $pending );
-
- last if $flag;
-
- ### don't want us to install? ###
- if( $target ne TARGET_INSTALL ) {
- my $dir = $modobj->status->extract
- or error(loc("No extraction dir for '%1' found ".
- "-- weird", $modobj->module));
-
- $modobj->add_to_includepath();
-
- next;
- }
- }
-
- ### reset the $prereqs iterator, in case we bailed out early ###
- keys %$prereqs;
-
- ### chdir back to where we started
- $cb->_chdir( dir => $original_wd );
-
- return 1 unless $flag;
- return;
-}
-
-1;
-
-# Local variables:
-# c-indentation-style: bsd
-# c-basic-offset: 4
-# indent-tabs-mode: nil
-# End:
-# vim: expandtab shiftwidth=4:
+++ /dev/null
-package CPANPLUS::Dist::Autobundle;
-use deprecate;
-
-use strict;
-use warnings;
-use CPANPLUS::Error qw[error msg];
-use Params::Check qw[check];
-use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';
-use vars qw[$VERSION];
-$VERSION = "0.9135";
-
-use base qw[CPANPLUS::Dist::Base];
-
-=head1 NAME
-
-CPANPLUS::Dist::Autobundle - distribution class for installation snapshots
-
-=head1 SYNOPSIS
-
- $modobj = $cb->parse_module( module => 'file://path/to/Snapshot_XXYY.pm' );
- $modobj->install;
-
-=head1 DESCRIPTION
-
-C<CPANPLUS::Dist::Autobundle> is a distribution class for installing installation
-snapshots as created by C<CPANPLUS>' C<autobundle> command.
-
-All modules as mentioned in the snapshot will be installed on your system.
-
-=cut
-
-sub init {
- my $dist = shift;
- my $status = $dist->status;
-
- $status->mk_accessors(
- qw[prepared created installed _prepare_args _create_args _install_args]
- );
-
- return 1;
-}
-
-sub prepare {
- my $dist = shift;
- my %args = @_;
-
- ### store the arguments, so ->install can use them in recursive loops ###
- $dist->status->_prepare_args( \%args );
-
- return $dist->status->prepared( 1 );
-}
-
-sub create {
- my $dist = shift;
- my $self = $dist->parent;
-
- ### we're also the cpan_dist, since we don't need to have anything
- ### prepared
- $dist = $self->status->dist_cpan if $self->status->dist_cpan;
- $self->status->dist_cpan( $dist ) unless $self->status->dist_cpan;
-
- my $cb = $self->parent;
- my $conf = $cb->configure_object;
- my %hash = @_;
-
- my( $force, $verbose, $prereq_target, $prereq_format, $prereq_build);
-
- my $args = do {
- local $Params::Check::ALLOW_UNKNOWN = 1;
- my $tmpl = {
- force => { default => $conf->get_conf('force'),
- store => \$force },
- verbose => { default => $conf->get_conf('verbose'),
- store => \$verbose },
- prereq_target => { default => '', store => \$prereq_target },
-
- ### don't set the default prereq format to 'makemaker' -- wrong!
- prereq_format => { #default => $self->status->installer_type,
- default => '',
- store => \$prereq_format },
- prereq_build => { default => 0, store => \$prereq_build },
- };
-
- check( $tmpl, \%hash ) or return;
- };
-
- ### maybe we already ran a create on this object? ###
- return 1 if $dist->status->created && !$force;
-
- ### store the arguments, so ->install can use them in recursive loops ###
- $dist->status->_create_args( \%hash );
-
- msg(loc("Resolving prerequisites mentioned in the bundle"), $verbose);
-
- ### this will set the directory back to the start
- ### dir, so we must chdir /again/
- my $ok = $dist->_resolve_prereqs(
- format => $prereq_format,
- verbose => $verbose,
- prereqs => $self->status->prereqs,
- target => $prereq_target,
- force => $force,
- prereq_build => $prereq_build,
- );
-
- ### if all went well, mark it & return
- return $dist->status->created( $ok ? 1 : 0);
-}
-
-sub install {
- my $dist = shift;
- my %args = @_;
-
- ### store the arguments, so ->install can use them in recursive loops ###
- $dist->status->_install_args( \%args );
-
- return $dist->status->installed( 1 );
-}
-
-1;
+++ /dev/null
-package CPANPLUS::Dist::Base;
-use deprecate;
-
-use strict;
-
-use base qw[CPANPLUS::Dist];
-use vars qw[$VERSION];
-$VERSION = "0.9135";
-
-=head1 NAME
-
-CPANPLUS::Dist::Base - Base class for custom distribution classes
-
-=head1 SYNOPSIS
-
- package CPANPLUS::Dist::MY_IMPLEMENTATION
-
- use base 'CPANPLUS::Dist::Base';
-
- sub prepare {
- my $dist = shift;
-
- ### do the 'standard' things
- $dist->SUPER::prepare( @_ ) or return;
-
- ### do MY_IMPLEMENTATION specific things
- ...
-
- ### don't forget to set the status!
- return $dist->status->prepared( $SUCCESS ? 1 : 0 );
- }
-
-
-=head1 DESCRIPTION
-
-CPANPLUS::Dist::Base functions as a base class for all custom
-distribution implementations. It does all the mundane work
-CPANPLUS would have done without a custom distribution, so you
-can override just the parts you need to make your own implementation
-work.
-
-=head1 FLOW
-
-Below is a brief outline when and in which order methods in this
-class are called:
-
- $Class->format_available; # can we use this class on this system?
-
- $dist->init; # set up custom accessors, etc
- $dist->prepare; # find/write meta information
- $dist->create; # write the distribution file
- $dist->install; # install the distribution file
-
- $dist->uninstall; # remove the distribution (OPTIONAL)
-
-=head1 METHODS
-
-=cut
-
-=head2 @subs = $Class->methods
-
-Returns a list of methods that this class implements that you can
-override.
-
-=cut
-
-sub methods {
- return qw[format_available init prepare create install uninstall]
-}
-
-=head2 $bool = $Class->format_available
-
-This method is called when someone requests a module to be installed
-via the superclass. This gives you the opportunity to check if all
-the needed requirements to build and install this distribution have
-been met.
-
-For example, you might need a command line program, or a certain perl
-module installed to do your job. Now is the time to check.
-
-Simply return true if the request can proceed and false if it can not.
-
-The C<CPANPLUS::Dist::Base> implementation always returns true.
-
-=cut
-
-sub format_available { return 1 }
-
-
-=head2 $bool = $dist->init
-
-This method is called just after the new dist object is set up and
-before the C<prepare> method is called. This is the time to set up
-the object so it can be used with your class.
-
-For example, you might want to add extra accessors to the C<status>
-object, which you might do as follows:
-
- $dist->status->mk_accessors( qw[my_implementation_accessor] );
-
-The C<status> object is implemented as an instance of the
-C<Object::Accessor> class. Please refer to its documentation for
-details.
-
-Return true if the initialization was successful, and false if it was
-not.
-
-The C<CPANPLUS::Dist::Base> implementation does not alter your object
-and always returns true.
-
-=cut
-
-sub init { return 1; }
-
-=head2 $bool = $dist->prepare
-
-This runs the preparation step of your distribution. This step is meant
-to set up the environment so the C<create> step can create the actual
-distribution(file).
-A C<prepare> call in the standard C<ExtUtils::MakeMaker> distribution
-would, for example, run C<perl Makefile.PL> to find the dependencies
-for a distribution. For a C<debian> distribution, this is where you
-would write all the metafiles required for the C<dpkg-*> tools.
-
-The C<CPANPLUS::Dist::Base> implementation simply calls the underlying
-distribution class (Typically C<CPANPLUS::Dist::MM> or
-C<CPANPLUS::Dist::Build>).
-
-Sets C<< $dist->status->prepared >> to the return value of this function.
-If you override this method, you should make sure to set this value.
-
-=cut
-
-sub prepare {
- ### just in case you already did a create call for this module object
- ### just via a different dist object
- my $dist = shift;
- my $self = $dist->parent;
- my $dist_cpan = $self->status->dist_cpan;
-
- my $cb = $self->parent;
- my $conf = $cb->configure_object;
-
- $dist->status->prepared( $dist_cpan->prepare( @_ ) );
-}
-
-=head2 $bool = $dist->create
-
-This runs the creation step of your distribution. This step is meant
-to follow up on the C<prepare> call, that set up your environment so
-the C<create> step can create the actual distribution(file).
-A C<create> call in the standard C<ExtUtils::MakeMaker> distribution
-would, for example, run C<make> and C<make test> to build and test
-a distribution. For a C<debian> distribution, this is where you
-would create the actual C<.deb> file using C<dpkg>.
-
-The C<CPANPLUS::Dist::Base> implementation simply calls the underlying
-distribution class (Typically C<CPANPLUS::Dist::MM> or
-C<CPANPLUS::Dist::Build>).
-
-Sets C<< $dist->status->dist >> to the location of the created
-distribution.
-If you override this method, you should make sure to set this value.
-
-Sets C<< $dist->status->created >> to the return value of this function.
-If you override this method, you should make sure to set this value.
-
-=cut
-
-sub create {
- ### just in case you already did a create call for this module object
- ### just via a different dist object
- my $dist = shift;
- my $self = $dist->parent;
- my $dist_cpan = $self->status->dist_cpan;
- $dist = $self->status->dist if $self->status->dist;
- $self->status->dist( $dist ) unless $self->status->dist;
-
- my $cb = $self->parent;
- my $conf = $cb->configure_object;
- my $format = ref $dist;
-
- ### make sure to set this variable, if the caller hasn't yet
- ### just so we have some clue where the dist left off.
- $dist->status->dist( $dist_cpan->status->distdir )
- unless defined $dist->status->dist;
-
- $dist->status->created( $dist_cpan->create(prereq_format => $format, @_) );
-}
-
-=head2 $bool = $dist->install
-
-This runs the install step of your distribution. This step is meant
-to follow up on the C<create> call, which prepared a distribution(file)
-to install.
-A C<create> call in the standard C<ExtUtils::MakeMaker> distribution
-would, for example, run C<make install> to copy the distribution files
-to their final destination. For a C<debian> distribution, this is where
-you would run C<dpkg --install> on the created C<.deb> file.
-
-The C<CPANPLUS::Dist::Base> implementation simply calls the underlying
-distribution class (Typically C<CPANPLUS::Dist::MM> or
-C<CPANPLUS::Dist::Build>).
-
-Sets C<< $dist->status->installed >> to the return value of this function.
-If you override this method, you should make sure to set this value.
-
-=cut
-
-sub install {
- ### just in case you already did a create call for this module object
- ### just via a different dist object
- my $dist = shift;
- my $self = $dist->parent;
- my $dist_cpan = $self->status->dist_cpan;
-
- my $cb = $self->parent;
- my $conf = $cb->configure_object;
-
- $dist->status->installed( $dist_cpan->install( @_ ) );
-}
-
-=head2 $bool = $dist->uninstall
-
-This runs the uninstall step of your distribution. This step is meant
-to remove the distribution from the file system.
-A C<uninstall> call in the standard C<ExtUtils::MakeMaker> distribution
-would, for example, run C<make uninstall> to remove the distribution
-files the file system. For a C<debian> distribution, this is where you
-would run C<dpkg --uninstall PACKAGE>.
-
-The C<CPANPLUS::Dist::Base> implementation simply calls the underlying
-distribution class (Typically C<CPANPLUS::Dist::MM> or
-C<CPANPLUS::Dist::Build>).
-
-Sets C<< $dist->status->uninstalled >> to the return value of this function.
-If you override this method, you should make sure to set this value.
-
-=cut
-
-sub uninstall {
- ### just in case you already did a create call for this module object
- ### just via a different dist object
- my $dist = shift;
- my $self = $dist->parent;
- my $dist_cpan = $self->status->dist_cpan;
-
- my $cb = $self->parent;
- my $conf = $cb->configure_object;
-
- $dist->status->uninstalled( $dist_cpan->uninstall( @_ ) );
-}
-
-1;
-
-# Local variables:
-# c-indentation-style: bsd
-# c-basic-offset: 4
-# indent-tabs-mode: nil
-# End:
-# vim: expandtab shiftwidth=4:
+++ /dev/null
-package CPANPLUS::Dist::MM;
-use deprecate;
-
-use strict;
-use warnings;
-use vars qw[@ISA $STATUS $VERSION];
-use base 'CPANPLUS::Dist::Base';
-$VERSION = "0.9135";
-
-use CPANPLUS::Internals::Constants;
-use CPANPLUS::Internals::Constants::Report;
-use CPANPLUS::Error;
-use FileHandle;
-use Cwd;
-
-use IPC::Cmd qw[run];
-use Params::Check qw[check];
-use File::Basename qw[dirname];
-use Module::Load::Conditional qw[can_load check_install];
-use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';
-
-local $Params::Check::VERBOSE = 1;
-
-=pod
-
-=head1 NAME
-
-CPANPLUS::Dist::MM - distribution class for MakeMaker related modules
-
-=head1 SYNOPSIS
-
- $mm = CPANPLUS::Dist::MM->new( module => $modobj );
-
- $mm->create; # runs make && make test
- $mm->install; # runs make install
-
-
-=head1 DESCRIPTION
-
-C<CPANPLUS::Dist::MM> is a distribution class for MakeMaker related
-modules.
-Using this package, you can create, install and uninstall perl
-modules. It inherits from C<CPANPLUS::Dist>.
-
-=head1 ACCESSORS
-
-=over 4
-
-=item parent()
-
-Returns the C<CPANPLUS::Module> object that parented this object.
-
-=item status()
-
-Returns the C<Object::Accessor> object that keeps the status for
-this module.
-
-=back
-
-=head1 STATUS ACCESSORS
-
-All accessors can be accessed as follows:
- $mm->status->ACCESSOR
-
-=over 4
-
-=item makefile ()
-
-Location of the Makefile (or Build file).
-Set to 0 explicitly if something went wrong.
-
-=item make ()
-
-BOOL indicating if the C<make> (or C<Build>) command was successful.
-
-=item test ()
-
-BOOL indicating if the C<make test> (or C<Build test>) command was
-successful.
-
-=item prepared ()
-
-BOOL indicating if the C<prepare> call exited successfully
-This gets set after C<perl Makefile.PL>
-
-=item distdir ()
-
-Full path to the directory in which the C<prepare> call took place,
-set after a call to C<prepare>.
-
-=item created ()
-
-BOOL indicating if the C<create> call exited successfully. This gets
-set after C<make> and C<make test>.
-
-=item installed ()
-
-BOOL indicating if the module was installed. This gets set after
-C<make install> (or C<Build install>) exits successfully.
-
-=item uninstalled ()
-
-BOOL indicating if the module was uninstalled properly.
-
-=item _create_args ()
-
-Storage of the arguments passed to C<create> for this object. Used
-for recursive calls when satisfying prerequisites.
-
-=item _install_args ()
-
-Storage of the arguments passed to C<install> for this object. Used
-for recursive calls when satisfying prerequisites.
-
-=back
-
-=cut
-
-=head1 METHODS
-
-=head2 $bool = $dist->format_available();
-
-Returns a boolean indicating whether or not you can use this package
-to create and install modules in your environment.
-
-=cut
-
-### check if the format is available ###
-sub format_available {
- my $dist = shift;
-
- ### we might be called as $class->format_available =/
- require CPANPLUS::Internals;
- my $cb = CPANPLUS::Internals->_retrieve_id(
- CPANPLUS::Internals->_last_id );
- my $conf = $cb->configure_object;
-
- my $mod = "ExtUtils::MakeMaker";
- unless( can_load( modules => { $mod => 0.0 } ) ) {
- error( loc( "You do not have '%1' -- '%2' not available",
- $mod, __PACKAGE__ ) );
- return;
- }
-
- for my $pgm ( qw[make] ) {
- unless( $conf->get_program( $pgm ) ) {
- error(loc(
- "You do not have '%1' in your path -- '%2' not available\n" .
- "Please check your config entry for '%1'",
- $pgm, __PACKAGE__ , $pgm
- ));
- return;
- }
- }
-
- return 1;
-}
-
-=pod
-
-=head2 $bool = $dist->init();
-
-Sets up the C<CPANPLUS::Dist::MM> object for use.
-Effectively creates all the needed status accessors.
-
-Called automatically whenever you create a new C<CPANPLUS::Dist> object.
-
-=cut
-
-sub init {
- my $dist = shift;
- my $status = $dist->status;
-
- $status->mk_accessors(qw[makefile make test created installed uninstalled
- bin_make _prepare_args _create_args _install_args]
- );
-
- return 1;
-}
-
-=pod
-
-=head2 $bool = $dist->prepare([perl => '/path/to/perl', makemakerflags => 'EXTRA=FLAGS', force => BOOL, verbose => BOOL])
-
-C<prepare> preps a distribution for installation. This means it will
-run C<perl Makefile.PL> and determine what prerequisites this distribution
-declared.
-
-If you set C<force> to true, it will go over all the stages of the
-C<prepare> process again, ignoring any previously cached results.
-
-When running C<perl Makefile.PL>, the environment variable
-C<PERL5_CPANPLUS_IS_EXECUTING> will be set to the full path of the
-C<Makefile.PL> that is being executed. This enables any code inside
-the C<Makefile.PL> to know that it is being installed via CPANPLUS.
-
-Returns true on success and false on failure.
-
-You may then call C<< $dist->create >> on the object to create the
-installable files.
-
-=cut
-
-sub prepare {
- ### just in case you already did a create call for this module object
- ### just via a different dist object
- my $dist = shift;
- my $self = $dist->parent;
-
- ### we're also the cpan_dist, since we don't need to have anything
- ### prepared
- $dist = $self->status->dist_cpan if $self->status->dist_cpan;
- $self->status->dist_cpan( $dist ) unless $self->status->dist_cpan;
-
- my $cb = $self->parent;
- my $conf = $cb->configure_object;
- my %hash = @_;
-
- my $dir;
- unless( $dir = $self->status->extract ) {
- error( loc( "No dir found to operate on!" ) );
- return;
- }
-
- my $args;
- my( $force, $verbose, $perl, $mmflags, $prereq_target, $prereq_format,
- $prereq_build );
- { local $Params::Check::ALLOW_UNKNOWN = 1;
- my $tmpl = {
- perl => { default => $^X, store => \$perl },
- makemakerflags => { default =>
- $conf->get_conf('makemakerflags') || '',
- store => \$mmflags },
- force => { default => $conf->get_conf('force'),
- store => \$force },
- verbose => { default => $conf->get_conf('verbose'),
- store => \$verbose },
- prereq_target => { default => '', store => \$prereq_target },
- prereq_format => { default => '',
- store => \$prereq_format },
- prereq_build => { default => 0, store => \$prereq_build },
- };
-
- $args = check( $tmpl, \%hash ) or return;
- }
-
- my @mmflags = $dist->_split_like_shell( $mmflags );
-
- ### maybe we already ran a create on this object? ###
- return 1 if $dist->status->prepared && !$force;
-
- ### store the arguments, so ->install can use them in recursive loops ###
- $dist->status->_prepare_args( $args );
-
- ### chdir to work directory ###
- my $orig = cwd();
- unless( $cb->_chdir( dir => $dir ) ) {
- error( loc( "Could not chdir to build directory '%1'", $dir ) );
- return;
- }
-
- my $fail;
- RUN: {
-
- ### we resolve 'configure requires' here, so we can run the 'perl
- ### Makefile.PL' command
- ### XXX for tests: mock f_c_r to something that *can* resolve and
- ### something that *doesn't* resolve. Check the error log for ok
- ### on this step or failure
- ### XXX make a separate tarball to test for this scenario: simply
- ### containing a makefile.pl/build.pl for test purposes?
- { my $configure_requires = $dist->find_configure_requires;
- my $ok = $dist->_resolve_prereqs(
- format => $prereq_format,
- verbose => $verbose,
- prereqs => $configure_requires,
- target => $prereq_target,
- force => $force,
- prereq_build => $prereq_build,
- );
-
- unless( $ok ) {
-
- #### use $dist->flush to reset the cache ###
- error( loc( "Unable to satisfy '%1' for '%2' " .
- "-- aborting install",
- 'configure_requires', $self->module ) );
- $dist->status->prepared(0);
- $fail++;
- last RUN;
- }
- ### end of prereq resolving ###
- }
-
-
-
- ### don't run 'perl makefile.pl' again if there's a makefile already
- if( -e MAKEFILE->() && (-M MAKEFILE->() < -M $dir) && !$force ) {
- msg(loc("'%1' already exists, not running '%2 %3' again ".
- " unless you force",
- MAKEFILE->(), $perl, MAKEFILE_PL->() ), $verbose );
-
- } else {
- unless( -e MAKEFILE_PL->() ) {
- msg(loc("No '%1' found - attempting to generate one",
- MAKEFILE_PL->() ), $verbose );
-
- $dist->write_makefile_pl(
- verbose => $verbose,
- force => $force
- );
-
- ### bail out if there's no makefile.pl ###
- unless( -e MAKEFILE_PL->() ) {
- error( loc( "Could not find '%1' - cannot continue",
- MAKEFILE_PL->() ) );
-
- ### mark that we screwed up ###
- $dist->status->makefile(0);
- $fail++; last RUN;
- }
- }
-
- ### you can turn off running this verbose by changing
- ### the config setting below, although it is really not
- ### recommended
- my $run_verbose = $verbose ||
- $conf->get_conf('allow_build_interactivity') ||
- 0;
-
- ### this makes MakeMaker use defaults if possible, according
- ### to schwern. See ticket 8047 for details.
- local $ENV{PERL_MM_USE_DEFAULT} = 1 unless $run_verbose;
-
- ### turn off our PERL5OPT so no modules from CPANPLUS::inc get
- ### included in the makefile.pl -- it should build without
- ### also, modules that run in taint mode break if we leave
- ### our code ref in perl5opt
- ### XXX we've removed the ENV settings from cp::inc, so only need
- ### to reset the @INC
- #local $ENV{PERL5OPT} = CPANPLUS::inc->original_perl5opt || '';
-
- ### make sure it's a string, so that mmflags that have more than
- ### one key value pair are passed as is, rather than as:
- ### perl Makefile.PL "key=val key=>val"
-
-
- #### XXX this needs to be the absolute path to the Makefile.PL
- ### since cpanp-run-perl uses 'do' to execute the file, and do()
- ### checks your @INC.. so, if there's _another_ makefile.pl in
- ### your @INC, it will execute that one...
- my $makefile_pl = MAKEFILE_PL->( $cb->_safe_path( path => $dir ) );
-
- ### setting autoflush to true fixes issue from rt #8047
- ### XXX this means that we need to keep the path to CPANPLUS
- ### in @INC, stopping us from resolving dependencies on CPANPLUS
- ### at bootstrap time properly.
-
- my @run_perl = ( '-e', PERL_WRAPPER );
- my $cmd = [$perl, @run_perl, $makefile_pl, @mmflags];
-
- ### set ENV var to tell underlying code this is what we're
- ### executing.
- my $captured;
- my $rv = do {
- my $env = ENV_CPANPLUS_IS_EXECUTING;
- local $ENV{$env} = $makefile_pl;
- scalar run( command => $cmd,
- buffer => \$captured,
- verbose => $run_verbose, # may be interactive
- );
- };
-
- unless( $rv ) {
- error( loc( "Could not run '%1 %2': %3 -- cannot continue",
- $perl, MAKEFILE_PL->(), $captured ) );
-
- $dist->status->makefile(0);
- $fail++; last RUN;
- }
-
- ### put the output on the stack, don't print it
- msg( $captured, 0 );
- }
-
- ### so, nasty feature in Module::Build, that when a Makefile.PL
- ### is a disguised Build.PL, it generates a Build file, not a
- ### Makefile. this breaks everything :( see rt bug #19741
- if( not -e MAKEFILE->( $dir ) and -e BUILD_PL->( $dir ) ) {
- error(loc(
- "We just ran '%1' without errors, but no '%2' is ".
- "present. However, there is a '%3' file, so this may ".
- "be related to bug #19741 in %4, which describes a ".
- "fake '%5' which generates a '%6' file instead of a '%7'. ".
- "You could try to work around this issue by setting '%8' ".
- "to false and trying again. This will attempt to use the ".
- "'%9' instead.",
- "$^X ".MAKEFILE_PL->(), MAKEFILE->(), BUILD_PL->(),
- 'Module::Build', MAKEFILE_PL->(), 'Build', MAKEFILE->(),
- 'prefer_makefile', BUILD_PL->()
- ));
-
- $fail++, last RUN;
- }
-
- ### if we got here, we managed to make a 'makefile' ###
- $dist->status->makefile( MAKEFILE->($dir) );
-
- ### Make (haha) sure that Makefile.PL is older than the Makefile
- ### we just generated.
- eval {
- my $makestat = ( stat MAKEFILE->( $dir ) )[9];
- my $mplstat = ( stat MAKEFILE_PL->( $cb->_safe_path( path => $dir ) ) )[9];
- if ( $makestat < $mplstat ) {
- my $ftime = $makestat - 60;
- utime $ftime, $ftime, MAKEFILE_PL->( $cb->_safe_path( path => $dir ) );
- }
- };
-
- ### start resolving prereqs ###
- my $prereqs = $self->status->prereqs;
-
- ### a hashref of prereqs on success, undef on failure ###
- $prereqs ||= $dist->_find_prereqs(
- verbose => $verbose,
- file => $dist->status->makefile
- );
-
- unless( $prereqs ) {
- error( loc( "Unable to scan '%1' for prereqs",
- $dist->status->makefile ) );
-
- $fail++; last RUN;
- }
- }
-
- unless( $cb->_chdir( dir => $orig ) ) {
- error( loc( "Could not chdir back to start dir '%1'", $orig ) );
- }
-
- ### save where we wrote this stuff -- same as extract dir in normal
- ### installer circumstances
- $dist->status->distdir( $self->status->extract );
-
- return $dist->status->prepared( $fail ? 0 : 1);
-}
-
-=pod
-
-=head2 $href = $dist->_find_prereqs( file => '/path/to/Makefile', [verbose => BOOL])
-
-Parses a C<Makefile> for C<PREREQ_PM> entries and distills from that
-any prerequisites mentioned in the C<Makefile>
-
-Returns a hash with module-version pairs on success and false on
-failure.
-
-=cut
-
-sub _find_prereqs {
- my $dist = shift;
- my $self = $dist->parent;
- my $cb = $self->parent;
- my $conf = $cb->configure_object;
- my %hash = @_;
-
- my ($verbose, $file);
- my $tmpl = {
- verbose => { default => $conf->get_conf('verbose'), store => \$verbose },
- file => { required => 1, allow => FILE_READABLE, store => \$file },
- };
-
- my $args = check( $tmpl, \%hash ) or return;
-
- ### see if we got prereqs from MYMETA
- my $prereqs = $dist->find_mymeta_requires();
-
- ### we found some prereqs, we'll trust MYMETA
- ### but we do need to run it through the callback
- return $cb->_callbacks->filter_prereqs->( $cb, $prereqs ) if keys %$prereqs;
-
- my $fh = FileHandle->new();
- unless( $fh->open( $file ) ) {
- error( loc( "Cannot open '%1': %2", $file, $! ) );
- return;
- }
-
- my %p;
- while( local $_ = <$fh> ) {
- my ($found) = m|^[\#]\s+PREREQ_PM\s+=>\s+(.+)|;
-
- next unless $found;
-
- while( $found =~ m/(?:\s)([\w\:]+)=>(?:q\[(.*?)\],?|undef)/g ) {
- if( defined $p{$1} ) {
- my $ver = $cb->_version_to_number(version => $2);
- $p{$1} = $ver
- if $cb->_vcmp( $ver, $p{$1} ) > 0;
- }
- else {
- $p{$1} = $cb->_version_to_number(version => $2);
- }
- }
- last;
- }
-
- my $href = $cb->_callbacks->filter_prereqs->( $cb, \%p );
-
- $self->status->prereqs( $href );
-
- ### just to make sure it's not the same reference ###
- return { %$href };
-}
-
-=pod
-
-=head2 $bool = $dist->create([perl => '/path/to/perl', make => '/path/to/make', makeflags => 'EXTRA=FLAGS', prereq_target => TARGET, skiptest => BOOL, force => BOOL, verbose => BOOL])
-
-C<create> creates the files necessary for installation. This means
-it will run C<make> and C<make test>. This will also scan for and
-attempt to satisfy any prerequisites the module may have.
-
-If you set C<skiptest> to true, it will skip the C<make test> stage.
-If you set C<force> to true, it will go over all the stages of the
-C<make> process again, ignoring any previously cached results. It
-will also ignore a bad return value from C<make test> and still allow
-the operation to return true.
-
-Returns true on success and false on failure.
-
-You may then call C<< $dist->install >> on the object to actually
-install it.
-
-=cut
-
-sub create {
- ### just in case you already did a create call for this module object
- ### just via a different dist object
- my $dist = shift;
- my $self = $dist->parent;
-
- ### we're also the cpan_dist, since we don't need to have anything
- ### prepared
- $dist = $self->status->dist_cpan if $self->status->dist_cpan;
- $self->status->dist_cpan( $dist ) unless $self->status->dist_cpan;
-
- my $cb = $self->parent;
- my $conf = $cb->configure_object;
- my %hash = @_;
-
- my $dir;
- unless( $dir = $self->status->extract ) {
- error( loc( "No dir found to operate on!" ) );
- return;
- }
-
- my $args;
- my( $force, $verbose, $make, $makeflags, $skiptest, $prereq_target, $perl,
- @mmflags, $prereq_format, $prereq_build);
- { local $Params::Check::ALLOW_UNKNOWN = 1;
- my $tmpl = {
- perl => { default => $^X, store => \$perl },
- force => { default => $conf->get_conf('force'),
- store => \$force },
- verbose => { default => $conf->get_conf('verbose'),
- store => \$verbose },
- make => { default => $conf->get_program('make'),
- store => \$make },
- makeflags => { default => $conf->get_conf('makeflags'),
- store => \$makeflags },
- skiptest => { default => $conf->get_conf('skiptest'),
- store => \$skiptest },
- prereq_target => { default => '', store => \$prereq_target },
- ### don't set the default prereq format to 'makemaker' -- wrong!
- prereq_format => { #default => $self->status->installer_type,
- default => '',
- store => \$prereq_format },
- prereq_build => { default => 0, store => \$prereq_build },
- };
-
- $args = check( $tmpl, \%hash ) or return;
- }
-
- my @makeflags = $dist->_split_like_shell( $makeflags );
-
- ### maybe we already ran a create on this object?
- ### make sure we add to include path again, just in case we came from
- ### ->save_state, at which point we need to restore @INC/$PERL5LIB
- if( $dist->status->created && !$force ) {
- $self->add_to_includepath;
- return 1;
- }
-
- ### store the arguments, so ->install can use them in recursive loops ###
- $dist->status->_create_args( $args );
-
- unless( $dist->status->prepared ) {
- error( loc( "You have not successfully prepared a '%2' distribution ".
- "yet -- cannot create yet", __PACKAGE__ ) );
- return;
- }
-
-
- ### chdir to work directory ###
- my $orig = cwd();
- unless( $cb->_chdir( dir => $dir ) ) {
- error( loc( "Could not chdir to build directory '%1'", $dir ) );
- return;
- }
-
- my $fail; my $prereq_fail; my $test_fail;
- my $status = { };
- RUN: {
- ### this will set the directory back to the start
- ### dir, so we must chdir /again/
- my $ok = $dist->_resolve_prereqs(
- format => $prereq_format,
- verbose => $verbose,
- prereqs => $self->status->prereqs,
- target => $prereq_target,
- force => $force,
- prereq_build => $prereq_build,
- );
-
- unless( $cb->_chdir( dir => $dir ) ) {
- error( loc( "Could not chdir to build directory '%1'", $dir ) );
- return;
- }
-
- unless( $ok ) {
-
- #### use $dist->flush to reset the cache ###
- error( loc( "Unable to satisfy prerequisites for '%1' " .
- "-- aborting install", $self->module ) );
- $dist->status->make(0);
- $fail++; $prereq_fail++;
- last RUN;
- }
- ### end of prereq resolving ###
-
- my $captured;
-
- ### 'make' section ###
- if( -d BLIB->($dir) && (-M BLIB->($dir) < -M $dir) && !$force ) {
- msg(loc("Already ran '%1' for this module [%2] -- " .
- "not running again unless you force",
- $make, $self->module ), $verbose );
- } else {
- unless(scalar run( command => [$make, @makeflags],
- buffer => \$captured,
- verbose => $verbose )
- ) {
- error( loc( "MAKE failed: %1 %2", $!, $captured ) );
- if ( $conf->get_conf('cpantest') ) {
- $status->{stage} = 'build';
- $status->{capture} = $captured;
- }
- $dist->status->make(0);
- $fail++; last RUN;
- }
-
- ### put the output on the stack, don't print it
- msg( $captured, 0 );
-
- $dist->status->make(1);
-
- ### add this directory to your lib ###
- $self->add_to_includepath();
-
- ### dont bail out here, there's a conditional later on
- #last RUN if $skiptest;
- }
-
- ### 'make test' section ###
- unless( $skiptest ) {
-
- ### turn off our PERL5OPT so no modules from CPANPLUS::inc get
- ### included in make test -- it should build without
- ### also, modules that run in taint mode break if we leave
- ### our code ref in perl5opt
- ### XXX CPANPLUS::inc functionality is now obsolete.
- #local $ENV{PERL5OPT} = CPANPLUS::inc->original_perl5opt || '';
-
- ### you can turn off running this verbose by changing
- ### the config setting below, although it is really not
- ### recommended
- my $run_verbose =
- $verbose ||
- $conf->get_conf('allow_build_interactivity') ||
- 0;
-
- ### XXX need to add makeflags here too?
- ### yes, but they should really be split out -- see bug #4143
- if( scalar run(
- command => [$make, 'test', @makeflags],
- buffer => \$captured,
- verbose => $run_verbose,
- ) ) {
- ### tests might pass because it doesn't have any tests defined
- ### log this occasion non-verbosely, so our test reporter can
- ### pick up on this
- if ( NO_TESTS_DEFINED->( $captured ) ) {
- msg( NO_TESTS_DEFINED->( $captured ), 0 )
- } else {
- msg( loc( "MAKE TEST passed: %1", $captured ), 0 );
- }
-
- if ( $conf->get_conf('cpantest') ) {
- $status->{stage} = 'test';
- $status->{capture} = $captured;
- }
-
- $dist->status->test(1);
- } else {
- error( loc( "MAKE TEST failed: %1", $captured ), ( $run_verbose ? 0 : 1 ) );
-
- if ( $conf->get_conf('cpantest') ) {
- $status->{stage} = 'test';
- $status->{capture} = $captured;
- }
-
- ### send out error report here? or do so at a higher level?
- ### --higher level --kane.
- $dist->status->test(0);
-
- ### mark specifically *test* failure.. so we dont
- ### send success on force...
- $test_fail++;
-
- if( !$force and !$cb->_callbacks->proceed_on_test_failure->(
- $self, $captured )
- ) {
- $fail++; last RUN;
- }
- }
- }
- } #</RUN>
-
- unless( $cb->_chdir( dir => $orig ) ) {
- error( loc( "Could not chdir back to start dir '%1'", $orig ) );
- }
-
- ### TODO: Add $stage to _send_report()
- ### send out test report?
- ### only do so if the failure is this module, not its prereq
- if( $conf->get_conf('cpantest') and not $prereq_fail) {
- $cb->_send_report(
- module => $self,
- failed => $test_fail || $fail,
- buffer => CPANPLUS::Error->stack_as_string,
- status => $status,
- verbose => $verbose,
- force => $force,
- ) or error(loc("Failed to send test report for '%1'",
- $self->module ) );
- }
-
- return $dist->status->created( $fail ? 0 : 1);
-}
-
-=pod
-
-=head2 $bool = $dist->install([make => '/path/to/make', makemakerflags => 'EXTRA=FLAGS', force => BOOL, verbose => BOOL])
-
-C<install> runs the following command:
- make install
-
-Returns true on success, false on failure.
-
-=cut
-
-sub install {
-
- ### just in case you did the create with ANOTHER dist object linked
- ### to the same module object
- my $dist = shift();
- my $self = $dist->parent;
- $dist = $self->status->dist_cpan if $self->status->dist_cpan;
-
- my $cb = $self->parent;
- my $conf = $cb->configure_object;
- my %hash = @_;
-
-
- unless( $dist->status->created ) {
- error(loc("You have not successfully created a '%2' distribution yet " .
- "-- cannot install yet", __PACKAGE__ ));
- return;
- }
-
- my $dir;
- unless( $dir = $self->status->extract ) {
- error( loc( "No dir found to operate on!" ) );
- return;
- }
-
- my $args;
- my($force,$verbose,$make,$makeflags);
- { local $Params::Check::ALLOW_UNKNOWN = 1;
- my $tmpl = {
- force => { default => $conf->get_conf('force'),
- store => \$force },
- verbose => { default => $conf->get_conf('verbose'),
- store => \$verbose },
- make => { default => $conf->get_program('make'),
- store => \$make },
- makeflags => { default => $conf->get_conf('makeflags'),
- store => \$makeflags },
- };
-
- $args = check( $tmpl, \%hash ) or return;
- }
-
- ### value set and false -- means failure ###
- if( defined $self->status->installed &&
- !$self->status->installed && !$force
- ) {
- error( loc( "Module '%1' has failed to install before this session " .
- "-- aborting install", $self->module ) );
- return;
- }
-
- my @makeflags = $dist->_split_like_shell( $makeflags );
-
- $dist->status->_install_args( $args );
-
- my $orig = cwd();
- unless( $cb->_chdir( dir => $dir ) ) {
- error( loc( "Could not chdir to build directory '%1'", $dir ) );
- return;
- }
-
- my $fail; my $captured;
-
- ### 'make install' section ###
- ### XXX need makeflags here too?
- ### yes, but they should really be split out.. see bug #4143
- my $cmd = [$make, 'install', @makeflags];
- my $sudo = $conf->get_program('sudo');
- unshift @$cmd, $sudo if $sudo and $>;
-
- $cb->flush('lib');
- unless(scalar run( command => $cmd,
- verbose => $verbose,
- buffer => \$captured,
- ) ) {
- error( loc( "MAKE INSTALL failed: %1 %2", $!, $captured ) );
- $fail++;
- }
-
- ### put the output on the stack, don't print it
- msg( $captured, 0 );
-
- unless( $cb->_chdir( dir => $orig ) ) {
- error( loc( "Could not chdir back to start dir '%1'", $orig ) );
- }
-
- return $dist->status->installed( $fail ? 0 : 1 );
-
-}
-
-=pod
-
-=head2 $bool = $dist->write_makefile_pl([force => BOOL, verbose => BOOL])
-
-This routine can write a C<Makefile.PL> from the information in a
-module object. It is used to write a C<Makefile.PL> when the original
-author forgot it (!!).
-
-Returns 1 on success and false on failure.
-
-The file gets written to the directory the module's been extracted
-to.
-
-=cut
-
-sub write_makefile_pl {
- ### just in case you already did a call for this module object
- ### just via a different dist object
- my $dist = shift;
- my $self = $dist->parent;
- $dist = $self->status->dist_cpan if $self->status->dist_cpan;
- $self->status->dist_cpan( $dist ) unless $self->status->dist_cpan;
-
- my $cb = $self->parent;
- my $conf = $cb->configure_object;
- my %hash = @_;
-
- my $dir;
- unless( $dir = $self->status->extract ) {
- error( loc( "No dir found to operate on!" ) );
- return;
- }
-
- my ($force, $verbose);
- my $tmpl = {
- force => { default => $conf->get_conf('force'),
- store => \$force },
- verbose => { default => $conf->get_conf('verbose'),
- store => \$verbose },
- };
-
- my $args = check( $tmpl, \%hash ) or return;
-
- my $file = MAKEFILE_PL->($dir);
- if( -s $file && !$force ) {
- msg(loc("Already created '%1' - not doing so again without force",
- $file ), $verbose );
- return 1;
- }
-
- ### due to a bug with AS perl 5.8.4 built 810 (and maybe others)
- ### opening files with content in them already does nasty things;
- ### seek to pos 0 and then print, but not truncating the file
- ### bug reported to activestate on 19 sep 2004:
- ### http://bugs.activestate.com/show_bug.cgi?id=34051
- unlink $file if $force;
-
- my $fh = new FileHandle;
- unless( $fh->open( ">$file" ) ) {
- error( loc( "Could not create file '%1': %2", $file, $! ) );
- return;
- }
-
- my $mf = MAKEFILE_PL->();
- my $name = $self->module;
- my $version = $self->version;
- my $author = $self->author->author;
- my $href = $self->status->prereqs;
- my $prereqs = join ",\n", map {
- (' ' x 25) . "'$_'\t=> '$href->{$_}'"
- } keys %$href;
- $prereqs ||= ''; # just in case there are none;
-
- print $fh qq|
- ### Auto-generated $mf by CPANPLUS ###
-
- use ExtUtils::MakeMaker;
-
- WriteMakefile(
- NAME => '$name',
- VERSION => '$version',
- AUTHOR => '$author',
- PREREQ_PM => {
-$prereqs
- },
- );
- \n|;
-
- $fh->close;
- return 1;
-}
-
-sub dist_dir {
- ### just in case you already did a call for this module object
- ### just via a different dist object
- my $dist = shift;
- my $self = $dist->parent;
- $dist = $self->status->dist_cpan if $self->status->dist_cpan;
- $self->status->dist_cpan( $dist ) unless $self->status->dist_cpan;
-
- my $cb = $self->parent;
- my $conf = $cb->configure_object;
- my %hash = @_;
-
- my $make; my $verbose;
- { local $Params::Check::ALLOW_UNKNOWN = 1;
- my $tmpl = {
- make => { default => $conf->get_program('make'),
- store => \$make },
- verbose => { default => $conf->get_conf('verbose'),
- store => \$verbose },
- };
-
- check( $tmpl, \%hash ) or return;
- }
-
-
- my $dir;
- unless( $dir = $self->status->extract ) {
- error( loc( "No dir found to operate on!" ) );
- return;
- }
-
- ### chdir to work directory ###
- my $orig = cwd();
- unless( $cb->_chdir( dir => $dir ) ) {
- error( loc( "Could not chdir to build directory '%1'", $dir ) );
- return;
- }
-
- my $fail; my $distdir;
- TRY: {
- $dist->prepare( @_ ) or (++$fail, last TRY);
-
-
- my $captured;
- unless(scalar run( command => [$make, 'distdir'],
- buffer => \$captured,
- verbose => $verbose )
- ) {
- error( loc( "MAKE DISTDIR failed: %1 %2", $!, $captured ) );
- ++$fail, last TRY;
- }
-
- ### /path/to/Foo-Bar-1.2/Foo-Bar-1.2
- $distdir = File::Spec->catdir( $dir, $self->package_name . '-' .
- $self->package_version );
-
- unless( -d $distdir ) {
- error(loc("Do not know where '%1' got created", 'distdir'));
- ++$fail, last TRY;
- }
- }
-
- unless( $cb->_chdir( dir => $orig ) ) {
- error( loc( "Could not chdir to start directory '%1'", $orig ) );
- return;
- }
-
- return if $fail;
- return $distdir;
-}
-
-sub _split_like_shell {
- my ($self, $string) = @_;
-
- return () unless defined($string);
- return @$string if ref $string eq 'ARRAY';
- $string =~ s/^\s+|\s+$//g;
- return () unless length($string);
-
- require Text::ParseWords;
- return Text::ParseWords::shellwords($string);
-}
-
-1;
-
-# Local variables:
-# c-indentation-style: bsd
-# c-basic-offset: 4
-# indent-tabs-mode: nil
-# End:
-# vim: expandtab shiftwidth=4:
+++ /dev/null
-package CPANPLUS::Dist::Sample;
-use deprecate;
-
-use vars qw[$VERSION];
-$VERSION = "0.9135";
-
-=pod
-
-=head1 NAME
-
-CPANPLUS::Dist::Sample -- Sample code to create your own Dist::* plugin
-
-=head1 Description.
-
-This document is B<Obsolete>. Please read the documentation and code
-in C<CPANPLUS::Dist::Base>.
-
-=cut
-
-1;
+++ /dev/null
-package CPANPLUS::Error;
-use deprecate;
-
-use strict;
-use vars qw[$VERSION];
-$VERSION = "0.9135";
-
-use Log::Message private => 0;;
-
-=pod
-
-=head1 NAME
-
-CPANPLUS::Error - error handling for CPANPLUS
-
-=head1 SYNOPSIS
-
- use CPANPLUS::Error qw[cp_msg cp_error];
-
-=head1 DESCRIPTION
-
-This module provides the error handling code for the CPANPLUS
-libraries, and is mainly intended for internal use.
-
-=head1 FUNCTIONS
-
-=head2 cp_msg("message string" [,VERBOSE])
-
-Records a message on the stack, and prints it to C<STDOUT> (or actually
-C<$MSG_FH>, see the C<GLOBAL VARIABLES> section below), if the
-C<VERBOSE> option is true.
-The C<VERBOSE> option defaults to false.
-
-=head2 msg()
-
-An alias for C<cp_msg>.
-
-=head2 cp_error("error string" [,VERBOSE])
-
-Records an error on the stack, and prints it to C<STDERR> (or actually
-C<$ERROR_FH>, see the C<GLOBAL VARIABLES> sections below), if the
-C<VERBOSE> option is true.
-The C<VERBOSE> options defaults to true.
-
-=head2 error()
-
-An alias for C<cp_error>.
-
-=head1 CLASS METHODS
-
-=head2 CPANPLUS::Error->stack()
-
-Retrieves all the items on the stack. Since C<CPANPLUS::Error> is
-implemented using C<Log::Message>, consult its manpage for the
-function C<retrieve> to see what is returned and how to use the items.
-
-=head2 CPANPLUS::Error->stack_as_string([TRACE])
-
-Returns the whole stack as a printable string. If the C<TRACE> option is
-true all items are returned with C<Carp::longmess> output, rather than
-just the message.
-C<TRACE> defaults to false.
-
-=head2 CPANPLUS::Error->flush()
-
-Removes all the items from the stack and returns them. Since
-C<CPANPLUS::Error> is implemented using C<Log::Message>, consult its
-manpage for the function C<retrieve> to see what is returned and how
-to use the items.
-
-=cut
-
-BEGIN {
- use Exporter;
- use Params::Check qw[check];
- use vars qw[@EXPORT @ISA $ERROR_FH $MSG_FH];
-
- @ISA = 'Exporter';
- @EXPORT = qw[cp_error cp_msg error msg];
-
- my $log = new Log::Message;
-
- for my $func ( @EXPORT ) {
- no strict 'refs';
-
- my $prefix = 'cp_';
- my $name = $func;
- $name =~ s/^$prefix//g;
-
- *$func = sub {
- my $msg = shift;
-
- ### no point storing non-messages
- return unless defined $msg;
-
- $log->store(
- message => $msg,
- tag => uc $name,
- level => $prefix . $name,
- extra => [@_]
- );
- };
- }
-
- sub flush {
- my @foo = $log->flush;
- return unless @foo;
- return reverse @foo;
- }
-
- sub stack {
- return $log->retrieve( chrono => 1 );
- }
-
- sub stack_as_string {
- my $class = shift;
- my $trace = shift() ? 1 : 0;
-
- return join $/, map {
- '[' . $_->tag . '] [' . $_->when . '] ' .
- ($trace ? $_->message . ' ' . $_->longmess
- : $_->message);
- } __PACKAGE__->stack;
- }
-}
-
-=head1 GLOBAL VARIABLES
-
-=over 4
-
-=item $ERROR_FH
-
-This is the filehandle all the messages sent to C<error()> are being
-printed. This defaults to C<*STDERR>.
-
-=item $MSG_FH
-
-This is the filehandle all the messages sent to C<msg()> are being
-printed. This default to C<*STDOUT>.
-
-=back
-
-=cut
-
-local $| = 1;
-$ERROR_FH = \*STDERR;
-$MSG_FH = \*STDOUT;
-
-package # Hide from Pause
- Log::Message::Handlers;
-use Carp ();
-
-{
-
- sub cp_msg {
- my $self = shift;
- my $verbose = shift;
-
- ### so you don't want us to print the msg? ###
- return if defined $verbose && $verbose == 0;
-
- my $old_fh = select $CPANPLUS::Error::MSG_FH;
-
- print '['. $self->tag . '] ' . $self->message . "\n";
- select $old_fh;
-
- return;
- }
-
- sub cp_error {
- my $self = shift;
- my $verbose = shift;
-
- ### so you don't want us to print the error? ###
- return if defined $verbose && $verbose == 0;
-
- my $old_fh = select $CPANPLUS::Error::ERROR_FH;
-
- ### is only going to be 1 for now anyway ###
- ### C::I may not be loaded, so do a can() check first
- my $cb = CPANPLUS::Internals->can('_return_all_objects')
- ? (CPANPLUS::Internals->_return_all_objects)[0]
- : undef;
-
- ### maybe we didn't initialize an internals object (yet) ###
- my $debug = $cb ? $cb->configure_object->get_conf('debug') : 0;
- my $msg = '['. $self->tag . '] ' . $self->message . "\n";
-
- ### i'm getting this warning in the test suite:
- ### Ambiguous call resolved as CORE::warn(), qualify as such or
- ### use & at CPANPLUS/Error.pm line 57.
- ### no idea where it's coming from, since there's no 'sub warn'
- ### anywhere to be found, but i'll mark it explicitly nonetheless
- ### --kane
- print $debug ? Carp::shortmess($msg) : $msg . "\n";
-
- select $old_fh;
-
- return;
- }
-}
-
-1;
-
-# Local variables:
-# c-indentation-style: bsd
-# c-basic-offset: 4
-# indent-tabs-mode: nil
-# End:
-# vim: expandtab shiftwidth=4:
+++ /dev/null
-=pod
-
-=head1 NAME
-
-CPANPLUS::FAQ - CPANPLUS Frequently Asked Questions
-
-=head1 NAME
-
-CPANPLUS::FAQ
-
-=head1 DESCRIPTION
-
-This document attempts to provide answers to commonly asked questions.
-
- XXX Work in progress
-
-=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
-
+++ /dev/null
-=pod
-
-=head1 NAME
-
-CPANPLUS::Hacking - developing CPANPLUS
-
-=head1 DESCRIPTION
-
-This document attempts to describe how to develop with the
-CPANPLUS environment most easily, how certain things work and why.
-
-This is basically a quick-start guide to people who want to add
-features or patches to CPANPLUS.
-
-=head1 OBTAINING CPANPLUS
-
-Checkout CPANPLUS from its GIT repository at
-L<https://github.com/jib/cpanplus-devel> .
-
-=head1 INSTALLING CPANPLUS
-
-CPANPLUS follows the standard perl module installation process:
-
- perl Makefile.PL
- make
- make test
- make install
-
-=head1 CONFIGURING CPANPLUS
-
-When running C<perl Makefile.PL> you will be prompted to configure.
-If you have already done so, and merely wish to update the C<Makefile>,
-simply run:
-
- perl Makefile.PL JFDI=1
-
-This will keep your configuration intact. Note however, if there are
-changes to the default configuration file C<Config.pm-orig>, you should
-either delete your current config file and reconfigure, or patch your
-config file from the new entries in C<Config.pm-orig>.
-
-=head1 RUNNING CPANPLUS FROM DEVELOPMENT ENVIRONMENT
-
-If you'd rather not install the development version to your
-C<site_perl> directory, that's no problem. You can set your C<PERL5LIB>
-environment variable to CPANPLUS' C<lib> directory, and you can run it
-from there.
-
-=head1 RUNNING CPANPLUS TESTS
-
-Tests are what tells us if CPANPLUS is working. If a test is not working,
-try to run it explicitly like this:
-
- perl -I/path/to/cpanplus/lib t/XX_name_of_test.t 1
-
-The extra '1' makes sure that all the messages and errors (they might
-be errors we're testing for!) are being printed rather than kept quiet.
-This is a great way to find out the context of any failures that may
-occur.
-
-If you believe this test failure proves a bug in CPANPLUS, the long
-output of the test file is something we'd like to see alongside your
-bug report.
-
-=head1 FINDING BUGS
-
-Sometimes you might find bugs in CPANPLUS' behaviour. If you encounter
-these in a development snapshot, we'd appreciate a complete patch (as
-described below in the L<SENDING PATCHES> section.
-
-If it's way over your head, then of course reporting the bug is always
-better than not reporting it at all. Before you do so though, make
-sure you have the B<latest> development snapshot, and the bug still
-persists there. If so, report the bug to this address:
-
- bug-cpanplus@rt.cpan.org
-
-A good C<patch> would have the following characteristics:
-
-=over 4
-
-=item Problem description
-
-Describe clearly what the bug is you found, and what it should have
-done instead.
-
-=item Program demonstrating the bug
-
-Show us how to reproduce the bug, in a simple of a program as possible
-
-=item [OPTIONAL] A patch to the test suite to test for the bug
-
-Amend our test suite by making sure this bug will be found in this, and
-future versions of CPANPLUS (see L<SUPPLYING PATCHES>)
-
-=item [OPTIONAL] A patch to the code + tests + documentation
-
-Fix the bug, update the docs & tests. That way your bug will be gone
-forever :)
-
-=back
-
-=head1 SUPPLYING PATCHES
-
-Patches are a good thing, and they are welcome. Especially if they fix
-bugs you've found along the way, or that others have reported.
-
-We prefer patches in the following format:
-
-=over 4
-
-=item * In C<diff -u> or C<diff -c> format
-
-=item * From the root of the snapshot
-
-=item * Including patches for code + tests + docs
-
-=item * Sent per mail to bug-cpanplus@rt.cpan.org
-
-=item * With subject containing C<[PATCH]> + description of the patch
-
-=back
-
-You will always be informed if a patch is applied or rejected, and in
-case of rejection why that is (perhaps you can tweak the patch to have
-it accepted after all).
-
-=cut
-
-__END__
-
-* perl5lib
-* perl t/foo 1
-* patches to cpanplus-devel
-* snap/devel.tgz
+++ /dev/null
-package CPANPLUS::Internals;
-use deprecate;
-
-### we /need/ perl5.6.1 or higher -- we use coderefs in @INC,
-### and 5.6.0 is just too buggy
-use 5.006001;
-
-use strict;
-use Config;
-
-use CPANPLUS::Error;
-
-use CPANPLUS::Selfupdate;
-
-use CPANPLUS::Internals::Extract;
-use CPANPLUS::Internals::Fetch;
-use CPANPLUS::Internals::Utils;
-use CPANPLUS::Internals::Constants;
-use CPANPLUS::Internals::Search;
-use CPANPLUS::Internals::Report;
-
-require base;
-use Cwd qw[cwd];
-use Module::Load qw[load];
-use Params::Check qw[check];
-use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';
-use Module::Load::Conditional qw[can_load];
-
-use Object::Accessor;
-
-local $Params::Check::VERBOSE = 1;
-
-use vars qw[@ISA $VERSION];
-
-@ISA = qw[
- CPANPLUS::Internals::Extract
- CPANPLUS::Internals::Fetch
- CPANPLUS::Internals::Utils
- CPANPLUS::Internals::Search
- CPANPLUS::Internals::Report
- ];
-
-$VERSION = "0.9135";
-
-=pod
-
-=head1 NAME
-
-CPANPLUS::Internals - CPANPLUS internals
-
-=head1 SYNOPSIS
-
- my $internals = CPANPLUS::Internals->_init( _conf => $conf );
- my $backend = CPANPLUS::Internals->_retrieve_id( $ID );
-
-=head1 DESCRIPTION
-
-This module is the guts of CPANPLUS -- it inherits from all other
-modules in the CPANPLUS::Internals::* namespace, thus defying normal
-rules of OO programming -- but if you're reading this, you already
-know what's going on ;)
-
-Please read the C<CPANPLUS::Backend> documentation for the normal API.
-
-=head1 ACCESSORS
-
-=over 4
-
-=item _conf
-
-Get/set the configure object
-
-=item _id
-
-Get/set the id
-
-=cut
-
-### autogenerate accessors ###
-for my $key ( qw[_conf _id _modules _hosts _methods _status _path
- _callbacks _selfupdate _mtree _atree]
-) {
- no strict 'refs';
- *{__PACKAGE__."::$key"} = sub {
- $_[0]->{$key} = $_[1] if @_ > 1;
- return $_[0]->{$key};
- }
-}
-
-=pod
-
-=back
-
-=head1 METHODS
-
-=head2 $internals = CPANPLUS::Internals->_init( _conf => CONFIG_OBJ )
-
-C<_init> creates a new CPANPLUS::Internals object.
-
-You have to pass it a valid C<CPANPLUS::Configure> object.
-
-Returns the object on success, or dies on failure.
-
-=cut
-
-{ ### NOTE:
- ### if extra callbacks are added, don't forget to update the
- ### 02-internals.t test script with them!
- my $callback_map = {
- ### name default value
- install_prerequisite => 1, # install prereqs when 'ask' is set?
- edit_test_report => 0, # edit the prepared test report?
- send_test_report => 1, # send the test report?
- # munge the test report
- munge_test_report => sub { return $_[1] },
- # filter out unwanted prereqs
- filter_prereqs => sub { return $_[1] },
- # continue if 'make test' fails?
- proceed_on_test_failure => sub { return 0 },
- munge_dist_metafile => sub { return $_[1] },
- };
-
- my $status = Object::Accessor->new;
- $status->mk_accessors(qw[pending_prereqs]);
-
- my $callback = Object::Accessor->new;
- $callback->mk_accessors(keys %$callback_map);
-
- my $conf;
- my $Tmpl = {
- _conf => { required => 1, store => \$conf,
- allow => IS_CONFOBJ },
- _id => { default => '', no_override => 1 },
- _authortree => { default => '', no_override => 1 },
- _modtree => { default => '', no_override => 1 },
- _hosts => { default => {}, no_override => 1 },
- _methods => { default => {}, no_override => 1 },
- _status => { default => '<empty>', no_override => 1 },
- _callbacks => { default => '<empty>', no_override => 1 },
- _path => { default => $ENV{PATH} || '', no_override => 1 },
- };
-
- sub _init {
- my $class = shift;
- my %hash = @_;
-
- ### temporary warning until we fix the storing of multiple id's
- ### and their serialization:
- ### probably not going to happen --kane
- if( my $id = $class->_last_id ) {
- # make it a singleton.
- warn loc(q[%1 currently only supports one %2 object per ] .
- qq[running program\n], 'CPANPLUS', $class);
-
- return $class->_retrieve_id( $id );
- }
-
- my $args = check($Tmpl, \%hash)
- or die loc(qq[Could not initialize '%1' object], $class);
-
- bless $args, $class;
-
- $args->{'_id'} = $args->_inc_id;
- $args->{'_status'} = $status;
- $args->{'_callbacks'} = $callback;
-
- ### initialize callbacks to default state ###
- for my $name ( $callback->ls_accessors ) {
- my $rv = ref $callback_map->{$name} ? 'sub return value' :
- $callback_map->{$name} ? 'true' : 'false';
-
- $args->_callbacks->$name(
- sub { msg(loc("DEFAULT '%1' HANDLER RETURNING '%2'",
- $name, $rv), $args->_conf->get_conf('debug'));
- return ref $callback_map->{$name}
- ? $callback_map->{$name}->( @_ )
- : $callback_map->{$name};
- }
- );
- }
-
- ### create a selfupdate object
- $args->_selfupdate( CPANPLUS::Selfupdate->new( $args ) );
-
- ### initialize it as an empty hashref ###
- $args->_status->pending_prereqs( {} );
-
- $conf->_set_build( startdir => cwd() ),
- or error( loc("couldn't locate current dir!") );
-
- $ENV{FTP_PASSIVE} = 1, if $conf->get_conf('passive');
-
- my $id = $args->_store_id( $args );
-
- unless ( $id == $args->_id ) {
- error( loc("IDs do not match: %1 != %2. Storage failed!",
- $id, $args->_id) );
- }
-
- ### different source engines available now, so set them here
- { my $store = $conf->get_conf( 'source_engine' )
- || DEFAULT_SOURCE_ENGINE;
-
- unless( can_load( modules => { $store => '0.0' }, verbose => 1 ) ) {
- error( loc( "Could not load source engine '%1'", $store ) );
-
- if( $store ne DEFAULT_SOURCE_ENGINE ) {
- msg( loc("Falling back to %1", DEFAULT_SOURCE_ENGINE), 1 );
-
- load DEFAULT_SOURCE_ENGINE;
-
- base->import( DEFAULT_SOURCE_ENGINE );
- } else {
- return;
- }
- } else {
- base->import( $store );
- }
- }
-
- return $args;
- }
-
-=pod
-
-=head2 $bool = $internals->_flush( list => \@caches )
-
-Flushes the designated caches from the C<CPANPLUS> object.
-
-Returns true on success, false if one or more caches could not be
-be flushed.
-
-=cut
-
- sub _flush {
- my $self = shift;
- my $conf = $self->configure_object;
- my %hash = @_;
-
- my $aref;
- my $tmpl = {
- list => { required => 1, default => [],
- strict_type => 1, store => \$aref },
- };
-
- my $args = check( $tmpl, \%hash ) or return;
-
- my $flag = 0;
- for my $what (@$aref) {
- my $cache = '_' . $what;
-
- ### set the include paths back to their original ###
- if( $what eq 'lib' ) {
- $ENV{PERL5LIB} = $conf->_perl5lib || '';
- @INC = @{$conf->_lib};
- $ENV{PATH} = $self->_path || '';
-
- ### give all modules a new status object -- this is slightly
- ### costly, but the best way to make sure all statuses are
- ### forgotten --kane
- } elsif ( $what eq 'modules' ) {
- for my $modobj ( values %{$self->module_tree} ) {
-
- $modobj->_flush;
- }
-
-
https://perl5.git.perl.org / perl5.git / commitdiff