lib/CPANPLUS.pm CPANPLUS
lib/CPANPLUS/Selfupdate.pm CPANPLUS
lib/CPANPLUS/Shell/Classic.pm CPANPLUS
+lib/CPANPLUS/Shell/Default/Plugins/CustomSource.pm CPANPLUS
lib/CPANPLUS/Shell/Default/Plugins/HOWTO.pod CPANPLUS
lib/CPANPLUS/Shell/Default/Plugins/Remote.pm CPANPLUS
lib/CPANPLUS/Shell/Default/Plugins/Source.pm CPANPLUS
lib/CPANPLUS/t/30_CPANPLUS-Internals-Selfupdate.t CPANPLUS tests
lib/CPANPLUS/t/40_CPANPLUS-Internals-Report.t CPANPLUS tests
lib/CPANPLUS/t/dummy-CPAN/authors/01mailrc.txt.gz.packed CPANPLUS tests
-lib/CPANPLUS/t/dummy-CPAN/authors/id/E/EU/EUNOXS/Bundle-Foo-Bar-0.01.tar.gz.packed CPANPLUS tests
-lib/CPANPLUS/t/dummy-CPAN/authors/id/E/EU/EUNOXS/CHECKSUMS CPANPLUS tests
-lib/CPANPLUS/t/dummy-CPAN/authors/id/E/EU/EUNOXS/Foo-Bar-0.01.readme CPANPLUS tests
-lib/CPANPLUS/t/dummy-CPAN/authors/id/E/EU/EUNOXS/Foo-Bar-0.01.tar.gz.packed CPANPLUS tests
-lib/CPANPLUS/t/dummy-CPAN/authors/id/E/EU/EUNOXS/perl5.005_03.tar.gz.packed CPANPLUS tests
-lib/CPANPLUS/t/dummy-CPAN/authors/id/E/EU/EUXS/CHECKSUMS CPANPLUS tests
-lib/CPANPLUS/t/dummy-CPAN/authors/id/E/EU/EUXS/Foo-Bar-0.01.readme CPANPLUS tests
-lib/CPANPLUS/t/dummy-CPAN/authors/id/E/EU/EUXS/Foo-Bar-0.01.tar.gz.packed CPANPLUS tests
-lib/CPANPLUS/t/dummy-CPAN/authors/id/M/MB/MBNOXS/CHECKSUMS CPANPLUS tests
-lib/CPANPLUS/t/dummy-CPAN/authors/id/M/MB/MBNOXS/Foo-Bar-0.01.readme CPANPLUS tests
-lib/CPANPLUS/t/dummy-CPAN/authors/id/M/MB/MBNOXS/Foo-Bar-0.01.tar.gz.packed CPANPLUS tests
-lib/CPANPLUS/t/dummy-CPAN/authors/id/M/MB/MBXS/CHECKSUMS CPANPLUS tests
-lib/CPANPLUS/t/dummy-CPAN/authors/id/M/MB/MBXS/Foo-Bar-0.01.readme CPANPLUS tests
-lib/CPANPLUS/t/dummy-CPAN/authors/id/M/MB/MBXS/Foo-Bar-0.01.tar.gz.packed CPANPLUS tests
+lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/Bundle-Foo-Bar-0.01.tar.gz.packed CPANPLUS tests
+lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/CHECKSUMS CPANPLUS tests
+lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/Foo-Bar-0.01.readme CPANPLUS tests
+lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/Foo-Bar-0.01.tar.gz.packed CPANPLUS tests
+lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/perl5.005_03.tar.gz.packed CPANPLUS tests
+lib/CPANPLUS/t/dummy-CPAN/authors/id/EUXS/CHECKSUMS CPANPLUS tests
+lib/CPANPLUS/t/dummy-CPAN/authors/id/EUXS/Foo-Bar-0.01.readme CPANPLUS tests
+lib/CPANPLUS/t/dummy-CPAN/authors/id/EUXS/Foo-Bar-0.01.tar.gz.packed CPANPLUS tests
+lib/CPANPLUS/t/dummy-CPAN/authors/id/MBNOXS/CHECKSUMS CPANPLUS tests
+lib/CPANPLUS/t/dummy-CPAN/authors/id/MBNOXS/Foo-Bar-0.01.readme CPANPLUS tests
+lib/CPANPLUS/t/dummy-CPAN/authors/id/MBNOXS/Foo-Bar-0.01.tar.gz.packed CPANPLUS tests
+lib/CPANPLUS/t/dummy-CPAN/authors/id/MBXS/CHECKSUMS CPANPLUS tests
+lib/CPANPLUS/t/dummy-CPAN/authors/id/MBXS/Foo-Bar-0.01.readme CPANPLUS tests
+lib/CPANPLUS/t/dummy-CPAN/authors/id/MBXS/Foo-Bar-0.01.tar.gz.packed CPANPLUS tests
lib/CPANPLUS/t/dummy-CPAN/modules/02packages.details.txt.gz.packed CPANPLUS tests
lib/CPANPLUS/t/dummy-CPAN/modules/03modlist.data.gz.packed CPANPLUS tests
lib/CPANPLUS/t/inc/conf.pl CPANPLUS tests
use vars qw( @EXPORT @ISA $VERSION );
@EXPORT = qw( shell fetch get install );
@ISA = qw( Exporter );
- $VERSION = "0.82"; #have to hardcode or cpan.org gets unhappy
+ $VERSION = "0.83_02"; #have to hardcode or cpan.org gets unhappy
}
### purely for backward compatibility, so we can call it from the commandline:
=head1 SYNOPSIS
- my $cb = CPANPLUS::Backend->new( );
+ my $cb = CPANPLUS::Backend->new;
my $conf = $cb->configure_object;
my $author = $cb->author_tree('KANE');
=pod
-=head2 $conf = $cb->configure_object ()
+=head2 $conf = $cb->configure_object;
Returns a copy of the C<CPANPLUS::Configure> object.
### 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;
}
=item index_files
-Enable/disable fetching of index files. This is ok if you don't plan
-to use the local mirror as your primary sites, or if you'd like
-up-to-date index files be fetched from elsewhere.
+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.
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 {
return $file;
}
+### XXX these wrappers are not individually tested! only the underlying
+### code through source.t and indirectly trought 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 SEE ALSO
-L<CPANPLUS::Configure>, L<CPANPLUS::Module>, L<CPANPLUS::Module::Author>
+L<CPANPLUS::Configure>, L<CPANPLUS::Module>, L<CPANPLUS::Module::Author>,
+L<CPANPLUS::Selfupdate>
=cut
'stored' => 'sourcefiles',
'dslip' => '03modlist.data.gz',
'update' => '86400',
- 'mod' => '02packages.details.txt.gz'
+ 'mod' => '02packages.details.txt.gz',
+ 'custom_index' => 'packages.txt',
},
'_build' => {
'plugins' => 'plugins',
'autobundle_prefix' => 'Snapshot',
'autdir' => 'authors',
'install_log_dir' => 'install-logs',
+ 'custom_sources' => 'custom-sources',
'sanity_check' => 1,
},
'_mirror' => {
CPANPLUS::Internals::Report
];
-$VERSION = "0.82";
+$VERSION = "0.83_02";
=pod
use CPANPLUS::Error;
+use Config;
use File::Spec;
use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';
use constant TARGET_PREPARE => 'prepare';
use constant TARGET_INSTALL => 'install';
use constant TARGET_IGNORE => 'ignore';
-use constant DOT_CPANPLUS => $^O eq 'VMS' ? '_cpanplus' : '.cpanplus';
+
+use constant ON_WIN32 => $^O eq 'MSWin32';
+use constant ON_NETWARE => $^O eq 'NetWare';
+use constant ON_CYGWIN => $^O eq 'cygwin';
+use constant ON_VMS => $^O eq 'VMS';
+
+use constant DOT_CPANPLUS => ON_VMS ? '_cpanplus' : '.cpanplus';
use constant OPT_AUTOFLUSH => '-MCPANPLUS::Internals::Utils::Autoflush';
$dir));
return;
};
-
+
+ ### On VMS, if the $Config{make} is either MMK
+ ### or MMS, then the makefile is 'DESCRIP.MMS'.
+use constant MAKEFILE => sub { my $file =
+ (ON_VMS and
+ $Config::Config{make} =~ /MM[S|K]/i)
+ ? 'DESCRIP.MMS'
+ : 'Makefile';
+
+ return @_
+ ? File::Spec->catfile( @_, $file )
+ : $file;
+ };
use constant MAKEFILE_PL => sub { return @_
? File::Spec->catfile( @_,
'Makefile.PL' )
: 'Makefile.PL';
- };
-use constant MAKEFILE => sub { return @_
- ? File::Spec->catfile( @_,
- 'Makefile' )
- : 'Makefile';
};
use constant BUILD_PL => sub { return @_
? File::Spec->catfile( @_,
return $fh if $fh;
return;
};
-
+
+use constant OPEN_DIR => sub {
+ my $dir = shift;
+ my $dh;
+ opendir $dh, $dir or error(loc(
+ "Could not open dir '%1': %2", $dir, $!
+ ));
+
+ return $dh if $dh;
+ return;
+ };
+
+use constant READ_DIR => sub {
+ my $dir = shift;
+ my $dh = OPEN_DIR->( $dir ) or return;
+
+ ### exclude . and ..
+ my @files = grep { $_ !~ /^\.{1,2}/ }
+ readdir($dh);
+
+ return @files;
+ };
+
use constant STRIP_GZ_SUFFIX
=> sub {
my $file = $_[0] or return;
: 'file://' . $dir;
};
+use constant CUSTOM_AUTHOR_ID
+ => 'LOCAL';
+
use constant DOT_SHELL_DEFAULT_RC
=> '.shell-default.rc';
return $name;
};
-use constant ON_WIN32 => $^O eq 'MSWin32';
-use constant ON_NETWARE => $^O eq 'NetWare';
-use constant ON_CYGWIN => $^O eq 'cygwin';
-use constant ON_VMS => $^O eq 'VMS';
-
use constant ON_OLD_CYGWIN => do { ON_CYGWIN and $] < 5.008
? loc(
"Your perl version for %1 is too low; ".
### well, then we really don't know.
my $dir;
- for my $try ( File::Spec->rel2abs( File::Spec->catdir(
- $to, $mod->package_name .'-'. $mod->package_version ) ),
- File::Spec->rel2abs( $ae->extract_path ),
+ for my $try (
+ File::Spec->rel2abs(
+ $self->_safe_path( path =>
+ File::Spec->catdir( $to,
+ $mod->package_name .'-'.
+ $mod->package_version
+ ) ) ),
+ File::Spec->rel2abs( $ae->extract_path ),
) {
($dir = $try) && last if -d $try;
}
use Data::Dumper;
use Params::Check qw[check];
-use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';
use Module::Load::Conditional qw[can_load];
+use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';
$Params::Check::VERBOSE = 1;
=cut
{ my $query_list = {
- LWP => '0.0',
- 'LWP::UserAgent' => '0.0',
- 'HTTP::Request' => '0.0',
- URI => '0.0',
- YAML => '0.0',
+ 'File::Fetch' => '0.08',
+ 'YAML::Tiny' => '0.0',
+ 'File::Temp' => '0.0',
};
my $send_list = {
%$query_list,
- 'Test::Reporter' => 1.27,
+ 'Test::Reporter' => '1.34',
};
sub _have_query_report_modules {
### check if we have the modules we need for querying
return unless $self->_have_query_report_modules( verbose => 1 );
- ### new user agent ###
- my $ua = LWP::UserAgent->new;
- $ua->agent( CPANPLUS_UA->() );
+ ### XXX no longer use LWP here. However, that means we don't
+ ### automagically set proxies anymore!!!
+ # my $ua = LWP::UserAgent->new;
+ # $ua->agent( CPANPLUS_UA->() );
+ #
### set proxies if we have them ###
- $ua->env_proxy();
+ # $ua->env_proxy();
my $url = TESTERS_URL->($mod->package_name);
- my $req = HTTP::Request->new( GET => $url);
+ my $ff = File::Fetch->new( uri => $url );
msg( loc("Fetching: '%1'", $url), $verbose );
- my $res = $ua->request( $req );
+ my $res = do {
+ my $tempdir = File::Temp::tempdir();
+ my $where = $ff->fetch( to => $tempdir );
+
+ unless( $where ) {
+ error( loc( "Fetching report for '%1' failed: %2",
+ $url, $ff->error ) );
+ return;
+ }
- unless( $res->is_success ) {
- error( loc( "Fetching report for '%1' failed: %2",
- $url, $res->message ) );
- return;
- }
+ my $fh = OPEN_FILE->( $where );
+
+ do { local $/; <$fh> };
+ };
+
+ my ($aref) = eval { YAML::Tiny::Load( $res ) };
- my $aref = YAML::Load( $res->content );
+ if( $@ ) {
+ error(loc("Error reading result: %1", $@));
+ return;
+ };
my $dist = $mod->package_name .'-'. $mod->package_version;
$message .= REPORT_LOADED_PREREQS->($mod);
### the footer
- $message .= REPORT_MESSAGE_FOOTER->();
+ $message .= REPORT_MESSAGE_FOOTER->();
### it may be another grade than fail/unknown.. may be worth noting
### that tests got skipped, since the buffer is not added in
}
}
}
+
+ msg( loc("Sending test report for '%1'", $dist), $verbose);
### reporter object ###
my $reporter = Test::Reporter->new(
grade => $grade,
distribution => $dist,
via => "CPANPLUS $int_ver",
+ timeout => $conf->get_conf('timeout') || 60,
debug => $conf->get_conf('debug'),
);
my $conf = $self->configure_object;
my %hash = @_;
- my %seen; my @rv;
-
+ ### File::Find uses follow_skip => 1 by default, which doesn't die
+ ### on duplicates, unless they are directories or symlinks.
+ ### Ticket #29796 shows this code dying on Alien::WxWidgets,
+ ### which uses symlinks.
+ ### File::Find doc says to use follow_skip => 2 to ignore duplicates
+ ### so this will stop it from dying.
+ my %find_args = ( follow_skip => 2 );
### File::Find uses lstat, which quietly becomes stat on win32
### it then uses -l _ which is not allowed by the statbuffer because
### you did a stat, not an lstat (duh!). so don't tell win32 to
### follow symlinks, as that will break badly
- my %find_args = ();
- $find_args{'follow_fast'} = 1 unless $^O eq 'MSWin32';
+ $find_args{'follow_fast'} = 1 unless ON_WIN32;
### never use the @INC hooks to find installed versions of
### modules -- they're just there in case they're not on the
### XXX CPANPLUS::inc is now obsolete, remove the calls
#local @INC = CPANPLUS::inc->original_inc;
+ my %seen; my @rv;
for my $dir (@INC ) {
next if $dir eq '.';
- ### not a directory after all ###
+ ### not a directory after all
+ ### may be coderef or some such
next unless -d $dir;
### make sure to clean up the directories just in case,
### as we're making assumptions about the length
### This solves rt.cpan issue #19738
- $dir = File::Spec->canonpath( $dir );
-
- File::Find::find(
+
+ ### John M. notes: On VMS cannonpath can not currently handle
+ ### the $dir values that are in UNIX format.
+ $dir = File::Spec->canonpath( $dir ) unless ON_VMS;
+
+ ### have to use F::S::Unix on VMS, or things will break
+ my $file_spec = ON_VMS ? 'File::Spec::Unix' : 'File::Spec';
+
+ ### XXX in some cases File::Find can actually die!
+ ### so be safe and wrap it in an eval.
+ eval { File::Find::find(
{ %find_args,
wanted => sub {
return unless /\.pm$/i;
my $mod = $File::Find::name;
+ ### make sure it's in Unix format, as it
+ ### may be in VMS format on VMS;
+ $mod = VMS::Filespec::unixify( $mod ) if ON_VMS;
+
$mod = substr($mod, length($dir) + 1, -3);
- $mod = join '::', File::Spec->splitdir($mod);
+ $mod = join '::', $file_spec->splitdir($mod);
return if $seen{$mod}++;
- my $modobj = $self->module_tree($mod) or return;
+
+ ### 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/^$mod$/i],
+ )
+ : $self->module_tree($mod)
+ };
+
+ ### seperate return, a list context return with one ''
+ ### in it, is also true!
+ return unless $modobj;
push @rv, $modobj;
},
}, $dir
- );
+ ) };
+
+ ### report the error if file::find died
+ error(loc("Error finding installed files in '%1': %2", $dir, $@)) if $@;
}
return \@rv;
use CPANPLUS::Module::Author;
use CPANPLUS::Internals::Constants;
+use File::Fetch;
use Archive::Extract;
-use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';
-use Params::Check qw[check];
use IPC::Cmd qw[can_run];
+use File::Temp qw[tempdir];
+use File::Basename qw[dirname];
+use Params::Check qw[check];
use Module::Load::Conditional qw[can_load];
+use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';
$Params::Check::VERBOSE = 1;
The flow looks like this:
$cb->_author_tree || $cb->_module_tree
- $cb->__check_trees
+ $cb->_check_trees
$cb->__check_uptodate
$cb->_update_source
+ $cb->__update_custom_module_sources
+ $cb->__update_custom_module_source
$cb->_build_trees
$cb->__create_author_tree
$cb->__retrieve_source
$cb->__retrieve_source
$cb->__create_dslip_tree
$cb->__retrieve_source
+ $cb->__create_custom_module_entries
$cb->_save_source
$cb->_dslip_defs
}
}
+ ### if we're explicitly asked to update the sources, or if the
+ ### standard source files are out of date, update the custom sources
+ ### as well
+ $self->__update_custom_module_sources( verbose => $verbose )
+ if $update_source or !$uptodate;
+
return $uptodate;
}
if ( $flag or $args->{'update_source'} ) {
if ( $self->_update_source( name => $args->{'name'} ) ) {
- return 0; # return 0 so 'uptodate' will be set to 0, meaning no use
- # of previously stored hashrefs!
+ return 0; # return 0 so 'uptodate' will be set to 0, meaning no
+ # use of previously stored hashrefs!
} else {
msg( loc("Unable to update source, attempting to get away with using old source file!"), $args->{verbose} );
return 1;
my %hash = @_;
my $conf = $self->configure_object;
-
+ my $verbose;
my $tmpl = {
name => { required => 1 },
path => { default => $conf->get_conf('base') },
- verbose => { default => $conf->get_conf('verbose') },
+ verbose => { default => $conf->get_conf('verbose'), store => \$verbose },
};
my $args = check( $tmpl, \%hash ) or return;
my $path = $args->{path};
- my $now = time;
-
{ ### this could use a clean up - Kane
### no worries about the / -> we get it from the _ftp configuration, so
### it's not platform dependant. -kane
my ($dir, $file) = $conf->_get_mirror( $args->{'name'} ) =~ m|(.+/)(.+)$|sg;
- msg( loc("Updating source file '%1'", $file), $args->{'verbose'} );
+ msg( loc("Updating source file '%1'", $file), $verbose );
my $fake = CPANPLUS::Module::Fake->new(
module => $args->{'name'},
return;
}
- ### `touch` the file, so windoze knows it's new -jmb
- ### works on *nix too, good fix -Kane
- ### make sure it is writable first, otherwise the `touch` will fail
- unless (chmod ( 0644, File::Spec->catfile($path, $file) ) &&
- utime ( $now, $now, File::Spec->catfile($path, $file) )) {
- error( loc("Couldn't touch %1", $file) );
- }
-
+ $self->_update_timestamp( file => File::Spec->catfile($path, $file) );
}
+
return 1;
}
### return if we weren't able to build the trees ###
return unless $self->{_modtree} && $self->{_authortree};
+ ### update them if the other sources are also deemed out of date
+ unless( $uptodate ) {
+ $self->__update_custom_module_sources( verbose => $args->{verbose} )
+ or error(loc("Could not update custom module sources"));
+ }
+
+ ### add custom sources here
+ $self->__create_custom_module_entries( verbose => $args->{verbose} )
+ or error(loc("Could not create custom module entries"));
+
### write the stored files to disk, so we can keep using them
### from now on, till they become invalid
### write them if the original sources weren't uptodate, or
=cut
-sub __create_author_tree() {
+sub __create_author_tree {
my $self = shift;
my %hash = @_;
my $conf = $self->configure_object;
### authors can apparently have digits in their names,
### and dirs can have dots... blah!
my ($author, $package) = $data[2] =~
- m| [A-Z\d-]/
- [A-Z\d-]{2}/
+ m| (?:[A-Z\d-]/)?
+ (?:[A-Z\d-]{2}/)?
([A-Z\d-]+) (?:/[\S]+)?/
([^/]+)$
|xsg;
return $aref;
}
+=head2 $file = $cb->_add_custom_module_source( uri => URI, [verbose => BOOL] );
+
+Adds a custom source index and updates it based on the provided URI.
+
+Returns the full path to the index file on success or false on failure.
+
+=cut
+
+sub _add_custom_module_source {
+ my $self = shift;
+ my $conf = $self->configure_object;
+ my %hash = @_;
+
+ my($verbose,$uri);
+ my $tmpl = {
+ verbose => { default => $conf->get_conf('verbose'),
+ store => \$verbose },
+ uri => { required => 1, store => \$uri }
+ };
+
+ check( $tmpl, \%hash ) or return;
+
+ my $index = File::Spec->catfile(
+ $conf->get_conf('base'),
+ $conf->_get_build('custom_sources'),
+ $self->_uri_encode( uri => $uri ),
+ );
+
+ ### already have it.
+ if( IS_FILE->( $index ) ) {
+ msg(loc("Source '%1' already added", $uri));
+ return 1;
+ }
+
+ ### do we need to create the targe dir?
+ { my $dir = dirname( $index );
+ unless( IS_DIR->( $dir ) ) {
+ $self->_mkdir( dir => $dir ) or return
+ }
+ }
+
+ ### write the file
+ my $fh = OPEN_FILE->( $index => '>' ) or do {
+ error(loc("Could not write index file for '%1'", $uri));
+ return;
+ };
+
+ ### basically we 'touched' it.
+ close $fh;
+
+ $self->__update_custom_module_source(
+ remote => $uri,
+ local => $index,
+ verbose => $verbose,
+ ) or do {
+ ### we faild to update it, we probably have an empty
+ ### possibly silly filename on disk now -- remove it
+ 1 while unlink $index;
+ return;
+ };
+
+ return $index;
+}
+
+=head2 $file = $cb->_remove_custom_module_source( uri => URI, [verbose => BOOL] );
+
+Removes a custom index file based on the URI provided.
+
+Returns the full path to the index file on success or false on failure.
+
+=cut
+
+sub _remove_custom_module_source {
+ my $self = shift;
+ my $conf = $self->configure_object;
+ my %hash = @_;
+
+ my($verbose,$uri);
+ my $tmpl = {
+ verbose => { default => $conf->get_conf('verbose'),
+ store => \$verbose },
+ uri => { required => 1, store => \$uri }
+ };
+
+ check( $tmpl, \%hash ) or return;
+
+ ### use uri => local, instead of the other way around
+ my %files = reverse $self->__list_custom_module_sources;
+
+ my $file = $files{ $uri } or do {
+ error(loc("No such custom source '%1'", $uri));
+ return;
+ };
+
+ 1 while unlink $file;
+
+ if( IS_FILE->( $file ) ) {
+ error(loc("Could not remove index file '%1' for custom source '%2'",
+ $file, $uri));
+ return;
+ }
+
+ msg(loc("Successfully removed index file for '%1'", $uri), $verbose);
+
+ return $file;
+}
+
+=head2 %files = $cb->__list_custom_module_sources
+
+This method scans the 'custom-sources' directory in your base directory
+for additional sources to include in your module tree.
+
+Returns a list of key value pairs as follows:
+
+ /full/path/to/source/file%3Fencoded => http://decoded/mirror/path
+
+=cut
+
+sub __list_custom_module_sources {
+ my $self = shift;
+ my $conf = $self->configure_object;
+
+ my $dir = File::Spec->catdir(
+ $conf->get_conf('base'),
+ $conf->_get_build('custom_sources'),
+ );
+
+ unless( IS_DIR->( $dir ) ) {
+ msg(loc("No '%1' dir, skipping custom sources", $dir));
+ return;
+ }
+
+ ### unencode the files
+ ### skip ones starting with # though
+ my %files = map {
+ my $org = $_;
+ my $dec = $self->_uri_decode( uri => $_ );
+ File::Spec->catfile( $dir, $org ) => $dec
+ } grep { $_ !~ /^#/ } READ_DIR->( $dir );
+
+ return %files;
+}
+
+=head2 $bool = $cb->__update_custom_module_sources( [verbose => BOOL] );
+
+Attempts to update all the index files to your custom module sources.
+
+If the index is missing, and it's a C<file://> uri, it will generate
+a new local index for you.
+
+Return true on success, false on failure.
+
+=cut
+
+sub __update_custom_module_sources {
+ my $self = shift;
+ my $conf = $self->configure_object;
+ my %hash = @_;
+
+ my $verbose;
+ my $tmpl = {
+ verbose => { default => $conf->get_conf('verbose'),
+ store => \$verbose }
+ };
+
+ check( $tmpl, \%hash ) or return;
+
+ my %files = $self->__list_custom_module_sources;
+
+ ### uptodate check has been done a few levels up.
+ my $fail;
+ while( my($local,$remote) = each %files ) {
+
+ $self->__update_custom_module_source(
+ remote => $remote,
+ local => $local,
+ verbose => $verbose,
+ ) or ( $fail++, next );
+ }
+
+ error(loc("Failed updating one or more remote sources files")) if $fail;
+
+ return if $fail;
+ return 1;
+}
+
+=head2 $ok = $cb->__update_custom_module_source
+
+Attempts to update all the index files to your custom module sources.
+
+If the index is missing, and it's a C<file://> uri, it will generate
+a new local index for you.
+
+Return true on success, false on failure.
+
+=cut
+
+sub __update_custom_module_source {
+ my $self = shift;
+ my $conf = $self->configure_object;
+ my %hash = @_;
+
+ my($verbose,$local,$remote);
+ my $tmpl = {
+ verbose => { default => $conf->get_conf('verbose'),
+ store => \$verbose },
+ local => { store => \$local, allow => FILE_EXISTS },
+ remote => { required => 1, store => \$remote },
+ };
+
+ check( $tmpl, \%hash ) or return;
+
+ msg( loc("Updating sources from '%1'", $remote), $verbose);
+
+ ### if you didn't provide a local file, we'll look in your custom
+ ### dir to find the local encoded version for you
+ $local ||= do {
+ ### find all files we know of
+ my %files = reverse $self->__list_custom_module_sources or do {
+ error(loc("No custom modules sources defined -- need '%1' argument",
+ 'local'));
+ return;
+ };
+
+ ### return the local file we're supposed to use
+ $files{ $remote } or do {
+ error(loc("Remote source '%1' unknown -- needs '%2' argument",
+ $remote, 'local'));
+ return;
+ };
+ };
+
+ my $uri = join '/', $remote, $conf->_get_source('custom_index');
+ my $ff = File::Fetch->new( uri => $uri );
+ my $dir = tempdir();
+ my $res = do { local $File::Fetch::WARN = 0;
+ local $File::Fetch::WARN = 0;
+ $ff->fetch( to => $dir );
+ };
+
+ ### couldn't get the file
+ unless( $res ) {
+
+ ### it's not a local scheme, so can't auto index
+ unless( $ff->scheme eq 'file' ) {
+ error(loc("Could not update sources from '%1': %2",
+ $remote, $ff->error ));
+ return;
+
+ ### it's a local uri, we can index it ourselves
+ } else {
+ msg(loc("No index file found at '%1', generating one",
+ $ff->uri), $verbose );
+
+ $self->__write_custom_module_index(
+ path => File::Spec->catdir(
+ File::Spec::Unix->splitdir( $ff->path )
+ ),
+ to => $local,
+ verbose => $verbose,
+ ) or return;
+
+ ### XXX don't write that here, __write_custom_module_index
+ ### already prints this out
+ #msg(loc("Index file written to '%1'", $to), $verbose);
+ }
+
+ ### copy it to the real spot and update it's timestamp
+ } else {
+ $self->_move( file => $res, to => $local ) or return;
+ $self->_update_timestamp( file => $local );
+
+ msg(loc("Index file saved to '%1'", $local), $verbose);
+ }
+
+ return $local;
+}
+
+=head2 $bool = $cb->__write_custom_module_index( path => /path/to/packages, [to => /path/to/index/file, verbose => BOOL] )
+
+Scans the C<path> you provided for packages and writes an index with all
+the available packages to C<$path/packages.txt>. If you'd like the index
+to be written to a different file, provide the C<to> argument.
+
+Returns true on success and false on failure.
+
+=cut
+
+sub __write_custom_module_index {
+ my $self = shift;
+ my $conf = $self->configure_object;
+ my %hash = @_;
+
+ my ($verbose, $path, $to);
+ my $tmpl = {
+ verbose => { default => $conf->get_conf('verbose'),
+ store => \$verbose },
+ path => { required => 1, allow => DIR_EXISTS, store => \$path },
+ to => { store => \$to },
+ };
+
+ check( $tmpl, \%hash ) or return;
+
+ ### no explicit to? then we'll use our default
+ $to ||= File::Spec->catfile( $path, $conf->_get_source('custom_index') );
+
+ my @files;
+ require File::Find;
+ File::Find::find( sub {
+ ### let's see if A::E can even parse it
+ my $ae = do {
+ local $Archive::Extract::WARN = 0;
+ local $Archive::Extract::WARN = 0;
+ Archive::Extract->new( archive => $File::Find::name )
+ } or return;
+
+ ### it's a type A::E recognize, so we can add it
+ $ae->type or return;
+
+ ### neither $_ nor $File::Find::name have the chunk of the path in
+ ### it starting $path -- it's either only the filename, or the full
+ ### path, so we have to strip it ourselves
+ ### make sure to remove the leading slash as well.
+ my $copy = $File::Find::name;
+ my $re = quotemeta($path);
+ $copy =~ s|^$path[\\/]?||i;
+
+ push @files, $copy;
+
+ }, $path );
+
+ ### does the dir exist? if not, create it.
+ { my $dir = dirname( $to );
+ unless( IS_DIR->( $dir ) ) {
+ $self->_mkdir( dir => $dir ) or return
+ }
+ }
+
+ ### create the index file
+ my $fh = OPEN_FILE->( $to => '>' ) or return;
+
+ print $fh "$_\n" for @files;
+ close $fh;
+
+ msg(loc("Successfully written index file to '%1'", $to), $verbose);
+
+ return $to;
+}
+
+
+=head2 $bool = $cb->__create_custom_module_entries( [verbose => BOOL] )
+
+Creates entries in the module tree based upon the files as returned
+by C<__list_custom_module_sources>.
+
+Returns true on success, false on failure.
+
+=cut
+
+### use $auth_obj as a persistant version, so we don't have to recreate
+### modules all the time
+{ my $auth_obj;
+
+ sub __create_custom_module_entries {
+ my $self = shift;
+ my $conf = $self->configure_object;
+ my %hash = @_;
+
+ my $verbose;
+ my $tmpl = {
+ verbose => { default => $conf->get_conf('verbose'), store => \$verbose },
+ };
+
+ check( $tmpl, \%hash ) or return undef;
+
+ my %files = $self->__list_custom_module_sources;
+
+ while( my($file,$name) = each %files ) {
+
+ msg(loc("Adding packages from custom source '%1'", $name), $verbose);
+
+ my $fh = OPEN_FILE->( $file ) or next;
+
+ while( <$fh> ) {
+ chomp;
+ next if /^#/;
+ next unless /\S+/;
+
+ ### join on / -- it's a URI after all!
+ my $parse = join '/', $name, $_;
+
+ ### try to make a module object out of it
+ my $mod = $self->parse_module( module => $parse ) or (
+ error(loc("Could not parse '%1'", $_)),
+ next
+ );
+
+ ### mark this object with a custom author
+ $auth_obj ||= do {
+ my $id = CUSTOM_AUTHOR_ID;
+
+ ### if the object is being created for the first time,
+ ### make sure there's an entry in the author tree as
+ ### well, so we can search on the CPAN ID
+ $self->author_tree->{ $id } =
+ CPANPLUS::Module::Author::Fake->new( cpanid => $id );
+ };
+
+ $mod->author( $auth_obj );
+
+ ### and now add it to the modlue tree -- this MAY
+ ### override things of course
+ if( $self->module_tree( $mod->module ) ) {
+ msg(loc("About to overwrite module tree entry for '%1' with '%2'",
+ $mod->module, $mod->package), $verbose);
+ }
+
+ ### mark where it came from
+ $mod->description( loc("Custom source from '%1'",$name) );
+
+ ### store it in the module tree
+ $self->module_tree->{ $mod->module } = $mod;
+ }
+ }
+
+ return 1;
+ }
+}
+
+
# Local variables:
# c-indentation-style: bsd
# c-basic-offset: 4
my($scheme, $host, $path);
my $tmpl = {
- scheme => { required => 1, store => \$scheme },
- host => { default => '', store => \$host },
- path => { default => '', store => \$path },
+ scheme => { required => 1, store => \$scheme },
+ host => { default => 'localhost', store => \$host },
+ path => { default => '', store => \$path },
};
check( $tmpl, \%hash ) or return;
- $host ||= 'localhost';
+ ### it's an URI, so unixify the path
+ $path = File::Spec::Unix->catdir( File::Spec->splitdir( $path ) );
return "$scheme://" . File::Spec::Unix->catdir( $host, $path );
}
=head2 $path = $cb->_safe_path( path => $path );
-Returns a path that's safe to us on Win32. Only cleans up
-the path on Win32 if the path exists.
+Returns a path that's safe to us on Win32 and VMS.
+
+Only cleans up the path on Win32 if the path exists.
+
+On VMS, it encodes dots to _ using C<VMS::Filespec::vmsify>
=cut
check( $tmpl, \%hash ) or return;
- ### only need to fix it up if there's spaces in the path
- return $path unless $path =~ /\s+/;
+ if( ON_WIN32 ) {
+ ### only need to fix it up if there's spaces in the path
+ return $path unless $path =~ /\s+/;
+
+ ### or if we are on win32
+ return $path if $^O ne 'MSWin32';
- ### or if we are on win32
- return $path if $^O ne 'MSWin32';
-
- ### clean up paths if we are on win32
- return Win32::GetShortPathName( $path ) || $path;
-
+ ### clean up paths if we are on win32
+ return Win32::GetShortPathName( $path ) || $path;
+
+ } elsif ( ON_VMS ) {
+ ### XXX According to John Malmberg, there's an VMS issue:
+ ### catdir on VMS can not currently deal with directory components
+ ### with dots in them.
+ ### Fixing this is a a three step procedure, which will work for
+ ### VMS in its traditional ODS-2 mode, and it will also work if
+ ### VMS is in the ODS-5 mode that is being implemented.
+
+ ### 1. Make sure that the value to be converted, $path is
+ ### in UNIX directory syntax by appending a '/' to it.
+ $path .= '/' unless $path =~ m|/$|;
+
+ ### 2. Use VMS::Filespec::vmsify($path . '/') to convert the dots to
+ ### underscores if needed. The trailing '/' is needed as so that
+ ### C<vmsify> knows that it should use directory translation instead of
+ ### filename translation, as filename translation leaves one dot.
+ $path = VMS::Filespec::vmsify( $path );
+
+ ### 3. Use $path = File::Spec->splitdir( VMS::Filespec::vmsify(
+ ### $path . '/') to remove the directory delimiters.
+
+ ### From John Malmberg:
+ ### File::Spec->catdir will put the path back together.
+ ### The '/' trick only works if the string is a directory name
+ ### with UNIX style directory delimiters or no directory delimiters.
+ ### It is to force vmsify to treat the input specification as UNIX.
+ ###
+ ### There is a VMS::Filespec::unixpath() to do the appending of the '/'
+ ### to the specification, which will do a VMS::Filespec::vmsify()
+ ### if needed.
+ ### However it is not a good idea to call vmsify() on a pathname
+ ### returned by unixify(), and it is not a good idea to call unixify()
+ ### on a pathname returned by vmsify(). Because of the nature of the
+ ### conversion, not all file specifications can make the round trip.
+ ###
+ ### I think that directory specifications can safely make the round
+ ### trip, but not ones containing filenames.
+ $path = File::Spec->catdir( File::Spec->splitdir( $path ) )
+ }
+
+ return $path;
}
}
}
+{ my %escapes = map {
+ chr($_) => sprintf("%%%02X", $_)
+ } 0 .. 255;
+
+ sub _uri_encode {
+ my $self = shift;
+ my %hash = @_;
+
+ my $str;
+ my $tmpl = {
+ uri => { store => \$str, required => 1 }
+ };
+
+ check( $tmpl, \%hash ) or return;
+
+ ### XXX taken straight from URI::Encode
+ ### Default unsafe characters. RFC 2732 ^(uric - reserved)
+ $str =~ s|([^A-Za-z0-9\-_.!~*'()])|$escapes{$1}|g;
+
+ return $str;
+ }
+
+
+ sub _uri_decode {
+ my $self = shift;
+ my %hash = @_;
+
+ my $str;
+ my $tmpl = {
+ uri => { store => \$str, required => 1 }
+ };
+
+ check( $tmpl, \%hash ) or return;
+
+ ### XXX use unencode routine in utils?
+ $str =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
+
+ return $str;
+ }
+}
+
+sub _update_timestamp {
+ my $self = shift;
+ my %hash = @_;
+
+ my $file;
+ my $tmpl = {
+ file => { required => 1, store => \$file, allow => FILE_EXISTS }
+ };
+
+ check( $tmpl, \%hash ) or return;
+
+ ### `touch` the file, so windoze knows it's new -jmb
+ ### works on *nix too, good fix -Kane
+ ### make sure it is writable first, otherwise the `touch` will fail
+
+ my $now = time;
+ unless( chmod( 0644, $file) && utime ($now, $now, $file) ) {
+ error( loc("Couldn't touch %1", $file) );
+ return;
+ }
+
+ return 1;
+}
+
+
1;
# Local variables:
'Locale::Maketext::Simple' => '0.01',
'Log::Message' => '0.01',
'Module::Load' => '0.10',
- 'Module::Load::Conditional' => '0.16', # Better parsing: #23995
+ 'Module::Load::Conditional' => '0.18', # Better parsing: #23995,
+ # uses version.pm for <=>
'version' => '0.70', # needed for M::L::C
# addresses #24630 and
# #24675
],
cpantest => [
{
- LWP => '0.0',
- 'LWP::UserAgent' => '0.0',
- 'HTTP::Request' => '0.0',
- URI => '0.0',
- YAML => '0.0',
- 'Test::Reporter' => 1.27,
+ 'YAML::Tiny' => '0.0',
+ 'File::Fetch' => '0.08',
+ 'Test::Reporter' => '1.34',
},
sub {
my $cb = shift;
=cut
-
sub import {
my $class = shift;
my $option = shift;
- ### XXX this should offer to reconfigure CPANPLUS, somehow. --rs
- my $conf = CPANPLUS::Configure->new()
- or die loc("No configuration available -- aborting") . $/;
### find out what shell we're supposed to load ###
$SHELL = $option
? $class . '::' . $option
- : $conf->get_conf('shell') || $DEFAULT;
-
+ : do { ### XXX this should offer to reconfigure
+ ### CPANPLUS, somehow. --rs
+ ### XXX load Configure only if we really have to
+ ### as that means any $Conf passed later on will
+ ### be ignored in favour of the one that was
+ ### retrieved via ->new --kane
+ my $conf = CPANPLUS::Configure->new() or
+ die loc("No configuration available -- aborting") . $/;
+ $conf->get_conf('shell') || $DEFAULT;
+ };
+
### load the shell, fall back to the default if required
### and die if even that doesn't work
EVAL: {
$rl_avail = loc("ReadLine support %1.", $rl_avail);
$rl_avail = "\n*** $rl_avail" if (length($rl_avail) > 45);
- print loc("%1 -- CPAN exploration and module installation (v%2)",
+ $self->__print(
+ loc("%1 -- CPAN exploration and module installation (v%2)",
$self->which, $self->which->VERSION()), "\n",
loc("*** Please report bugs to <bug-cpanplus\@rt.cpan.org>."), "\n",
loc("*** Using CPANPLUS::Backend v%1. %2",
- $cpan->VERSION, $rl_avail), "\n\n";
+ $cpan->VERSION, $rl_avail), "\n\n"
+ );
}
### checks whether the Term::ReadLine is broken and needs to fallback to Stub
}
}
+### Custom print routines, mainly to be able to catch output
+### in test cases, or redirect it if need be
+{ sub __print {
+ my $self = shift;
+ print @_;
+ }
+
+ sub __printf {
+ my $self = shift;
+ my $fmt = shift;
+
+ ### MUST specify $fmt as a seperate param, and not as part
+ ### of @_, as it will then miss the $fmt and return the
+ ### number of elements in the list... =/ --kane
+ $self->__print( sprintf( $fmt, @_ ) );
+ }
+}
+
1;
=pod
BEGIN {
use vars qw[ $VERSION @ISA ];
@ISA = qw[ CPANPLUS::Shell::_Base::ReadLine ];
- $VERSION = "0.82";
+ $VERSION = "0.83_02";
}
load CPANPLUS::Shell;
sub new {
my $class = shift;
- my $cb = new CPANPLUS::Backend;
+ my $cb = CPANPLUS::Backend->new( @_ );
my $self = $class->SUPER::_init(
brand => $Brand,
term => Term::ReadLine->new( $Brand ),
if( -e $rc_file && -r _ ) {
- $rc = _read_configuration_from_rc( $rc_file );
+ $rc = $self->_read_configuration_from_rc( $rc_file );
}
### register install callback ###
code => \&__ask_about_test_failure,
);
+ ### load all the plugins
+ $self->_plugins_init;
return $self;
}
my $conf = $self->backend->configure_object;
$self->_show_banner;
- print "*** Type 'p' now to show start up log\n"; # XXX add to banner?
+ $self->__print( "*** Type 'p' now to show start up log\n" ); # XXX add to banner?
$self->_show_random_tip if $conf->get_conf('show_startup_tip');
- $self->_input_loop && print "\n";
+ $self->_input_loop && $self->__print( "\n" );
$self->_quit;
}
$SIG{$sig} = $entry->{handler} if exists($entry->{handler});
}
- print "\n";
+ $self->__print( "\n" );
last if $self->dispatch_on_input( input => $input );
### flush the lib cache ###
### space char, we misparsed.. like 'Test::Foo::Bar', which
### would turn into 't', '::Foo::Bar'...
if( $input and $input !~ s/^\s+// ) {
- print loc("Could not understand command: %1\n".
+ $self->__print( loc("Could not understand command: %1\n".
"Possibly missing command before argument(s)?\n",
- $org_input);
+ $org_input) );
return;
}
if( $key eq 'z' or
($key eq 's' and $input =~ /^\s*edit/)
) {
- print "\n",
+ $self->__print( "\n",
loc( "Command '%1' not supported over remote connection",
join ' ', $key, $input
- ), "\n\n";
+ ), "\n\n" );
} else {
my($status,$buff) = $self->__send_remote_command($org_input);
- print "\n", loc("Command failed!"), "\n\n" unless $status;
+ $self->__print( "\n", loc("Command failed!"), "\n\n" )
+ unless $status;
$self->_pager_open if $buff =~ tr/\n// > $self->_term_rowcount;
- print $buff;
+ $self->__print( $buff );
$self->_pager_close;
}
} else {
unless( $self->can($method) ) {
- print loc("Unknown command '%1'. Usage:", $key), "\n";
+ $self->__print(loc("Unknown command '%1'. Usage:", $key), "\n");
$self->_help;
} else {
### it's a cache look up ###
if( $mod =~ /^\d+/ and $mod > 0 ) {
unless( scalar @$cache ) {
- print loc("No search was done yet!"), "\n";
+ $self->__print( loc("No search was done yet!"), "\n" );
} elsif ( my $obj = $cache->[$mod] ) {
push @rv, $obj;
} else {
- print loc("No such module: %1", $mod), "\n";
+ $self->__print( loc("No such module: %1", $mod), "\n" );
}
} else {
my $obj = $cb->parse_module( module => $mod );
unless( $obj ) {
- print loc("No such module: %1", $mod), "\n";
+ $self->__print( loc("No such module: %1", $mod), "\n" );
} else {
push @rv, $obj;
}
unless( scalar @rv ) {
- print loc("No modules found to operate on!\n");
+ $self->__print( loc("No modules found to operate on!\n") );
return;
} else {
return @rv;
### for dists only -- we have checksum info
if( $mod->mtime ) {
- printf $self->dist_format,
- $i,
- $mod->module,
- $mod->mtime,
- $self->_format_version($mod->version),
- $mod->author->cpanid();
+ $self->__printf(
+ $self->dist_format,
+ $i,
+ $mod->module,
+ $mod->mtime,
+ $self->_format_version( $mod->version ),
+ $mod->author->cpanid
+ );
} else {
- printf $self->format,
- $i,
- $mod->module,
- $self->_format_version($mod->version),
- $mod->author->cpanid();
+ $self->__printf(
+ $self->format,
+ $i,
+ $mod->module,
+ $self->_format_version( $mod->version ),
+ $mod->author->cpanid
+ );
}
$i++;
}
$self->_pager_close;
} else {
- print loc("No results to display"), "\n";
+ $self->__print( loc("No results to display"), "\n" );
}
}
$self->dispatch_on_input( input => $rc->{'logout'} )
if defined $rc->{'logout'};
- print loc("Exiting CPANPLUS shell"), "\n";
+ $self->__print( loc("Exiting CPANPLUS shell"), "\n" );
}
###########################
$self->_pager_open if (@help >= $self->_term_rowcount);
### XXX: functional placeholder for actual 'detailed' help.
- print "Detailed help for the command '$input' is not available.\n\n"
- if length $input;
- print map {"$_\n"} @help;
- print $/;
+ $self->__print( "Detailed help for the command '$input' is " .
+ "not available.\n\n" ) if length $input;
+ $self->__print( map {"$_\n"} @help );
+ $self->__print( $/ );
$self->_pager_close;
}
}
local $Data::Dumper::Indent = 1; # for dumpering from !
eval $input;
error( $@ ) if $@;
- print "\n";
+ $self->__print( "\n" );
return;
}
$self->_pager_open;
for my $mod ( @$mods ) {
- print $mod->readme( %$opts );
+ $self->__print( $mod->readme( %$opts ) );
}
$self->_pager_close;
for my $mod (@$mods) {
my $where = $mod->fetch( %$opts );
- print $where
+ $self->__print(
+ $where
? loc("Successfully fetched '%1' to '%2'",
$mod->module, $where )
- : loc("Failed to fetch '%1'", $mod->module);
- print "\n";
+ : loc("Failed to fetch '%1'", $mod->module)
+ );
+ $self->__print( "\n" );
}
$self->_pager_close;
my $shell = $conf->get_program('shell');
unless( $shell ) {
- print loc("Your config does not specify a subshell!"), "\n",
- loc("Perhaps you need to re-run your setup?"), "\n";
+ $self->__print(
+ loc("Your config does not specify a subshell!"), "\n",
+ loc("Perhaps you need to re-run your setup?"), "\n"
+ );
return;
}
#local $ENV{PERL5OPT} = CPANPLUS::inc->original_perl5opt;
if( system($shell) and $! ) {
- print loc("Error executing your subshell '%1': %2",
- $shell, $!),"\n";
+ $self->__print(
+ loc("Error executing your subshell '%1': %2",
+ $shell, $!),"\n"
+ );
next;
}
}
### so the update failed, but you didnt give it any options either
if( !$rv and !(keys %$opts) ) {
- print "\nFailure may be due to corrupt source files\n" .
- "Try this:\n\tx --update_source\n\n";
+ $self->__print(
+ "\nFailure may be due to corrupt source files\n" .
+ "Try this:\n\tx --update_source\n\n" );
}
return $rv;
}
unless( scalar @$mods ) {
- print loc("Nothing done\n");
+ $self->__print( loc("Nothing done\n") );
return;
}
my $status = {};
### first loop over the mods to install them ###
for my $mod (@$mods) {
- print $prompt, $mod->module, " (".$mod->version.")", "\n";
+ $self->__print( $prompt, $mod->module, " (".$mod->version.")", "\n" );
my $log_length = length CPANPLUS::Error->stack_as_string;
print $fh $stack;
close $fh;
- print loc("*** Install log written to:\n %1\n\n", $file);
+ $self->__print(
+ loc("*** Install log written to:\n %1\n\n", $file)
+ );
} else {
warn "Could not open '$file': $!\n";
next;
for my $mod (@$mods) {
# if( $mod->status->installed ) {
if( $status->{$mod} ) {
- print loc("Module '%1' %tense(%2,past) successfully\n",
- $mod->module, $action)
+ $self->__print(
+ loc("Module '%1' %tense(%2,past) successfully\n",
+ $mod->module, $action)
+ );
} else {
$flag++;
- print loc("Error %tense(%1,present) '%2'\n",
- $action, $mod->module);
+ $self->__print(
+ loc("Error %tense(%1,present) '%2'\n", $action, $mod->module)
+ );
}
}
if( !$flag ) {
- print loc("No errors %tense(%1,present) all modules", $action), "\n";
+ $self->__print(
+ loc("No errors %tense(%1,present) all modules", $action), "\n"
+ );
} else {
- print loc("Problem %tense(%1,present) one or more modules", $action);
- print "\n";
- print loc("*** You can view the complete error buffer by pressing '%1' ***\n", 'p')
- unless $conf->get_conf('verbose') || $self->noninteractive;
+ $self->__print(
+ loc("Problem %tense(%1,present) one or more modules", $action)
+ );
+ $self->__print( "\n" );
+
+ $self->__print(
+ loc("*** You can view the complete error buffer by pressing ".
+ "'%1' ***\n", 'p')
+ ) unless $conf->get_conf('verbose') || $self->noninteractive;
}
- print "\n";
+ $self->__print( "\n" );
return !$flag;
}
my $prereq = shift or return;
my $term = $Shell->term;
- print "\n";
- print loc( "Module '%1' requires '%2' to be installed",
- $mod->module, $prereq->module );
- print "\n\n";
- print loc( "If you don't wish to see this question anymore\n".
+ $Shell->__print( "\n" );
+ $Shell->__print( loc("Module '%1' requires '%2' to be installed",
+ $mod->module, $prereq->module ) );
+ $Shell->__print( "\n\n" );
+ $Shell->__print(
+ loc( "If you don't wish to see this question anymore\n".
"you can disable it by entering the following ".
"commands on the prompt:\n '%1'",
- 's conf prereqs 1; s save' );
- print "\n\n";
+ 's conf prereqs 1; s save' ) );
+ $Shell->__print("\n\n");
my $bool = $term->ask_yn(
prompt => loc("Should I install this module?"),
my $term = $Shell->term;
- print "\n";
- print loc( "Test report prepared for module '%1'.\n Would you like to ".
- "send it? (You can edit it if you like)", $mod->module );
- print "\n\n";
+ $Shell->__print( "\n" );
+ $Shell->__print(
+ loc("Test report prepared for module '%1'.\n Would you like to ".
+ "send it? (You can edit it if you like)", $mod->module ) );
+ $Shell->__print( "\n\n" );
my $bool = $term->ask_yn(
prompt => loc("Would you like to send the test report?"),
default => 'n'
my $term = $Shell->term;
- print "\n";
- print loc( "Test report prepared for module '%1'. You can edit this ".
- "report if you would like", $mod->module );
- print "\n\n";
+ $Shell->__print( "\n" );
+ $Shell->__print(
+ loc("Test report prepared for module '%1'. You can edit this ".
+ "report if you would like", $mod->module ) );
+ $Shell->__print("\n\n");
my $bool = $term->ask_yn(
prompt => loc("Would you like to edit the test report?"),
default => 'y'
my $captured = shift || '';
my $term = $Shell->term;
- print "\n";
- print loc( "The tests for '%1' failed. Would you like me to proceed ".
- "anyway or should we abort?", $mod->module );
- print "\n\n";
+ $Shell->__print( "\n" );
+ $Shell->__print(
+ loc( "The tests for '%1' failed. Would you like me to proceed ".
+ "anyway or should we abort?", $mod->module ) );
+ $Shell->__print( "\n\n" );
my $bool = $term->ask_yn(
prompt => loc("Proceed anyway?"),
my @list = sort { $a->module cmp $b->module } $mod->contains;
unless( $href ) {
- print loc("No details for %1 - it might be outdated.",
- $mod->module), "\n";
+ $self->__print(
+ loc("No details for %1 - it might be outdated.",
+ $mod->module), "\n" );
next;
} else {
- print loc( "Details for '%1'\n", $mod->module );
+ $self->__print( loc( "Details for '%1'\n", $mod->module ) );
for my $item ( sort keys %$href ) {
- printf $format, $item, $href->{$item};
+ $self->__printf( $format, $item, $href->{$item} );
}
my $showed;
for my $item ( @list ) {
- printf $format, ($showed ? '' : 'Contains:'), $item->module;
+ $self->__printf(
+ $format, ($showed ? '' : 'Contains:'), $item->module
+ );
$showed++;
}
- print "\n";
+ $self->__print( "\n" );
}
}
$self->_pager_close;
- print "\n";
+ $self->__print( "\n" );
return 1;
}
$self->_pager_open if !$file;
- print CPANPLUS::Error->stack_as_string;
+ $self->__print( CPANPLUS::Error->stack_as_string );
$self->_pager_close;
select $old if $old;
- print "\n";
+ $self->__print( "\n" );
return 1;
}
my $rv = $cb->configure_object->save( $where => $dir );
- print $rv
+ $self->__print(
+ $rv
? loc("Configuration successfully saved to %1\n (%2)\n",
$where, $rv)
- : loc("Failed to save configuration\n" );
+ : loc("Failed to save configuration\n" )
+ );
return $rv;
} elsif ( $type eq 'edit' ) {
} elsif ( $type eq 'mirrors' ) {
- print loc("Readonly list of mirrors (in order of preference):\n\n" );
+ $self->__print(
+ loc("Readonly list of mirrors (in order of preference):\n\n" ) );
my $i;
for my $host ( @{$conf->get_conf('hosts')} ) {
my $uri = $cb->_host_to_uri( %$host );
$i++;
- print "\t[$i] $uri\n";
+ $self->__print( "\t[$i] $uri\n" );
}
} elsif ( $type eq 'selfupdate' ) {
$cb->selfupdate_object->list_categories;
unless( $valid{$key} ) {
- print loc( "To update your current CPANPLUS installation, ".
+ $self->__print(
+ loc( "To update your current CPANPLUS installation, ".
"choose one of the these options:\n%1",
( join $/, map {
sprintf "\ts selfupdate %-17s " .
"[--latest=0] [--dryrun]", $_
} sort keys %valid )
- );
+ )
+ );
} else {
my %update_args = (
update => $key,
my %list = $cb->selfupdate_object
->list_modules_to_update( %update_args );
- print loc( "The following updates will take place:" ), $/.$/;
+ $self->__print(loc("The following updates will take place:"),$/.$/);
for my $feature ( sort keys %list ) {
my $aref = $list{$feature};
### is it a 'feature' or a built in?
- print $valid{$feature}
- ? " " . ucfirst($feature) . ":\n"
- : " Modules for '$feature' support:\n";
+ $self->__print(
+ $valid{$feature}
+ ? " " . ucfirst($feature) . ":\n"
+ : " Modules for '$feature' support:\n"
+ );
### show what modules would be installed
- print scalar @$aref
- ? map { sprintf " %-42s %-6s -> %-6s \n",
- $_->name, $_->installed_version, $_->version
- } @$aref
- : " No upgrades required\n";
- print $/;
+ $self->__print(
+ scalar @$aref
+ ? map { sprintf " %-42s %-6s -> %-6s \n",
+ $_->name, $_->installed_version, $_->version
+ } @$aref
+ : " No upgrades required\n"
+ );
+ $self->__print( $/ );
}
unless( $opts->{'dryrun'} ) {
- print loc( "Updating your CPANPLUS installation\n" );
+ $self->__print( loc("Updating your CPANPLUS installation\n") );
$cb->selfupdate_object->selfupdate( %update_args );
}
}
($val) = ref($val)
? (Data::Dumper::Dumper($val) =~ /= (.*);$/)
: "'$val'";
- printf " $format\n", $name, $val;
+
+ $self->__printf( " $format\n", $name, $val );
}
} elsif ( $key eq 'hosts' ) {
- print loc( "Setting hosts is not trivial.\n" .
- "It is suggested you use '%1' and edit the " .
- "configuration file manually", 's edit');
+ $self->__print(
+ loc( "Setting hosts is not trivial.\n" .
+ "It is suggested you use '%1' and edit the " .
+ "configuration file manually", 's edit')
+ );
} else {
my $method = 'set_' . $type;
$conf->$method( $key => defined $value ? $value : '' )
- and print loc("Key '%1' was set to '%2'", $key,
- defined $value ? $value : 'EMPTY STRING');
+ and $self->__print( loc("Key '%1' was set to '%2'", $key,
+ defined $value ? $value : 'EMPTY STRING') );
}
} else {
- print loc("Unknown type '%1'",$type || 'EMPTY' );
- print $/;
- print loc("Try one of the following:");
- print $/, join $/,
+ $self->__print( loc("Unknown type '%1'",$type || 'EMPTY' ) );
+ $self->__print( $/ );
+ $self->__print( loc("Try one of the following:") );
+ $self->__print( $/, join $/,
map { sprintf "\t%-11s %s", $_, $types{$_} }
- sort keys %types;
+ sort keys %types );
}
}
- print "\n";
+ $self->__print( "\n" );
return 1;
}
my $i = 1;
for my $mod ( @rv ) {
- printf $format,
- $i,
- $self->_format_version($mod->installed_version) || 'Unparsable',
- $self->_format_version( $mod->version ),
- $mod->module,
- $mod->author->cpanid();
+ $self->__printf(
+ $format,
+ $i,
+ $self->_format_version($mod->installed_version) || 'Unparsable',
+ $self->_format_version( $mod->version ),
+ $mod->module,
+ $mod->author->cpanid
+ );
$i++;
}
$self->_pager_close;
my $where = $cb->autobundle( %$opts );
- print $where
+ $self->__print(
+ $where
? loc("Wrote autobundle to '%1'", $where)
- : loc("Could not create autobundle" );
- print "\n";
+ : loc("Could not create autobundle" )
+ );
+ $self->__print( "\n" );
return $where ? 1 : 0;
}
unless( $force ) {
my $list = join "\n", map { ' ' . $_->module } @$mods;
- print loc("
+ $self->__print( loc("
This will uninstall the following modules:
%1
Note that if you installed them via a package manager, you probably
should use the same package manager to uninstall them
-", $list);
+", $list) );
return unless $term->ask_yn(
prompt => loc("Are you sure you want to continue?"),
### first loop over all the modules to uninstall them ###
for my $mod (@$mods) {
- print loc("Uninstalling '%1'", $mod->module), "\n";
+ $self->__print( loc("Uninstalling '%1'", $mod->module), "\n" );
$mod->uninstall( %$opts );
}
### then report whether all this went ok or not ###
for my $mod (@$mods) {
if( $mod->status->uninstall ) {
- print loc("Module '%1' %tense(uninstall,past) successfully\n",
- $mod->module )
+ $self->__print(
+ loc("Module '%1' %tense(uninstall,past) successfully\n",
+ $mod->module ) );
} else {
$flag++;
- print loc("Error %tense(uninstall,present) '%1'\n", $mod->module);
+ $self->__print(
+ loc("Error %tense(uninstall,present) '%1'\n", $mod->module) );
}
}
if( !$flag ) {
- print loc("All modules %tense(uninstall,past) successfully"), "\n";
+ $self->__print(
+ loc("All modules %tense(uninstall,past) successfully"), "\n" );
} else {
- print loc("Problem %tense(uninstalling,present) one or more modules" ),
- "\n";
- print loc("*** You can view the complete error buffer by pressing '%1'".
- "***\n", 'p') unless $conf->get_conf('verbose');
+ $self->__print(
+ loc("Problem %tense(uninstalling,present) one or more modules" ),
+ "\n" );
+
+ $self->__print(
+ loc("*** You can view the complete error buffer by pressing '%1'".
+ "***\n", 'p') ) unless $conf->get_conf('verbose');
}
- print "\n";
+ $self->__print( "\n" );
return !$flag;
}
my %seen;
for my $href (@list ) {
- print "[" . $mod->author->cpanid .'/'. $href->{'dist'} . "]\n"
- unless $seen{ $href->{'dist'} }++;
-
- printf $format, $href->{'grade'}, $href->{'platform'},
- ($href->{'details'} ? '(*)' : '');
+ $self->__print(
+ "[" . $mod->author->cpanid .'/'. $href->{'dist'} . "]\n"
+ ) unless $seen{ $href->{'dist'} }++;
+
+ $self->__printf(
+ $format,
+ $href->{'grade'},
+ $href->{'platform'},
+ ($href->{'details'} ? '(*)' : '')
+ );
$url ||= $href->{'details'};
}
- print "\n==> $url\n" if $url;
- print "\n";
+ $self->__print( "\n==> $url\n" ) if $url;
+ $self->__print( "\n" );
}
$self->_pager_close;
sub plugin_modules { return @PluginModules }
sub plugin_table { return %Dispatch }
- ### find all plugins first
- if( check_install( module => 'Module::Pluggable', version => '2.4') ) {
- require Module::Pluggable;
-
- my $only_re = __PACKAGE__ . '::Plugins::\w+$';
-
- Module::Pluggable->import(
- sub_name => '_plugins',
- search_path => __PACKAGE__,
- only => qr/$only_re/,
- #except => [ INSTALLER_MM, INSTALLER_SAMPLE ]
- );
-
- push @PluginModules, __PACKAGE__->_plugins;
- }
-
- ### now try to load them
- for my $p ( __PACKAGE__->plugin_modules ) {
- my %map = eval { load $p; $p->import; $p->plugins };
- error(loc("Could not load plugin '$p': $@")), next if $@;
+ my $init_done;
+ sub _plugins_init {
+ ### only initialize once
+ return if $init_done++;
+
+ ### find all plugins first
+ if( check_install( module => 'Module::Pluggable', version => '2.4') ) {
+ require Module::Pluggable;
- ### register each plugin
- while( my($name, $func) = each %map ) {
-
- if( not length $name or not length $func ) {
- error(loc("Empty plugin name or dispatch function detected"));
- next;
- }
-
- if( exists( $Dispatch{$name} ) ) {
- error(loc("'%1' is already registered by '%2'",
- $name, $Dispatch{$name}->[0]));
- next;
- }
+ my $only_re = __PACKAGE__ . '::Plugins::\w+$';
- ### register name, package and function
- $Dispatch{$name} = [ $p, $func ];
+ Module::Pluggable->import(
+ sub_name => '_plugins',
+ search_path => __PACKAGE__,
+ only => qr/$only_re/,
+ #except => [ INSTALLER_MM, INSTALLER_SAMPLE ]
+ );
+
+ push @PluginModules, __PACKAGE__->_plugins;
+ }
+
+ ### now try to load them
+ for my $p ( __PACKAGE__->plugin_modules ) {
+ my %map = eval { load $p; $p->import; $p->plugins };
+ error(loc("Could not load plugin '$p': $@")), next if $@;
+
+ ### register each plugin
+ while( my($name, $func) = each %map ) {
+
+ if( not length $name or not length $func ) {
+ error(loc("Empty plugin name or dispatch function detected"));
+ next;
+ }
+
+ if( exists( $Dispatch{$name} ) ) {
+ error(loc("'%1' is already registered by '%2'",
+ $name, $Dispatch{$name}->[0]));
+ next;
+ }
+
+ ### register name, package and function
+ $Dispatch{$name} = [ $p, $func ];
+ }
}
}
-
+
### dispatch a plugin command to it's function
sub _meta {
my $self = shift;
}
### plugin commands
-{ my $help_format = " /%-20s # %s\n";
+{ my $help_format = " /%-21s # %s\n";
sub _list_plugins {
- print loc("Available plugins:\n");
- print loc(" List usage by using: /? PLUGIN_NAME\n" );
- print $/;
+ my $self = shift;
+
+ $self->__print( loc("Available plugins:\n") );
+ $self->__print( loc(" List usage by using: /? PLUGIN_NAME\n" ) );
+ $self->__print( $/ );
my %table = __PACKAGE__->plugin_table;
for my $name( sort keys %table ) {
? "Standard Plugin"
: do { $pkg =~ s/^$this/../; "Provided by: $pkg" };
- printf $help_format, $name, $who;
+ $self->__printf( $help_format, $name, $who );
}
- print $/.$/;
+ $self->__print( $/.$/ );
- print " Write your own plugins? Read the documentation of:\n" .
- " CPANPLUS::Shell::Default::Plugins::HOWTO\n";
+ $self->__print(
+ " Write your own plugins? Read the documentation of:\n" .
+ " CPANPLUS::Shell::Default::Plugins::HOWTO\n" );
- print $/;
+ $self->__print( $/ );
}
sub _list_plugins_help {
}
sub _plugins_usage {
- my $pkg = shift;
+ my $self = shift;
my $shell = shift;
my $cb = shift;
my $cmd = shift;
my $input = shift;
- my %table = __PACKAGE__->plugin_table;
+ my %table = $self->plugin_table;
my @list = length $input ? split /\s+/, $input : sort keys %table;
my $func = $table{$name}->[1] . '_help';
if ( my $sub = $pkg->can( $func ) ) {
- eval { print $sub->() };
+ eval { $self->__print( $sub->() ) };
error( $@ ) if $@;
} else {
- print " No usage for '$name' -- try perldoc $pkg";
+ $self->__print(" No usage for '$name' -- try perldoc $pkg");
}
- print $/;
+ $self->__print( $/ );
}
- print $/.$/;
+ $self->__print( $/.$/ );
}
sub _plugins_usage_help {
sub _read_configuration_from_rc {
+ my $self = shift;
my $rc_file = shift;
my $href;
eval { $href = Config::Auto::parse( $rc_file, format => 'space' ) };
- print loc( "Unable to read in config file '%1': %2",
- $rc_file, $@ ) if $@;
+ $self->__print(
+ loc( "Unable to read in config file '%1': %2", $rc_file, $@ )
+ ) if $@;
}
return $href || {};
loc( "The documentation in %1 and %2 is very useful",
"CPANPLUS::Module", "CPANPLUS::Backend" ),
loc( "You can type '%1' for help and '%2' to exit", 'h', 'q' ),
- loc( "You can run an interactive setup using '%1'", 's reconfigure' ),
+ loc( "You can run an interactive setup using '%1'", 's reconfigure' ),
+ loc( "You can add custom sources to your index. See '%1' for details",
+ '/cs --help' ),
);
sub _show_random_tip {
my $self = shift;
- print $/, "Did you know...\n ", $tips[ int rand scalar @tips ], $/;
+ $self->__print( $/, "Did you know...\n ",
+ $tips[ int rand scalar @tips ], $/ );
return 1;
}
}
--- /dev/null
+package CPANPLUS::Shell::Default::Plugins::CustomSource;
+
+use strict;
+use CPANPLUS::Error qw[error msg];
+use CPANPLUS::Internals::Constants;
+
+use Data::Dumper;
+use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';
+
+=head1 NAME
+
+CPANPLUS::Shell::Default::Plugins::CustomSource
+
+=head1 SYNOPSIS
+
+ ### elaborate help text
+ CPAN Terminal> /? cs
+
+ ### add a new custom source
+ CPAN Terminal> /cs --add file:///path/to/releases
+
+ ### list all your custom sources by
+ CPAN Terminal> /cs --list
+
+ ### display the contents of a custom source by URI or ID
+ CPAN Terminal> /cs --contents file:///path/to/releases
+ CPAN Terminal> /cs --contents 1
+
+ ### Update a custom source by URI or ID
+ CPAN Terminal> /cs --update file:///path/to/releases
+ CPAN Terminal> /cs --update 1
+
+ ### Remove a custom source by URI or ID
+ CPAN Terminal> /cs --remove file:///path/to/releases
+ CPAN Terminal> /cs --remove 1
+
+ ### Write an index file for a custom source, to share
+ ### with 3rd parties or remote users
+ CPAN Terminal> /cs --write file:///path/to/releases
+
+ ### Make sure to save your sources when adding/removing
+ ### sources, so your changes are reflected in the cache:
+ CPAN Terminal> x
+
+=head1 DESCRIPTION
+
+This is a C<CPANPLUS::Shell::Default> plugin that can add
+custom sources to your CPANPLUS installation. This is a
+wrapper around the C<custom module sources> code as outlined
+in L<CPANPLUS::Backend/CUSTOM MODULE SOURCES>.
+
+This allows you to extend your index of available modules
+beyond what's available on C<CPAN> with your own local
+distributions, or ones offered by third parties.
+
+=cut
+
+
+sub plugins {
+ return ( cs => 'custom_source' )
+}
+
+my $Cb;
+my $Shell;
+my @Index = ();
+
+sub _uri_from_cache {
+ my $self = shift;
+ my $input = shift or return;
+
+ ### you gave us a search number
+ my $uri = $input =~ /^\d+$/
+ ? $Index[ $input - 1 ] # remember, off by 1!
+ : $input;
+
+ my %files = reverse $Cb->list_custom_sources;
+
+ ### it's an URI we know
+ if( my $local = $files{ $uri } ) {
+ return wantarray
+ ? ($uri, $local)
+ : $uri;
+ }
+
+ ### couldn't resolve the input
+ error(loc("Unknown URI/index: '%1'", $input));
+ return;
+}
+
+sub _list_custom_sources {
+ my $class = shift;
+
+ my %files = $Cb->list_custom_sources;
+
+ $Shell->__print( loc("Your remote sources:"), $/ ) if keys %files;
+
+ my $i = 0;
+ while(my($local,$remote) = each %files) {
+ $Shell->__printf( " [%2d] %s\n", ++$i, $remote );
+
+ ### remember, off by 1!
+ push @Index, $remote;
+ }
+
+ $Shell->__print( $/ );
+}
+
+sub _list_contents {
+ my $class = shift;
+ my $input = shift;
+
+ my ($uri,$local) = $class->_uri_from_cache( $input );
+ unless( $uri ) {
+ error(loc("--contents needs URI parameter"));
+ return;
+ }
+
+ my $fh = OPEN_FILE->( $local ) or return;
+
+ $Shell->__printf( " %s", $_ ) for sort <$fh>;
+ $Shell->__print( $/ );
+}
+
+sub custom_source {
+ my $class = shift;
+ my $shell = shift; $Shell = $shell; # available to all methods now
+ my $cb = shift; $Cb = $cb; # available to all methods now
+ my $cmd = shift;
+ my $input = shift || '';
+ my $opts = shift || {};
+
+ ### show a list
+ if( $opts->{'list'} ) {
+ $class->_list_custom_sources;
+
+ } elsif ( $opts->{'contents'} ) {
+ $class->_list_contents( $input );
+
+ } elsif ( $opts->{'add'} ) {
+ unless( $input ) {
+ error(loc("--add needs URI parameter"));
+ return;
+ }
+
+ $cb->add_custom_source( uri => $input )
+ and $shell->__print(loc("Added remote source '%1'", $input), $/);
+
+ $Shell->__print($/, loc("Remote source contains:"), $/, $/);
+ $class->_list_contents( $input );
+
+ } elsif ( $opts->{'remove'} ) {
+ my($uri,$local) = $class->_uri_from_cache( $input );
+ unless( $uri ) {
+ error(loc("--remove needs URI parameter"));
+ return;
+ }
+
+ 1 while unlink $local;
+
+ $shell->__print( loc("Removed remote source '%1'", $uri), $/ );
+
+ } elsif ( $opts->{'update'} ) {
+ ### did we get input? if so, it's a remote part
+ my $uri = $class->_uri_from_cache( $input );
+
+ $cb->update_custom_source( $uri ? ( remote => $uri ) : () )
+ and do { $shell->__print( loc("Updated remote sources"), $/ ) };
+
+ } elsif ( $opts->{'write'} ) {
+ $cb->write_custom_source_index( path => $input ) and
+ $shell->__print( loc("Wrote remote source index for '%1'", $input), $/);
+
+ } else {
+ error(loc("Unrecognized command, see '%1' for help", '/? cs'));
+ }
+
+ return;
+}
+
+sub custom_source_help {
+ return loc(
+ $/ .
+ ' # Plugin to manage custom sources from the default shell' . $/ .
+ " # See the 'CUSTOM MODULE SOURCES' section in the " . $/ .
+ ' # CPANPLUS::Backend documentation for details.' . $/ .
+ ' /cs --list # list available sources' . $/ .
+ ' /cs --add URI # add source' . $/ .
+ ' /cs --remove URI | INDEX # remove source' . $/ .
+ ' /cs --contents URI | INDEX # show packages from source'. $/ .
+ ' /cs --update [URI | INDEX] # update source index' . $/ .
+ ' /cs --write PATH # write source index' . $/
+ );
+
+}
+
+1;
+
### make sure to keep the plan -- this is the only test
### supported for 'older' T::H (pre 2.28) -- see Makefile.PL for details
-use Test::More tests => 36;
+use Test::More tests => 40;
use Cwd;
use Data::Dumper;
is( File::Spec->rel2abs(cwd()), File::Spec->rel2abs(File::Spec->catdir($Cwd,$Dir)),
" Cwd() is '$Dir'");
ok( $Class->_chdir( dir => $Cwd), "Chdir back to '$Cwd'" );
- is( File::Spec->rel2abs(cwd()),$Cwd," Cwd() is '$Cwd'" );
+ like( File::Spec->rel2abs(cwd()), qr/$Cwd/i,
+ " Cwd() is '$Cwd'" );
}
### test _move ###
ok( !-e $File, " File removed" );
}
-
+### uri encode/decode tests
+{ my $org = 'file://foo/bar';
+
+ my $enc = $Class->_uri_encode( uri => $org );
+
+ ok( $enc, "String '$org' encoded" );
+ like( $enc, qr/%/, " Contents as expected" );
+
+ my $dec = $Class->_uri_decode( uri => $enc );
+ ok( $dec, "String '$enc' decoded" );
+ is( $dec, $org, " Decoded properly" );
+}
use strict;
use CPANPLUS::Backend;
+use CPANPLUS::Internals::Constants;
use Test::More 'no_plan';
use Data::Dumper;
+use File::Basename qw[dirname];
my $conf = gimme_conf();
+my $cb = CPANPLUS::Backend->new( $conf );
+
+### XXX temp
+# $conf->set_conf( verbose => 1 );
-my $cb = CPANPLUS::Backend->new( $conf );
isa_ok($cb, "CPANPLUS::Internals" );
my $mt = $cb->_module_tree;
ok( (-e $file && -f _ && -s _), "$file exists" );
}
-ok( scalar keys %$at, "Authortree loaded successfully" );
-ok( scalar keys %$mt, "Moduletree loaded successfully" );
+ok( scalar keys %$at, "Authortree loaded successfully" );
+ok( scalar keys %$mt, "Moduletree loaded successfully" );
+
+### test lookups
+{ my $auth = $at->{'EUNOXS'};
+ my $mod = $mt->{$modname};
+
+ isa_ok( $auth, 'CPANPLUS::Module::Author' );
+ isa_ok( $mod, 'CPANPLUS::Module' );
+}
+
+### check custom sources
+### XXX whitebox test
+{ ### first, find a file to serve as a source
+ my $mod = $mt->{$modname};
+ my $package = File::Spec->rel2abs(
+ File::Spec->catfile(
+ $FindBin::Bin,
+ TEST_CONF_CPAN_DIR,
+ $mod->path,
+ $mod->package,
+ )
+ );
+
+ ok( $package, "Found file for custom source" );
+ ok( -e $package, " File '$package' exists" );
+
+ ### remote uri
+ my $uri = $cb->_host_to_uri(
+ scheme => 'file',
+ host => '',
+ path => File::Spec->catfile( dirname($package) )
+ );
+
+ ### local file
+ my $src_file = $cb->_add_custom_module_source( uri => $uri );
+ ok( $src_file, "Sources written to '$src_file'" );
+ ok( -e $src_file, " File exists" );
+
+ ### and write the file
+ { my $meth = '__write_custom_module_index';
+ can_ok( $cb, $meth );
+
+ my $rv = $cb->$meth(
+ path => dirname( $package ),
+ to => $src_file
+ );
+
+ ok( $rv, " Sources written" );
+ is( $rv, $src_file, " Written to expected file" );
+ ok( -e $src_file, " Source file exists" );
+ ok( -s $src_file, " File has non-zero size" );
+ }
+
+ ### let's see if we can find our custom files
+ { my $meth = '__list_custom_module_sources';
+ can_ok( $cb, $meth );
+
+ my %files = $cb->$meth;
+ ok( scalar(keys(%files)),
+ " Got list of sources" );
+ ok( $files{ $src_file }," Found proper entry" );
+ }
+
+ ### now we can have it be loaded in
+ { my $meth = '__create_custom_module_entries';
+ can_ok( $cb, $meth );
-my $auth = $at->{'EUNOXS'};
-my $mod = $mt->{$modname};
+ ### now add our own sources
+ ok( $cb->$meth, "Sources file loaded" );
-isa_ok( $auth, 'CPANPLUS::Module::Author' );
-isa_ok( $mod, 'CPANPLUS::Module' );
+ my $add_name = TEST_CONF_INST_MODULE;
+ my $add = $mt->{$add_name};
+ ok( $add, " Found added module" );
+
+ ok( $add->status->_fetch_from,
+ " Full download path set" );
+ is( $add->author->cpanid, CUSTOM_AUTHOR_ID,
+ " Attributed to custom author" );
+
+ ### since we replaced an existing module, there should be
+ ### a message on the stack
+ like( CPANPLUS::Error->stack_as_string, qr/overwrite module tree/i,
+ " Addition message recorded" );
+ }
+
+ ### test updating custom sources
+ { my $meth = '__update_custom_module_sources';
+ can_ok( $cb, $meth );
+
+ ### mark what time it is now, sleep 1 second for better measuring
+ my $now = time;
+ sleep 1;
+
+ my $ok = $cb->$meth;
+
+ ok( $ok, "Custom sources updated" );
+ cmp_ok( [stat $src_file]->[9], '>=', $now,
+ " Timestamp on sourcefile updated" );
+ }
+
+ ### now update it individually
+ { my $meth = '__update_custom_module_source';
+ can_ok( $cb, $meth );
+
+ ### mark what time it is now, sleep 1 second for better measuring
+ my $now = time;
+ sleep 1;
+
+ my $ok = $cb->$meth( remote => $uri );
+
+ ok( $ok, "Custom source for '$uri' updated" );
+ cmp_ok( [stat $src_file]->[9], '>=', $now,
+ " Timestamp on sourcefile updated" );
+ }
+
+ ### now update using the higher level API, see if it's part of the update
+ { CPANPLUS::Error->flush;
+
+ ### mark what time it is now, sleep 1 second for better measuring
+ my $now = time;
+ sleep 1;
+
+ my $ok = $cb->_build_trees(
+ uptodate => 0,
+ use_stored => 0,
+ );
+
+ ok( $ok, "All sources updated" );
+ cmp_ok( [stat $src_file]->[9], '>=', $now,
+ " Timestamp on sourcefile updated" );
+
+ like( CPANPLUS::Error->stack_as_string, qr/Updating sources from/,
+ " Update recorded in the log" );
+ }
+
+ ### now remove the index file;
+ { my $meth = '_remove_custom_module_source';
+ can_ok( $cb, $meth );
+
+ my $file = $cb->$meth( uri => $uri );
+ ok( $file, "Index file removed" );
+ ok( ! -e $file, " File '$file' no longer on disk" );
+ }
+}
# Local variables:
# c-indentation-style: bsd
name => $ModName,
comment => undef,
package => 'Foo-Bar-0.01.tar.gz',
- path => 'authors/id/E/EU/EUNOXS',
+ path => 'authors/id/EUNOXS',
version => '0.01',
dslip => 'cdpO ',
description => 'CPANPLUS Test Package',
### convenience methods ###
{ ok( 1, "Convenience functions" );
- is( $Mod->package_name, 'Foo-Bar', " Package name");
+ is( $Mod->package_name, 'Foo-Bar', " Package name");
is( $Mod->package_version, '0.01', " Package version");
is( $Mod->package_extension, 'tar.gz', " Package extension");
ok( !$Mod->package_is_perl_core, " Package not core");
use strict;
use Test::More 'no_plan';
use Cwd;
+use Config;
use File::Basename;
use CPANPLUS::Internals::Constants;
my $tmpl = {
MAKEFILE_PL => 'Makefile.PL',
- MAKEFILE => 'Makefile',
BUILD_PL => 'Build.PL',
BLIB => 'blib',
+ MAKEFILE => do {
+ ### On vms, it's a different name. See constants
+ ### file for details
+ (ON_VMS and $Config::Config{make} =~ /MM[S|K]/i)
+ ? 'DESCRIP.MMS'
+ : 'Makefile'
+ },
};
while ( my($sub,$res) = each %$tmpl ) {
flub://floo ]
) {
my $obj = $cb->parse_module( module => $guess );
- ok( IS_FAKE_MODOBJ->(mod => $obj), "parse_module success by '$guess'" );
+ ok( IS_FAKE_MODOBJ->(mod => $obj),
+ "parse_module success by '$guess'" );
is( $obj->status->_fetch_from, $guess,
- " Fetch from set ok" );
+ " Fetch from set ok" );
}
}
}
### installed tests ###
-{
- ok( scalar $cb->installed, "Found list of installed modules" );
+{ ok( scalar($cb->installed), "Found list of installed modules" );
}
### autobudle tests ###
+### the shell prints to STDOUT, so capture that here
+### and we can check the output
### make sure we can find our conf.pl file
BEGIN {
use FindBin;
require "$FindBin::Bin/inc/conf.pl";
}
-use strict;
-use Test::More 'no_plan';
+### this lets us capture output from the default shell
+{ no warnings 'redefine';
-use CPANPLUS::Internals::Constants;
+ my $out;
+ *CPANPLUS::Shell::Default::__print = sub {
+ my $self = shift;
+ $out .= "@_";
+ };
+ sub _out { $out }
+ sub _reset_out { $out = '' }
+}
-my $Class = 'CPANPLUS::Shell';
-my $Conf = gimme_conf();
+use strict;
+use Test::More 'no_plan';
+use CPANPLUS::Internals::Constants;
-$Conf->set_conf( shell => SHELL_DEFAULT );
+my $Conf = gimme_conf();
+my $Class = 'CPANPLUS::Shell';
+my $Default = SHELL_DEFAULT;
+my $TestMod = TEST_CONF_MODULE;
+my $TestAuth= TEST_CONF_AUTHOR;
+
### basic load tests
-use_ok( $Class );
+use_ok( $Class, 'Default' );
is( $Class->which, SHELL_DEFAULT,
"Default shell loaded" );
+### create an object
+my $Shell = $Class->new( $Conf );
+ok( $Shell, " New object created" );
+isa_ok( $Shell, $Default, " Object" );
+
+### method tests
+{
+ ### uri to use for /cs tests
+ my $cs_path = File::Spec->rel2abs(
+ File::Spec->catfile(
+ $FindBin::Bin,
+ TEST_CONF_CPAN_DIR,
+ )
+ );
+ my $cs_uri = $Shell->backend->_host_to_uri(
+ scheme => 'file',
+ host => '',
+ path => $cs_path,
+ );
+
+
+ ### XXX have to keep the list ordered, as some methods only work as
+ ### expected *after* others have run
+ my @map = (
+ 'v' => qr/CPANPLUS/,
+ '! $self->__print($$)' => qr/$$/,
+ '?' => qr/\[General\]/,
+ 'h' => qr/\[General\]/,
+ 's' => qr/Unknown type/,
+ 's conf' => qr/$Default/,
+ 's program' => qr/sudo/,
+ 's mirrors' => do { my $re = TEST_CONF_CPAN_DIR; qr/$re/ },
+ 's selfupdate' => qr/selfupdate/,
+ 'b' => qr/autobundle/,
+ "a $TestAuth" => qr/$TestAuth/,
+ "m $TestMod" => qr/$TestMod/,
+ "w" => qr/$TestMod/,
+ "r 1" => qr/README/,
+ "r $TestMod" => qr/README/,
+ "f $TestMod" => qr/$TestAuth/,
+ "d $TestMod" => qr/$TestMod/,
+ ### XXX this one prints to stdout in a subprocess -- skipping this
+ ### for now due to possible PERL_CORE issues
+ #"t $TestMod" => qr/$TestMod.*tested successfully/i,
+ "l $TestMod" => qr/$TestMod/,
+ '! die $$; p' => qr/$$/,
+ '/plugins' => qr/Available plugins:/i,
+ '/? ?' => qr/usage/i,
+
+ ### custom source plugin tests
+ "/? cs" => qr|/cs|,
+ "/cs --add $cs_uri" => qr/Added remote source/,
+ "/cs --list" => do { my $re = quotemeta($cs_uri); qr/$re/ },
+ "/cs --contents $cs_uri" => qr/$TestAuth/,
+ "/cs --update" => qr/Updated remote sources/,
+ "/cs --update $cs_uri" => qr/Updated remote sources/,
+ "/cs --write $cs_path" => qr/Wrote remote source index/,
+ "/cs --remove $cs_uri" => qr/Removed remote source/,
+ );
+
+ my $meth = 'dispatch_on_input';
+ can_ok( $Shell, $meth );
+
+ while( my($input,$out_re) = splice(@map, 0, 2) ) {
+
+ ### empty output cache
+ __PACKAGE__->_reset_out;
+ CPANPLUS::Error->flush;
+
+ ok( 1, "Testing '$input'" );
+ $Shell->$meth( input => $input );
+
+ my $out = __PACKAGE__->_out;
+
+ ### XXX remove me
+ #diag( $out );
+
+ ok( $out, " Output received" );
+ like( $out, $out_re, " Output matches '$out_re'" );
+ }
+}
+
+__END__
+
+#### test seperately, they have side effects
+'q' => qr/^$/, # no output!
+'s save boxed' => do { my $re = CONFIG_BOXED; qr/$re/ },
+### this doens't write any output
+'x --update_source' => qr/module tree/i,
+s edit
+s reconfigure
+'c' => '_reports',
+'i' => '_install',
+'u' => '_uninstall',
+'z' => '_shell',
+### might not have any out of date modules...
+'o' => '_uptodate',
+
+
diag(q[Note: 'sudo' might ask for your password to do the install test])
if $conf->get_program('sudo');
- ok( $Mod->install( force =>1 ),
+ ### make sure no options are set in PERL5_MM_OPT, as they might
+ ### change the installation target and therefor will 1. mess up
+ ### the tests and 2. leave an installed copy of our test module
+ ### lying around. This addresses bug #29716: 20_CPANPLUS-Dist-MM.t
+ ### fails (and leaves test files installed) when EUMM options
+ ### include INSTALL_BASE
+ { local $ENV{'PERL5_MM_OPT'};
+
+ ok( $Mod->install( force =>1 ),
"Installing module" );
+ }
+
ok( $Mod->status->installed," Module installed according to status" );
" Prior existance noted" );
### ok, unlink the makefile.pl, now really write one
- unlink $makefile;
+ 1 while unlink $makefile;
+
+ ### must do '1 while' for VMS
+ { my $unlink_sts = unlink($makefile_pl);
+ 1 while unlink $makefile_pl;
+ ok( $unlink_sts, "Deleting Makefile.PL");
+ }
- ok( unlink($makefile_pl), "Deleting Makefile.PL");
ok( !-s $makefile_pl, " Makefile.PL deleted" );
ok( !-s $makefile, " Makefile deleted" );
ok($dist->write_makefile_pl," Makefile.PL written" );
### seems ok, now delete it again and go via install()
### to see if it picks up on the missing makefile.pl and
### does the right thing
- ok( unlink($makefile_pl), "Deleting Makefile.PL");
+ ### must do '1 while' for VMS
+ { my $unlink_sts = unlink($makefile_pl);
+ 1 while unlink $makefile_pl;
+ ok( $unlink_sts, "Deleting Makefile.PL");
+ }
ok( !-s $makefile_pl, " Makefile.PL deleted" );
ok( $dist->status->mk_flush,"Dist status flushed" );
ok( $dist->prepare, " Dist->prepare run again" );
{ local $^W;
local *CPANPLUS::Dist::MM::write_makefile_pl = sub { 1 };
- unlink $makefile_pl;
- unlink $makefile;
+ 1 while unlink $makefile_pl;
+ 1 while unlink $makefile;
ok(!-s $makefile_pl, "Makefile.PL deleted" );
ok(!-s $makefile, "Makefile deleted" );
}
### clean up afterwards ###
- ok( unlink($makefile_pl), "Deleting Makefile.PL");
+ ### must do '1 while' for VMS
+ { my $unlink_sts = unlink($makefile_pl);
+ 1 while unlink $makefile_pl;
+ ok( $unlink_sts, "Deleting Makefile.PL");
+ }
+
$dist->status->mk_flush;
-
}
### test ENV setting in Makefile.PL
pre_hook => sub {
my $mod = shift;
my $clone = $mod->clone;
- $clone->status->prereqs( { $ModPrereq => ~0/2 } );
+ $clone->status->prereqs( { $ModPrereq => ~0 } );
return $clone;
},
failed => 1,
}
{ my $clone = $Mod->clone;
+
+ ### divide by two -- possibly ~0 is unsigned, and we cause an overflow,
+ ### as happens to version.pm 0.7203 among others.
my $prereqs = { $ModPrereq => ~0/2 };
$clone->status->prereqs( $prereqs );
uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/authors/01mailrc.txt.gz lib/CPANPLUS/t/dummy-CPAN/authors/01mailrc.txt.gz.packed
-Created at Wed Aug 15 16:13:41 2007
+Created at Tue Oct 9 17:23:14 2007
#########################################################################
__UU__
M'XL("%_EO$4``S`Q;6%I;')C+G1X=`!+S,E,+%9P#8T(5@`#)=>*DM"2S)QB
--- /dev/null
+#########################################################################
+This is a binary file that was packed with the 'uupacktool.pl' which
+is included in the Perl distribution.
+
+To unpack this file use the following command:
+
+ uupacktool.pl -u lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/Bundle-Foo-Bar-0.01.tar.gz.packed lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/Bundle-Foo-Bar-0.01.tar.gz
+
+To recreate it use the following command:
+
+ uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/Bundle-Foo-Bar-0.01.tar.gz lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/Bundle-Foo-Bar-0.01.tar.gz.packed
+
+Created at Tue Oct 9 17:23:14 2007
+#########################################################################
+__UU__
+M'XL("!1%OT4"`T)U;F1L92U&;V\M0F%R+3`N,#$N=&%R`.V7:V_:,!2&^8I_
+MQ6F91"L52"`)6KI6`Q8TI`$5EZW2-"%##%C-K8FSEDW[[W,2:&E$6VGKH$Q^
+M(`KR<4YB7K_'3CUT3(L4FJY;J&._(!4EN91Y821.5563LY:<.:MS_%N65+6J
+M*67^R4BR(E<J&5`S6R`,&/8!,E?8(4_UNYD38CTSR+5!9?:$^@;]+3HN[5C_
+MJB0+_7>I?])>VI'^FBR7A?ZO0'_>7MJ%_EI%%?J_$OUY>]&S_U)_35$>U5^5
+MM'O]I2K7OQK7?TGH_\_Q\.0*SP@D>NLZ%US7N>*G"+WY;/3ZK6X'SN`PFA>'
+MO$WFQVAD=#Z,1@B=S0DV9>C4V@9"Z01P%V]T.P.C,^@CM(KINC'4]<L^<*+,
+MZ4BG&\72D7;]L6NBR/HUC1L3TB21Y2/5AH./W1Y"QBT;,FH%/`6^(M'A0\<%
+MGJGAF@3>33SL>%88O">WV/8L4IRX]CG/,@D9']_]/Y'96S;Y/_H?II2/]N+3
+MBZW_3_I?45?^E\OE<KS^2XKP_W:&3V"#"TY1%`B83R>,6_Z+3QE930LX0I&A
+M(MNO&^SL'/+I(I`_B;LN"\FHV>NV5UTW+C+Y$\C!E#IF`*OJ$R<P:<!2]_K)
+MZTK[HF?T^W&ZV0_J0>'ME&?H#YO-UN6R-0^_DF=(+/_P<?_(_GQ,V5J]/^C5
+M&H.U9-=?TX/_=H*.3Z,HVC?_USJMIM$?O.3[WU/^+\O5U/Y/+6O"_UMAHPW1
+MV@J`5K,AF\T.YC0`*_*B.X4H'J"V,:@5%[8%S]%VS9#7#ILP7#`QPW"$39.8
+M,%[`G?F.]W@A_9_6_Z6FV_*_4DV__ZF*I`K_;X,<S!GS]%+)COU9&(?4,HN!
+M&_H3,G7]&2DZA,4SHA!X9%*<,]M"N<L$B`L"_V+P?)>Y;.&1@X,#@!:#&VI9
+M,)ECA[]<4`?8G,`T9*$?=XBOSB$'VT2_JQ`/IR+Z3OR`NHZ^MGU?-HVFOFOK
+ML+ET48<+:EDF]0-^:<#W+<@GUR'U2:`C%&TD?#H.690F>EP=DH&C&7&(CQDQ
+H1^.%OFE+!,N[@U:L2*)0"00"@4`@$`@$`H%`(-@;?@-?EF['`"@`````
--- /dev/null
+0&&<<''; # this PGP-signed message is also valid perl
+-----BEGIN PGP SIGNED MESSAGE-----
+Hash: SHA1
+
+# CHECKSUMS file written on Tue Jun 15 02:56:25 2004 by CPAN::Checksums (v1.016)
+$cksum = {
+ 'Foo-Bar-0.01.tar.gz' => {
+ 'mtime' => '1999-05-13',
+ 'md5' => '2917421f5a41419f7bb2d2cf87f04b8d',
+ 'size' => 1066
+ },
+ 'perl5.005_03.tar.gz' => {
+ 'mtime' => '1999-05-13',
+ 'md5' => '2b70961796a2ed7ca21fbf7e0c615643',
+ 'size' => 119
+ },
+ 'Bundle-Foo-Bar-0.01.tar.gz' => {
+ 'mtime' => '1999-05-13',
+ 'md5' => '76f9c0eed0de9f533ed4d3922bac2f11',
+ 'size' => 850
+ },
+};
+__END__
+-----BEGIN PGP SIGNATURE-----
+Version: GnuPG v1.2.3 (GNU/Linux)
+
+iD8DBQFAzmVZMo2oZ0UPiewRAv5MAJ9tajbtrg14echRtn4t940v7FpMfgCffvU1
+mAcaUP8yzmIvbpdn1cGUgpw=
+=rrmL
+-----END PGP SIGNATURE-----
--- /dev/null
+#########################################################################
+This is a binary file that was packed with the 'uupacktool.pl' which
+is included in the Perl distribution.
+
+To unpack this file use the following command:
+
+ uupacktool.pl -u lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/Foo-Bar-0.01.tar.gz.packed lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/Foo-Bar-0.01.tar.gz
+
+To recreate it use the following command:
+
+ uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/Foo-Bar-0.01.tar.gz lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/Foo-Bar-0.01.tar.gz.packed
+
+Created at Tue Oct 9 17:23:14 2007
+#########################################################################
+__UU__
+M'XL("/8X34("`T9O;RU"87(M,"XP,2YT87(`[9KQ;]I&%,?Y^?Z*1YE$(A5C
+M8YM(SE*-K69!*LD4Z%:IJZ(#'V!A^[SSN2F:]K_O#ML,6)ONAP+M\CY*XMCW
+MS/EX]WWWGNT^YZT?J6B9AFFU:X?!5%RXKMY:%ZZUO:VH66:G8W=LQ^YV:Z;5
+M<1VS!F[M".29I`*@MJ0)>\SN<^W50*KM-T)_V_\_7?=N?O9'A_"_XSB?]G_'
+M*?VO)L"%]K_M=MP:F.C_@S,`&@.%TO,P"R-&:LB384?_P][-H.^/Q@?0?_<1
+M_7?L_?BO_CJH_V-0"I_<^;V70Y\,Z9+I&&#\\HI4LX%(EDDCC4@43MIJOK35
+M?#'2F$S"I#WC?*+W(C+TQSUC%4?P.88\R",&,9.T%5!)X8P&`0M@L@+=N_X5
+MYQB#3J+_TH='UK_C=O;T[Z@4$/5_#!JPD#+UVNUX+<O6)`^CP,AX+J9LQL6<
+M&0F3ZXG1RE(V-18RCDCC30&,%V$&ZH="*KCD<I6R>KT.,)#P$$813!<TF3,(
+M$Y`+!K-<YF)ML#Z[01(:,V\3&,JI2-XSD84\*1OTQ*P.W<\$CSW8BT-AHEP8
+M14$H,G5.%DI&!/LC#P7+/$*",),BG.12GZ\OT(-BJ&3.$B:H9,']9.6!_T&^
+MEF&4>=XF"D'9+72-CDN>@/[+0'_T_+]K[>7_CNE<H/Z/HO]Z.\]$6Z_E*1,1
+M(:D($PG/+,.P?D^>75;[?`G%/BZ9_U_]Z\#Z5=S_L6VSB_=_3N)_O;">W/^.
+M:5OH_Y/YOTBLCK7^:]?OK?^NB?7_<2!7"T8#"VYZJOHG(QJGJC9OZ5P<5&T/
+M67%`_4LJR][K\?7MW<9V2!/XOC#[@7U8;XTICU]L[&_'U[XRKW+I*$Q8IBN"
+ME`>0+7@>J=)?E0CSA`L6>.2[7_V[T>#V!JZ@F7`)?.G!7&VK\W4)H,^M-R]5
+M%]-<JI2%3I=4E1GJHCU/S5W5T(!_]:<N*F:)S#[6:0/^4[?E1ZR[;JB2IBA^
+M=&FSW1L\L*9@$'&^#).Y^N[$SJC.FEIKS?.WYKM+@,;6Y;#W-&H&A/Q)]/$'
+M5C7Q)%J!5!5)446I.D?N=CCC>:)&`:K/*8V(+IL^-9Z,37D2[`\K8'I,?Q%B
+M88+WA/,_705\)?F?A<__3N/_S1W=+^M_]S'_.^[^^F]9^/SOI/5_,0U4O8]+
+MPM.)_UM/?[YT_'],_QW7WK__YUHVZO\XPV<?N_6M=/^;""6K9L39.JG41<+V
+MH[RK%]"LDN[F\[5)F7;>]^]NAY7);EE9&OIO_/O^X)4_^N>SWC9W%J#FN^>Z
+M@9Q?K@TP"AU<_\5#X(/D?X^__[.O?]NQ+-3_,2C?_RD\CZ__(`B"(`B"(`B"
+?(`B"(`B"(`B"(`B"(`B"(`B"(,@WP=^)5B"Y`%``````
--- /dev/null
+#########################################################################
+This is a binary file that was packed with the 'uupacktool.pl' which
+is included in the Perl distribution.
+
+To unpack this file use the following command:
+
+ uupacktool.pl -u lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/perl5.005_03.tar.gz.packed lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/perl5.005_03.tar.gz
+
+To recreate it use the following command:
+
+ uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/perl5.005_03.tar.gz lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/perl5.005_03.tar.gz.packed
+
+Created at Tue Oct 9 17:23:14 2007
+#########################################################################
+__UU__
+M'XL(`'3DO44``^W/,0J`,`Q`T1RE)Y"T-O4XXN"DB%2]OR(*NNC4[;_E#\F0
+MS'T>K5*U5FLI1`\IQK--LE<OXM6LJ5/P,8CZ8$'%::F#GK9E[;)S,G13_[7W
+=-[\?N0L`````````````````0$$[-9`]0P`H````
--- /dev/null
+0&&<<''; # this PGP-signed message is also valid perl
+-----BEGIN PGP SIGNED MESSAGE-----
+Hash: SHA1
+
+# CHECKSUMS file written on Tue Jun 15 02:56:25 2004 by CPAN::Checksums (v1.016)
+$cksum = {
+ 'Foo-Bar-0.01.tar.gz' => {
+ 'mtime' => '1999-05-13',
+ 'md5' => 'c7691a12e5faa70b3a0e83402d279bd6',
+ 'size' => 1589
+ },
+};
+__END__
+-----BEGIN PGP SIGNATURE-----
+Version: GnuPG v1.2.3 (GNU/Linux)
+
+iD8DBQFAzmVZMo2oZ0UPiewRAv5MAJ9tajbtrg14echRtn4t940v7FpMfgCffvU1
+mAcaUP8yzmIvbpdn1cGUgpw=
+=rrmL
+-----END PGP SIGNATURE-----
--- /dev/null
+#########################################################################
+This is a binary file that was packed with the 'uupacktool.pl' which
+is included in the Perl distribution.
+
+To unpack this file use the following command:
+
+ uupacktool.pl -u lib/CPANPLUS/t/dummy-CPAN/authors/id/EUXS/Foo-Bar-0.01.tar.gz.packed lib/CPANPLUS/t/dummy-CPAN/authors/id/EUXS/Foo-Bar-0.01.tar.gz
+
+To recreate it use the following command:
+
+ uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/authors/id/EUXS/Foo-Bar-0.01.tar.gz lib/CPANPLUS/t/dummy-CPAN/authors/id/EUXS/Foo-Bar-0.01.tar.gz.packed
+
+Created at Tue Oct 9 17:23:14 2007
+#########################################################################
+__UU__
+M'XL("`DY34("`T9O;RU"87(M,"XP,2YT87(`[5IK3]M(%,U7YE=<H%5``A.;
+M/*0@5@0P-"IY*`E=JFX53>))8F%[4L\8B%#_^][Q(P^VI5\VZ78[1P0G]IWG
+MO>?,^-I7G!^>T_"P8!3,H]QZ4$!42B5U-"LE<_F8(6<6+.O8.BX633QO6B6K
+MDH-2;@.(A*0A0.Z>!NPUNQ]=SP:2'7\17"W[_^)=K7EM=]?A_V*Q^'W_6\74
+M_Q@`E3+Z_[ADE7)0T/Y?.^I`?:"0>AY&KL=(3N.WP0K_&[5F_<KN]C:L_Q:*
+M_:K^'Y?+1<W_32`E/NG8M<N&3;(((`UZSY08&.T;@O%A3/WX\"2(9$(:4X\,
+MW.!HQ/E`7?1(P^[5C)GOP8_0X$[D,?"9I(<.E13VJ.,P!P8S4&VJ3[BO)>CG
+M\#]UXAKX7WYE_2\6K27^%Q3_*Y6*YO\FL`L3*:?5HR,_YN7A('(]QQ`\"H=L
+MQ,,Q,P(FX\`X%%,V-";2]\CN70+H35P!^$=A&G+)Y6S*MK>W`>H2'EW/@^&$
+M!F,&;@!RPF`4R2B,#>+2NR2@/JO.E2$-1?+`0N'R(+V@`C,[U1^%W*]"JD=N
+M@*[S/,<-!=H*5S(2LB^1&S)1)<1QA0S=0215.=6Q*B1#)&,6L)!*YO0'LRK8
+M3_)6NIZH5N?R`VES4#:L$OF-^)]*^SKV_Z77[O\JA1?[_V*A9&G^;P+G]G6]
+M"<_(7S>0L&,:AOE7L`-?3T@DF*)DM8KA<4+2Z_P>U/43O4#_'_FOMG3_B?S/
+ML571^9^?X__YEGZ#^E\LO=#_DFGJ_,]F]G_;1Y$(8\]/6>B13.B3,$"A)Z86
+M^]]%_Y,[_+7H_VO\MY#S+_*_9:NL^;\1_KO!T(L<!COV7<_N-(W)#EF<4Y*P
+M>N:N>WNNSI!&Z_+VQH;3^1YQ:ZM=NWA?NUX]1_`V31)7]-D#"_;<8!K)?;*E
+M)$8A_DW4MXO6I5TE6QV[]Z%V@S4DIO`6+#@]A<+^26S5NNVU;WMS.RU,_S[_
+MI_ZF^6]9Q<H_^&\6-/\W@2D=WM/Q\IV>NN]3J9.AQ,4_3:B`_33EH61X.3MS
+M.0OH#:<.2XL\T%#`E\<].*MW:_#6OFNW.KU^KW;=A;/T1^M]]A7>?+`[W7JK
+M"4AL$I<X586S9I9J5P:[4)?,%R`YL-@"A0._#ZGG,6Q5I9$$#H2I)++#1C3R
+MI`%-+ED5'`X!EVDQK"BV7;*#1U=.."H-55F?&8PY=R!D5/#`@%L<UZ+O*M_$
+MJ&-@+9=)K<+UI]XLZQ/V!F8\"F$:#3QW"*,H&*KLDSCR&;;AB*,A5RFK0`I#
+MC2E.GF$A_BBP-T./AE29;ZG9O.OVF)"0K^+U_(F:@)&J.QM.P)@#$LL?@,\?
+MW&"L?@1CK`==,Y38IWB"LMGFX9(/L+(X-R?H@TK#^SR<&63%7ZB^D%<-P^D?
+M\$GYA6R1??B<.&LQ(<KN[!G>+)5]CLM]A:_+MHEO51TG9.[X4\@KS<'!D0'G
+M$B..3N=1.(^/V/GMD'DJ%AQ()Q*]!!,6,B/>G?;[=O.RWT?#<[1[5/E((:,!
+MSM4P\ED@XUF%$4Y"[)TD"VC`1YS.`9,JVICC8DC);4).)^AA$YJUADU(ZH1#
+M:.,RB%Z6+!!950./3A;_Y@6['YNM=K?>);A<+?RH%J_O%+BTNQ>=>KN'8R6D
+M^^UN)Y4<P!#C4B:/2B;6DS!4FM7C_%Z`Y]XSE6(E-,()"H&/XH3KHLN/%&G"
+MQIX[QIJ!!3P:3Q2=/*:B0-FJ*2-1H*:"88R3\Y7^&FF'K90/A#1YL,(W,A]2
+M[;;WKM4AI(8$,C#*>7@`U(@,U;,S:HRI1Y]FQ@C7&O6ACW2VF#[;AMI-MX6W
+M(3CE>^:^:G>(6P2]4&]B_5]ZZ+?1_7_Y^&7^MV3JY[^YS0R??>L1".KNGR$J
+M0181>_'V.Z]T,;]XEHO+0SZ3[/Q!8I(*=_^JTVKD$Y-D6YD_@%T8N0'*=Z;N
+M<0G[SNY?U6_L[J+23_F53%3^\T'6HEI"-&G7Q?_D)8"U[/]??__K)?^/51I8
+M\W\#2-__2CRO7__2T-#0T-#0T-#0T-#0T-#0T-#0T-#0T-#0T-#0T-#0T-#0
+.T-#X9?`W%LHWQP!0````
--- /dev/null
+0&&<<''; # this PGP-signed message is also valid perl
+-----BEGIN PGP SIGNED MESSAGE-----
+Hash: SHA1
+
+# CHECKSUMS file written on Tue Jun 15 02:56:25 2004 by CPAN::Checksums (v1.016)
+$cksum = {
+ 'Foo-Bar-0.01.tar.gz' => {
+ 'mtime' => '1999-05-13',
+ 'md5' => '1f52c2e83140814f734c8674e8fae53f',
+ 'size' => 867
+ },
+};
+__END__
+-----BEGIN PGP SIGNATURE-----
+Version: GnuPG v1.2.3 (GNU/Linux)
+
+iD8DBQFAzmVZMo2oZ0UPiewRAv5MAJ9tajbtrg14echRtn4t940v7FpMfgCffvU1
+mAcaUP8yzmIvbpdn1cGUgpw=
+=rrmL
+-----END PGP SIGNATURE-----
--- /dev/null
+#########################################################################
+This is a binary file that was packed with the 'uupacktool.pl' which
+is included in the Perl distribution.
+
+To unpack this file use the following command:
+
+ uupacktool.pl -u lib/CPANPLUS/t/dummy-CPAN/authors/id/MBNOXS/Foo-Bar-0.01.tar.gz.packed lib/CPANPLUS/t/dummy-CPAN/authors/id/MBNOXS/Foo-Bar-0.01.tar.gz
+
+To recreate it use the following command:
+
+ uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/authors/id/MBNOXS/Foo-Bar-0.01.tar.gz lib/CPANPLUS/t/dummy-CPAN/authors/id/MBNOXS/Foo-Bar-0.01.tar.gz.packed
+
+Created at Tue Oct 9 17:23:14 2007
+#########################################################################
+__UU__
+M'XL("-<X34(``T9O;RU"87(M,"XP,2YT87(`[9E;;]HP%,=Y]J<X+9722@-R
+M!0G6:G2#M=)*I]+MI:M0((9&)#;*I5TU[;O/)J1JH!WK%-)U/;\7XTOXVSD^
+M]G'<Y;QR:`<5M:IJM=)F4`4-RY*IUK"T^VE*25-UW=`-T]`;)573+<,J@;6A
+M_F2(P\@.`$I3F]'?M5M7GPXD35\(W?OV?W_4[GWL]//6D.^C;IJ/VU\WE^QO
+M6*(("GF)K]S^QV#[8,/"\C!V/4J>NT](<63\_Z3=.^YV^N<Y:ZSS?TVM+_M_
+MO6Z@_Q?!PO')6:?]X:1##F/7<ZJ?/Y%T*I"(AE%UYA'/'=;$9*F)R5*=^63H
+MLMJ8\Z',>;ABO%@R_K^P==X::_?_NK;D_Z9JUM'_BZ"\58O#H";=>48#CY!9
+MX+((MK5J5?O&MEMIGD\AR3]WAY%<R?B_7.,WH/'T\Y]AJ`:>_XI@Q?YRC\]9
+MX^GV-U6]CO8O@@?MG\1XN6FLV?^EZ9?L;ZD8_Q<#V;^BMJ-!KRVB?]*W_9E'
+MH0)B%H`([R%,"L1/DK9L?SD_.CV[:WMB,WB;-'M'O\_3ZHC[!W?M3\^/.J+Y
+M-0U"ES/P7$9#<!G,N`/A%8\]!X84W`GC`76:9.=KYZQ_?-J#?5`8CX!/FS`1
+M:?K\.."^?'9+:0F)41R)D,4>3>T)E9UN-L7<%15E6-$3G?(IB\*'1,OP1[*+
+MOYA+ER&Z<L4?AR*E&36XH4I`P>-\ZK*)>'=!9E2[BO0U9>]"O6P!E.]UAU[;
+MGN(0\H/(\AN:5G'FW4)D3^E<:NP&8905'/.8B5&`T!S9GDCAT?&$=,29LSPL
+MA\HQ_21$PP#O=9%9_^4I8`,:?Q7_X??_0EBQ_]U'G?PTUI[_36MY_]<T#??_
+M(GCL_)],`W'>QRWAOR;C_^G7WYPUUOF_;C16SG\&QO^%$(<BA.=.[%$1.DOS
+MMX`0_Q9VAC(CHD=&;[(-1'BY*T-,?UXX8+9/8?\`E#3Z5M[(VG`4N+-H(.\3
+M0UE]`4IF=U'@4K;;:Y%$J7(P"J@=T<$\-T@>QY5GXV3\/[D$REUC[?ZO&\OQ
+MGZFIZ/]%L+C_3RR/U_\(@B`(@B`(@B`(@B`(@B`(@B`(@B`(@B`(@B`(@B`(
+,\D_S"QCQWFL`4```
--- /dev/null
+0&&<<''; # this PGP-signed message is also valid perl
+-----BEGIN PGP SIGNED MESSAGE-----
+Hash: SHA1
+
+# CHECKSUMS file written on Tue Jun 15 02:56:25 2004 by CPAN::Checksums (v1.016)
+$cksum = {
+ 'Foo-Bar-0.01.tar.gz' => {
+ 'mtime' => '1999-05-13',
+ 'md5' => '986e4316ac095d8a4d47d0d0dd2c408a',
+ 'size' => 1541
+ },
+};
+__END__
+-----BEGIN PGP SIGNATURE-----
+Version: GnuPG v1.2.3 (GNU/Linux)
+
+iD8DBQFAzmVZMo2oZ0UPiewRAv5MAJ9tajbtrg14echRtn4t940v7FpMfgCffvU1
+mAcaUP8yzmIvbpdn1cGUgpw=
+=rrmL
+-----END PGP SIGNATURE-----
--- /dev/null
+#########################################################################
+This is a binary file that was packed with the 'uupacktool.pl' which
+is included in the Perl distribution.
+
+To unpack this file use the following command:
+
+ uupacktool.pl -u lib/CPANPLUS/t/dummy-CPAN/authors/id/MBXS/Foo-Bar-0.01.tar.gz.packed lib/CPANPLUS/t/dummy-CPAN/authors/id/MBXS/Foo-Bar-0.01.tar.gz
+
+To recreate it use the following command:
+
+ uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/authors/id/MBXS/Foo-Bar-0.01.tar.gz lib/CPANPLUS/t/dummy-CPAN/authors/id/MBXS/Foo-Bar-0.01.tar.gz.packed
+
+Created at Tue Oct 9 17:23:15 2007
+#########################################################################
+__UU__
+M'XL("-\X34(``T9O;RU"87(M,"XP,2YT87(`[5K_3QI)%/=7YZ]XU39H(BN[
+M@%PP-*)N+:D"$6QL[AHRP``;EQVZ.RN2IO][WV,79+4]KG>(UW8^B<+NO)GW
+MYGV;F3>\D3)]S/UTQLB8^QM/@PRBD,_3IUG(FXN?,VR8&<O*6ME<-EO8R)A6
+M/GNP`?DGDB>!,%#<!]BXX9[X.[IE[;.)S#Y_$KQ9M/_)VW+US&ZLF@?IXR"7
+M^[[]K=P#^V?S5GX#UJ+$W]S^%>!#X!!;'GJ.*]ASRZ2Q/B3B_Z)<K;RQ&\T5
+M\U@6_R8F^P?Q?W!0T/&_#K0=;[\G99O[QLAEQZ'C=HWZ.8OS`7.=]CZZR/XQ
+MM0\3CW<!F_D+N[3+IQ<V4R)0-,R%W2P;DZ&K,\G_'HGX)_,^`8\?W_]ELYF<
+MWO^M`X_L3^&]8AX_;O]<QBIH^Z\#W[1_E-Y7QF/9^F\5'J[_>=/,Z?5_'=AV
+MO(X;=@5LV==-^[)J#+;8_;N1\-WDF^O&U3&]81>UTZMS&TJ`#E,LHL=L;M;+
+M)^_*9\EWC#F>8D[0$K?"VW&\4:AVV2:^`\+TF=&WD]JI762;EW;S??D<1XA(
+MX1584"I!9O=P2E6[:M:OFG,ZO;_XS_AN_(^&*^.Q)/XM*U=X&/\93`DZ_M>`
+M$>_<\+Z81^PA"P,!@?*=CCIDS!>?0L<78-^-I*\$-L_>G$X\?BYY5\1=;KD?
+MP*?Q#AQ5&F5X95_7:Y?-5K-\UH"C^*'V;O857KZW+QN56A4PL-FT1XDZS]@L
+MC$X$VU!18AB`DB"F%)@X\'N'NZY`KAX?B@`G(J`]@:[H\=!5!E2E$D7H2O"D
+MBKOA0%/:!3H8.VH@,=-PN!7^!/I2=L$7/)">`5<XKWO9'2]0@G<-'.4T&C5P
+MAB-W,I,)I8&)#'T8A6W7Z4`O]#K*D5ZP/Q3(HQOL=_!!<4\%!LVI.7`"ZB3'
+M`4K3<;G/B7R3M'G=:.)9"E)%;$\=D@)Z-/9L.IX075#8?P^&\M;Q^O3@]7$<
+M-$U'H4Q3!<VT+?T%&^!@8P=%#?BM@*$82G]BL(2],/M"BAA#Z37\279AFVP7
+M/D;&NE<(T1U]AI<+?3]/^WV!+XNTD6UIC$,V-WP)4I1S<'*L+:5"C^.CN1?.
+M_6-J_+HO7/*%+L2*1"O!0/@"U6@>LE;+KIZV6DAXC'1C0*T&*FRCKCKA4'AJ
+MJE7HH1*FUAG*;N@*`SZ@.MM"D;>)KH,NI5XP5AJ@A4VHEO$TRV(CI*&.RR!:
+M60DOF`W5=OG@_M^\8^-#M59O5!H,EZM[.]+B]9T.IW;CY+)2;^)<&6M\6^QH
+MD#WHH%\JU`)Z[\"Z"PR,"G"EO`G`=6X$NH!@/$0%^2![]+0@\IACF(B^Z_1Q
+M9!">#/L#"B=7D!<0+:F,A1ZI0J"/L^.$O$8LL!7'`V-5Z27BC<VG5+YJOJU=
+M,E;&`#+0RZ6_!]P(#9+LB!M][O*[B='#-8;^^)A/[M5GVU`^;]08HYW'CKE+
+M?#NX17CN-/G+(EG_B^LV*^:Q;/^?S68?G?\R>OU?"]+I-&Q_*%^<%TTCPVAU
+M+$+L$PP71$H>12#GB%-+$5-9&GX@M'F;4GM'%?]!%L55$QM1@M"[\>388YBM
+MA$\YK]6>%.%BFKEQ@:`J)<32H7#60>8/<V^^DM-LJ%CYW*K]*9"(_[A^NVH>
+MR^(_4WA<_\GI^O]:<&R?5:KP&48^G<FW3,,P__*VX$NTJ;\_%<3M\@:H_5`'
+MUR^"1/S39=`3\/A7]7_]^X^UX)']YY>!J^.Q-/_G\H_KOY;._^O`]HO],/"G
+MEJ<C%YLE^L@-,-'3"?NYA=1X,B3B/[K&7SF/I?%O/3S_97.FJ>-_'8A__Q59
+M7O_\Z[=#(OYG/_]9,8]E\6_EOG'_K^L_:P&=\A)U%5SQAQ-XV9[66$K@B?&#
+MN@L#V*'+V*B.WJ*2$=T3I&9GQ=0>M08=WQFI%B64(+I&2"5VERGX2'1T2Q#Q
+M2K^.RMNMZ5,KZJ^W'AH:&AH:&AH:&AH:&AH:&AH:&AH:&AH:&AH:&AH:&AH:
++R_`55?+KB0!0````
uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/modules/02packages.details.txt.gz lib/CPANPLUS/t/dummy-CPAN/modules/02packages.details.txt.gz.packed
-Created at Wed Aug 15 16:13:41 2007
+Created at Tue Oct 9 17:23:15 2007
#########################################################################
__UU__
-M'XL("-%#OT4``S`R<&%C:V%G97,N9&5T86EL<RYT>'0`E=-1:]LP$`#@=_^*
-M>]C#!K&D.IB"GAJGR=B6=&5M:-^&:ET3,5LRTKE>]NLG-2TM(6FWX\!@WWVZ
-M`WEN&I3P'*+H5/U+K3$PC:1,$QC]IFSU8_%2`QNB3G(^#`/KT#>L=BV?7DXN
-M>.MTWV#@1Y1S#+4W'1EGHW:Y*P&K6@QP[WJKP5C0QF--SF_APZ.I>MHX'[C1
-M/)NZIF]M>!JE>P6,X`%]B/`HOJ9-]L426HTZGSLO8=*3:Q6AAGND>@/>]60L
-MAM'N\`@A:%?W+5I2:3R6W7A#D<BK;3JM;;0)-*C4_/$!"C86Q2>XV\+$:H\J
-ML&\.K5F?*6M:%7?.%I'/IW$G2NTGXK0LLX4*E*\ZG0:1<(-Z!&,!7Y6%0H@"
-M1"F+F*?P>7F=97/GI*R4EW*VDO+V"O9",'&2GC,^6\6\O>*Q(X\->?K"2'FV
-M_O-*659O*4N^K&+^DW+Q?=_94U+!.T[:Z;CSM-.[SOXV_^M4\<K%RR^/>8><
-B74]^B)L.^MA$CU$<X-+_4S(ARI]B_.QD?P$Z!("8DP,`````
+M'XL("%^M`T<``S`R<&%C:V%G97,N9&5T86EL<RYT>'0`E=-1:]LP$`?P=WV*
+M>]C#"K&L.IB"GA9GR=B6=&6=:=^*9ET345LRTKE>]NDG-2OMPK)VA\$@GW[Z
+M'\A+TZ*$QQ)%KYH[M<'`-9(R;>#T@UC]=?74`UNB7N;Y.(Z\1]_RQG7Y_&)V
+MGG=.#RV&_(CR'D/C34_&V:A=[%O`J@X#W+K!:C`6M/'8D/,[>/-@JH&VSH?<
+MZ)S-73MT-OR.TC\#)G"//D1X$I=IRSY:0JM19TOG)<P&<ITBU'"+U&S!NX&,
+MQ3#9'QXA!.V:H4-+*L7C[,H;BD16[=)I7:M-H%&ES6_OH>!349S`]QW,K/:H
+M`O_LT)K-.V5-I^+,;!7Y;!YGHK3]5)R5)5NI0%G=ZQ1$PA7J"4P%?%(6"B$*
+M$*4LXG,&'];?&%LZ)V6EO)2+6LKK2S@HP<5I>B_JZ\L\-F>Q-TN+G)3GFY_/
+M@'7U+V!=O0HX_W)(/`'IVPM$&N(XL:A?)`[C_P=1Q9L5[[@\1AT0^_;L;])\
+<U,=R/%3QIY1^CI(+4=Z(Z2/!?@$#U+EW<`,`````
uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/modules/03modlist.data.gz lib/CPANPLUS/t/dummy-CPAN/modules/03modlist.data.gz.packed
-Created at Wed Aug 15 16:13:41 2007
+Created at Tue Oct 9 17:23:15 2007
#########################################################################
__UU__
M'XL("#'FO$4``S`S;6]D;&ES="YD871A`%U3_6O;,!#].?HKCBXC"20A=<@&
+### On VMS, the ENV is not reset after the program terminates.
+### So reset it here explicitly
+my ($old_env_path, $old_env_perl5lib);
BEGIN {
use FindBin;
use File::Spec;
use Config;
### and add them to the environment, so shellouts get them
- $ENV{'PERL5LIB'} = join ':',
+ $old_env_perl5lib = $ENV{'PERL5LIB'};
+ $ENV{'PERL5LIB'} = join ':',
grep { defined } $ENV{'PERL5LIB'}, @paths, @rel2abs;
### add our own path to the front of $ENV{PATH}, so that cpanp-run-perl
### and friends get picked up
- $ENV{'PATH'} = join $Config{'path_sep'},
+ $old_env_path = $ENV{PATH};
+ $ENV{'PATH'} = join $Config{'path_sep'},
grep { defined } "$FindBin::Bin/../bin", $ENV{'PATH'};
### Fix up the path to perl, as we're about to chdir
$IPC::Cmd::USE_IPC_RUN = 0 if $^O eq 'MSWin32';
}
+### Use a $^O comparison, as depending on module at this time
+### may cause weird errors/warnings
+END {
+ if ($^O eq 'VMS') {
+ ### VMS environment variables modified by this test need to be put back
+ ### path is "magic" on VMS, we can not tell if it really existed before
+ ### this was run, because VMS will magically pretend that a PATH
+ ### environment variable exists set to the current working directory
+ $ENV{PATH} = $old_path;
+
+ if (defined $old_perl5lib) {
+ $ENV{PERL5LIB} = $old_perl5lib;
+ } else {
+ delete $ENV{PERL5LIB};
+ }
+ }
+}
+
use strict;
use CPANPLUS::Configure;
use CPANPLUS::Error ();
$Locale::Maketext::Lexicon::VERSION = 0;
}
+my $Env = 'PERL5_CPANPLUS_TEST_VERBOSE';
+
# prereq has to be in our package file && core!
use constant TEST_CONF_PREREQ => 'Cwd';
use constant TEST_CONF_MODULE => 'Foo::Bar::EU::NOXS';
+use constant TEST_CONF_AUTHOR => 'EUNOXS';
use constant TEST_CONF_INST_MODULE => 'Foo::Bar';
use constant TEST_CONF_INVALID_MODULE => 'fnurk';
use constant TEST_CONF_MIRROR_DIR => 'dummy-localmirror';
+use constant TEST_CONF_CPAN_DIR => 'dummy-CPAN';
### we might need this Some Day when we're installing into
### our own sandbox. see t/20.t for details
### for our test suite. Bug [perl #43629] showed this.
my $conf = CPANPLUS::Configure->new( load_configs => 0 );
$conf->set_conf( hosts => [ {
- path => 'dummy-CPAN',
+ path => File::Spec->rel2abs(TEST_CONF_CPAN_DIR),
scheme => 'file',
} ],
);
$conf->set_conf( base => 'dummy-cpanplus' );
$conf->set_conf( dist_type => '' );
$conf->set_conf( signature => 0 );
+ $conf->set_conf( verbose => 1 ) if $ENV{ $Env };
+
+ ### never use a pager in the test suite
+ $conf->set_program( pager => '' );
### dmq tells us that we should run with /nologo
### if using nmake, as it's very noise otherwise.
sub output_file { return $file }
- my $env = 'PERL5_CPANPLUS_TEST_VERBOSE';
+
### redirect output from msg() and error() output to file
- unless( $ENV{$env} ) {
+ unless( $ENV{$Env} ) {
print "# To run tests in verbose mode, set ".
- "\$ENV{PERL5_CPANPLUS_TEST_VERBOSE} = 1\n" unless $ENV{PERL_CORE};
+ "\$ENV{$Env} = 1\n" unless $ENV{PERL_CORE};
- unlink $file; # just in case
+ 1 while unlink $file; # just in case
$CPANPLUS::Error::ERROR_FH =
$CPANPLUS::Error::ERROR_FH = output_handle();
}
}
-
-
### whenever we start a new script, we want to clean out our
### old files from the test '.cpanplus' dir..
sub _clean_test_dir {
my $path = File::Spec->catfile( $dir, $file );
+ ### John Malmberg reports yet another VMS issue:
+ ### A directory name on VMS in VMS format ends with .dir
+ ### when it is referenced as a file.
+ ### In UNIX format traditionally PERL on VMS does not remove the
+ ### '.dir', however the VMS C library conversion routines do remove
+ ### the '.dir' and the VMS C library routines can not handle the
+ ### '.dir' being present on UNIX format filenames.
+ ### So code doing the fixup has on VMS has to be able to handle both
+ ### UNIX format names and VMS format names.
+ ### XXX See http://www.xray.mpe.mpg.de/
+ ### mailing-lists/perl5-porters/2007-10/msg00064.html
+ ### for details -- the below regex could use some touchups
+ ### according to John. M.
+ $file =~ s/\.dir//i if $^O eq 'VMS';
+
+ my $dirpath = File::Spec->catdir( $dir, $file );
+
### directory, rmtree it
if( -d $path ) {
print "# Deleting directory '$path'\n" if $verbose;
projects / p5sagit/p5-mst-13.2.git / commitdiff