diff options
| author | Todd C. Miller <millert@cvs.openbsd.org> | 2010-09-24 14:49:07 +0000 |
|---|---|---|
| committer | Todd C. Miller <millert@cvs.openbsd.org> | 2010-09-24 14:49:07 +0000 |
| commit | 38b9480a88793314fc621bfec3da592ab7cc1b67 (patch) | |
| tree | 376a0f8b8ceb06f5a35dd4092e2142d144446f37 /gnu/usr.bin/perl/cpan/CPANPLUS | |
| parent | 9cbab6bbe32ea5284843bc86df049948f57cfeec (diff) | |
Perl 5.12.2 from CPAN
Diffstat (limited to 'gnu/usr.bin/perl/cpan/CPANPLUS')
32 files changed, 1110 insertions, 1265 deletions
diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/bin/cpan2dist b/gnu/usr.bin/perl/cpan/CPANPLUS/bin/cpan2dist index b4fadf552b9..5ba4556c529 100644 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/bin/cpan2dist +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/bin/cpan2dist @@ -40,7 +40,7 @@ GetOptions( $opts, 'default-ignorelist!', 'edit-metafile!', 'install!' ); - + die usage() if exists $opts->{'help'}; ### parse options @@ -49,14 +49,12 @@ my $keep = $opts->{'keepsource'} ? 1 : 0; my $prereqbuild = exists $opts->{'buildprereq'} ? $opts->{'buildprereq'} : 0; -my $timeout = exists $opts->{'timeout'} - ? $opts->{'timeout'} +my $timeout = exists $opts->{'timeout'} + ? $opts->{'timeout'} : 300; ### use default answers? -unless ( $ENV{'PERL_MM_USE_DEFAULT'} ) { - $ENV{'PERL_MM_USE_DEFAULT'} = $opts->{'defaults'} ? 1 : 0; -} +$ENV{'PERL_MM_USE_DEFAULT'} = $opts->{'defaults'} ? 1 : 0; my $format; ### if provided, we go with the command line option, fall back to conf setting @@ -64,7 +62,7 @@ my $format; $conf->set_conf( dist_type => $format ); ### is this a valid format?? - die loc("Invalid format: " . ($format || "[NONE]") ) . usage() + die loc("Invalid format: " . ($format || "[NONE]") ) . usage() unless $formats{$format}; ### any options to fix config entries @@ -72,14 +70,14 @@ my $format; while( my($key,$val) = each %$set_conf ) { $conf->set_conf( $key => $val ); } - } + } ### any options to fix program entries { my $set_prog = $opts->{'set-program'} || {}; while( my($key,$val) = each %$set_prog ) { $conf->set_program( $key => $val ); } - } + } ### any other options passed { my %map = ( verbose => 'verbose', @@ -87,54 +85,54 @@ my $format; skiptest => 'skiptest', makefile => 'prefer_makefile' ); - - ### set config options from arguments + + ### set config options from arguments while (my($key,$val) = each %map) { - my $bool = exists $opts->{$key} - ? $opts->{$key} + my $bool = exists $opts->{$key} + ? $opts->{$key} : $conf->get_conf($val); $conf->set_conf( $val => $bool ); - } - } + } + } } my @modules = @ARGV; if( exists $opts->{'modulelist'} ) { - push @modules, map { parse_file( $_ ) } @{ $opts->{'modulelist'} }; -} + push @modules, map { parse_file( $_ ) } @{ $opts->{'modulelist'} }; +} die usage() unless @modules; ### set up munge callback if requested { if( $opts->{'edit-metafile'} ) { my $editor = $conf->get_program('editor'); - + if( $editor ) { - + ### register install callback ### $cb->_register_callback( name => 'munge_dist_metafile', code => sub { my $self = shift; my $text = shift or return; - + my($fh,$file) = tempfile( UNLINK => 1 ); - + unless( print $fh $text ) { warn "Could not print metafile information: $!"; return; } - + close $fh; - + system( $editor => $file ); - + my $cont = $cb->_get_file_contents( file => $file ); - + return $cont; }, ); - + } else { warn "No editor configured. Can not edit metafiles!\n"; } @@ -144,13 +142,13 @@ die usage() unless @modules; my $fh; LOGFILE: { if( my $file = $opts->{logfile} ) { - open $fh, ">$file" or ( + open $fh, ">$file" or ( warn loc("Could not open '%1' for writing: %2", $file,$!), last LOGFILE - ); - + ); + warn "Logging to '$file'\n"; - + *STDERR = $fh; *STDOUT = $fh; } @@ -159,7 +157,7 @@ LOGFILE: { ### reload indices if so desired $cb->reload_indices() if $opts->{'flushcache'}; -{ my @ban = exists $opts->{'ban'} +{ my @ban = exists $opts->{'ban'} ? map { qr/$_/ } @{ $opts->{'ban'} } : (); @@ -167,54 +165,54 @@ $cb->reload_indices() if $opts->{'flushcache'}; if( exists $opts->{'banlist'} ) { push @ban, map { parse_file( $_, 1 ) } @{ $opts->{'banlist'} }; } - + push @ban, map { s/\s+//; $_ } map { [split /\s*#\s*/]->[0] } grep { /#/ } - map { split /\n/ } _default_ban_list() + map { split /\n/ } _default_ban_list() if $opts->{'default-banlist'}; - - ### use our prereq install callback + + ### use our prereq install callback $conf->set_conf( prereqs => PREREQ_ASK ); - + ### register install callback ### $cb->_register_callback( name => 'install_prerequisite', code => \&__ask_about_install, ); - + ### check for ban patterns when handling prereqs sub __ask_about_install { - + my $mod = shift or return; my $prereq = shift or return; - - + + ### die with an error object, so we can verify that ### the die came from this location, and that it's an ### 'acceptable' death my $pat = ban_me( $prereq ); die bless sub { loc("Module '%1' requires '%2' to be installed " . "but found in your ban list (%3) -- skipping", - $mod->module, $prereq->module, $pat ) + $mod->module, $prereq->module, $pat ) }, PREREQ_SKIP_CLASS if $pat; return 1; - } - + } + ### should we skip this module? sub ban_me { my $mod = shift; - + for my $pat ( @ban ) { return $pat if $mod->module =~ /$pat/i; } return; } -} +} ### patterns to strip from prereq lists -{ my @ignore = exists $opts->{'ignore'} +{ my @ignore = exists $opts->{'ignore'} ? map { qr/$_/ } @{ $opts->{'ignore'} } : (); @@ -225,10 +223,10 @@ $cb->reload_indices() if $opts->{'flushcache'}; push @ignore, map { s/\s+//; $_ } map { [split /\s*#\s*/]->[0] } grep { /#/ } - map { split /\n/ } _default_ignore_list() + map { split /\n/ } _default_ignore_list() if $opts->{'default-ignorelist'}; - + ### register install callback ### $cb->_register_callback( name => 'filter_prereqs', @@ -238,7 +236,7 @@ $cb->reload_indices() if $opts->{'flushcache'}; sub __filter_prereqs { my $cb = shift; my $href = shift; - + for my $name ( keys %$href ) { my $obj = $cb->parse_module( module => $name ) or ( warn "Cannot make a module object out of ". @@ -249,44 +247,44 @@ $cb->reload_indices() if $opts->{'flushcache'}; warn loc("'%1' found in your ignore list (%2) ". "-- filtering it out\n", $name, $pat); - delete $href->{ $name }; + delete $href->{ $name }; } } return $href; } - + ### should we skip this module? sub ignore_me { my $mod = shift; - + for my $pat ( @ignore ) { return $pat if $mod->module =~ /$pat/i; return $pat if $mod->package_name =~ /$pat/i; } return; - } -} + } +} my %done; for my $name (@modules) { my $obj; - + ### is it a tarball? then we get it locally and transform it ### and its dependencies into .debs if( $tarball ) { ### make sure we use an absolute path, so chdirs() dont ### mess things up - $name = File::Spec->rel2abs( $name ); + $name = File::Spec->rel2abs( $name ); ### ENOTARBALL? unless( -e $name ) { warn loc("Archive '$name' does not exist"); next; } - + $obj = CPANPLUS::Module::Fake->new( module => basename($name), path => dirname($name), @@ -303,7 +301,7 @@ for my $name (@modules) { ### set the location of the tarball $obj->status->fetch($name); - ### plain old cpan module? + ### plain old cpan module? } else { ### find the corresponding module object ### @@ -318,26 +316,26 @@ for my $name (@modules) { warn loc("'%1' found in your ban list (%2) -- skipping\n", $obj->module, $pat ); next; - } - - ### or just ignored it? + } + + ### or just ignored it? if( my $pat = ignore_me( $obj ) ) { warn loc("'%1' found in your ignore list (%2) -- skipping\n", $obj->module, $pat ); next; - } - + } + my $target = $opts->{'install'} ? 'install' : 'create'; - my $dist = eval { + my $dist = eval { local $SIG{ALRM} = sub { die bless {}, ALARM_CLASS } if $timeout; - + alarm $timeout || 0; my $dist_opts = $opts->{'dist-opts'} || {}; - my $rv = $obj->install( + my $rv = $obj->install( prereq_target => $target, target => $target, keep_source => $keep, @@ -346,32 +344,32 @@ for my $name (@modules) { ### any passed arbitrary options %$dist_opts, ); - - alarm 0; + + alarm 0; $rv; - }; - + }; + ### set here again, in case the install dies alarm 0; ### install failed due to a 'die' in our prereq skipper? if( $@ and ref $@ and $@->isa( PREREQ_SKIP_CLASS ) ) { - warn loc("Dist creation of '%1' skipped: '%2'", + warn loc("Dist creation of '%1' skipped: '%2'", $obj->module, $@->() ); next; } elsif ( $@ and ref $@ and $@->isa( ALARM_CLASS ) ) { warn loc("\nDist creation of '%1' skipped, build time exceeded: ". "%2 seconds\n", $obj->module, $timeout ); - next; + next; ### died for some other reason? just report and skip } elsif ( $@ ) { warn loc("Dist creation of '%1' failed: '%2'", $obj->module, $@ ); next; - } + } ### we didn't get a dist object back? unless ($dist and $obj->status->dist) { @@ -398,7 +396,7 @@ sub parse_file { s/^(\S+).*/$1/; # skip extra info push @rv, $qr ? qr/$_/ : $_; # add pattern to the list } - + return @rv; } @@ -430,11 +428,11 @@ sub usage { Usage: cpan2dist [--format FMT] [OPTS] Mod::Name [Mod::Name, ...] cpan2dist [--format FMT] [OPTS] --modulelist /tmp/mods.list - cpan2dist [--format FMT] [OPTS] --archive /tmp/dist [/tmp/dist2] + cpan2dist [--format FMT] [OPTS] --archive /tmp/dist [/tmp/dist2] Will create a distribution of type FMT of the modules specified on the command line, and all their prerequisites. - + Can also create a distribution of type FMT from a local archive and all of its prerequisites. @@ -446,21 +444,21 @@ $formats You can install more formats from CPAN! \n]; - + $usage .= << '=cut'; =pod - + Options: ### take no argument: --help Show this help message --install Install this package (and any prerequisites you built) - after building it. + after building it. --skiptest Skip tests. Can be negated using --noskiptest --force Force operation. Can be negated using --noforce --verbose Be verbose. Can be negated using --noverbose --keepsource Keep sources after building distribution. Can be - negated by --nokeepsource. May not be supported + negated by --nokeepsource. May not be supported by all formats --makefile Prefer Makefile.PL over Build.PL. Can be negated using --nomakefile. Defaults to your config setting @@ -484,7 +482,7 @@ Options: Are appended to the ban list built up by --ban May be given multiple times. --ignore Patterns of modules to exclude from prereq list. Useful - for when a prereq listed by a CPAN module is resolved + for when a prereq listed by a CPAN module is resolved in another way than from its corresponding CPAN package (Match is done on both module name, and package name of the package the module is in, case-insensitive) @@ -497,71 +495,71 @@ Options: --logfile File to log all output to. By default, all output goes to the console. --timeout The allowed time for buliding a distribution before - aborting. This is useful to terminate any build that - hang or happen to be interactive despite being told not - to be. Defaults to 300 seconds. To turn off, you can + aborting. This is useful to terminate any build that + hang or happen to be interactive despite being told not + to be. Defaults to 300 seconds. To turn off, you can set it to 0. --set-config Change any options as specified in your config for this - invocation only. See CPANPLUS::Config for a list of + invocation only. See CPANPLUS::Config for a list of supported options. --set-program Change any programs as specified in your config for this - invocation only. See CPANPLUS::Config for a list of + invocation only. See CPANPLUS::Config for a list of supported programs. --dist-opts Arbitrary options passed along to the chosen installer format's prepare()/create() routine. Please see the - documentation of the installer of your choice for + documentation of the installer of your choice for options it accepts. ### builtin lists --default-banlist Use our builtin banlist. Works just like --ban and --banlist, but with pre-set lists. See the "Builtin Lists" section for details. - --default-ignorelist Use our builtin ignorelist. Works just like - --ignore and --ignorelist but with pre-set lists. + --default-ignorelist Use our builtin ignorelist. Works just like + --ignore and --ignorelist but with pre-set lists. See the "Builtin Lists" section for details. Examples: - ### build a debian package of DBI and its prerequisites, + ### build a debian package of DBI and its prerequisites, ### don't bother running tests cpan2dist --format CPANPLUS::Dist::Deb --buildprereq --skiptest DBI - + ### build a debian package of DBI and its prerequisites and install them cpan2dist --format CPANPLUS::Dist::Deb --buildprereq --install DBI - - ### Build a package, whose format is determined by your config, of + + ### Build a package, whose format is determined by your config, of ### the local tarball, reloading cpanplus' indices first and using ### the tarballs Makefile.PL if it has one. cpan2dist --makefile --flushcache --archive /path/to/Cwd-1.0.tgz - + ### build a package from Net::FTP, but dont build any packages or - ### dependencies whose name match 'Foo', 'Bar' or any of the + ### dependencies whose name match 'Foo', 'Bar' or any of the ### patterns mentioned in /tmp/ban cpan2dist --ban Foo --ban Bar --banlist /tmp/ban Net::FTP - + ### build a package from Net::FTP, but ignore its listed dependency ### on IO::Socket, as it's shipped per default with the OS we're on cpan2dist --ignore IO::Socket Net::FTP - + ### building all modules listed, plus their prerequisites - cpan2dist --ignorelist /tmp/modules.ignore --banlist /tmp/modules.ban - --modulelist /tmp/modules.list --buildprereq --flushcache + cpan2dist --ignorelist /tmp/modules.ignore --banlist /tmp/modules.ban + --modulelist /tmp/modules.list --buildprereq --flushcache --makefile --defaults - + ### pass arbitrary options to the format's prepare()/create() routine cpan2dist --dist-opts deb_version=3 --dist-opts prefix=corp =cut - + $usage .= qq[ Builtin Lists: Ignore list:] . _default_ignore_list() . qq[ Ban list:] . _default_ban_list(); - + ### strip the pod directives $usage =~ s/=pod\n//g; - + return $usage; } @@ -581,10 +579,10 @@ if you like, or supply your own if need be. =head2 Built-In Ignore List -=pod +=pod You can use this list of regexes to ignore modules matching -to be listed as prerequisites of a package. Particularly useful +to be listed as prerequisites of a package. Particulaly useful if they are bundled with core-perl anyway and they have known issues building. @@ -601,9 +599,9 @@ sub _default_ignore_list { ^Cwd$ # Provided with core anyway ^File::Spec # Provided with core anyway ^Config$ # Perl's own config, not shipped separately - ^ExtUtils::MakeMaker$ # Shipped with perl, recent versions + ^ExtUtils::MakeMaker$ # Shipped with perl, recent versions # have bug 14721 (see rt.cpan.org) - ^ExtUtils::Install$ # Part of of EU::MM, same reason + ^ExtUtils::Install$ # Part of of EU::MM, same reason =cut @@ -626,7 +624,7 @@ sub _default_ban_list { ^GD$ # Needs c libaries ^Berk.*DB # DB packages require specific options & linking - ^DBD:: # DBD drivers require database files/headers + ^DBD:: # DBD drives require database files/headers ^XML:: # XML modules usually require expat libraries Apache # These usually require apache libraries SSL # These usually require SSL certificates & libs @@ -657,10 +655,10 @@ This module by Jos Boumans E<lt>kane@cpan.orgE<gt>. =head1 COPYRIGHT -The CPAN++ interface (of which this module is a part of) is copyright (c) +The CPAN++ interface (of which this module is a part of) is copyright (c) 2001 - 2007, Jos Boumans E<lt>kane@cpan.orgE<gt>. All rights reserved. -This library is free software; you may redistribute and/or modify it +This library is free software; you may redistribute and/or modify it under the same terms as Perl itself. =cut diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS.pm b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS.pm index e0ff071b34c..b61771b242c 100644 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS.pm +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS.pm @@ -1,5 +1,4 @@ package CPANPLUS; -use deprecate; use strict; use Carp; @@ -14,7 +13,7 @@ BEGIN { use vars qw( @EXPORT @ISA $VERSION ); @EXPORT = qw( shell fetch get install ); @ISA = qw( Exporter ); - $VERSION = "0.9135"; #have to hardcode or cpan.org gets unhappy + $VERSION = "0.90"; #have to hardcode or cpan.org gets unhappy } ### purely for backward compatibility, so we can call it from the commandline: @@ -114,7 +113,7 @@ CPANPLUS - API & CLI access to the CPAN mirrors $ perl -MCPANPLUS -eshell $ perl -MCPANPLUS -e'fetch Some::Module' - + =head1 DESCRIPTION The C<CPANPLUS> library is an API to the C<CPAN> mirrors and a @@ -125,21 +124,21 @@ that use this API. =head2 GENERAL USAGE -This is the document you are currently reading. It describes -basic usage and background information. Its main purpose is to +This is the document you are currently reading. It describes +basic usage and background information. Its main purpose is to assist the user who wants to learn how to invoke CPANPLUS and install modules from the commandline and to point you to more indepth reading if required. =head2 API REFERENCE -The C<CPANPLUS> API is meant to let you programmatically +The C<CPANPLUS> API is meant to let you programmatically interact with the C<CPAN> mirrors. The documentation in L<CPANPLUS::Backend> shows you how to create an object capable of interacting with those mirrors, letting you create & retrieve module objects. L<CPANPLUS::Module> shows you how you can use these module -objects to perform actions like installing and testing. +objects to perform actions like installing and testing. The default shell, documented in L<CPANPLUS::Shell::Default> is also scriptable. You can use its API to dispatch calls @@ -151,46 +150,46 @@ from your script to the CPANPLUS Shell. =head2 STARTING AN INTERACTIVE SHELL -You can start an interactive shell by running either of +You can start an interactive shell by running either of the two following commands: $ cpanp $ perl -MCPANPLUS -eshell -All commands available are listed in the interactive shells -help menu. See C<cpanp -h> or L<CPANPLUS::Shell::Default> -for instructions on using the default shell. - +All commans available are listed in the interactive shells +help menu. See C<cpanp -h> or L<CPANPLUS::Shell::Default> +for instructions on using the default shell. + =head2 CHOOSE A SHELL By running C<cpanp> without arguments, you will start up -the shell specified in your config, which defaults to +the shell specified in your config, which defaults to L<CPANPLUS::Shell::Default>. There are more shells available. -C<CPANPLUS> itself ships with an emulation shell called -L<CPANPLUS::Shell::Classic> that looks and feels just like +C<CPANPLUS> itself ships with an emulation shell called +L<CPANPLUS::Shell::Classic> that looks and feels just like the old C<CPAN.pm> shell. You can start this shell by typing: $ perl -MCPANPLUS -e'shell Classic' - -Even more shells may be available from C<CPAN>. + +Even more shells may be available from C<CPAN>. Note that if you have changed your default shell in your -configuration, that shell will be used instead. If for -some reason there was an error with your specified shell, +configuration, that shell will be used instead. If for +some reason there was an error with your specified shell, you will be given the default shell. =head2 BUILDING PACKAGES -C<cpan2dist> is a commandline tool to convert any distribution +C<cpan2dist> is a commandline tool to convert any distribution from C<CPAN> into a package in the format of your choice, like -for example C<.deb> or C<FreeBSD ports>. +for example C<.deb> or C<FreeBSD ports>. See C<cpan2dist -h> for details. - - + + =head1 FUNCTIONS For quick access to common commands, you may use this module, @@ -239,10 +238,10 @@ This module by Jos Boumans E<lt>kane@cpan.orgE<gt>. =head1 COPYRIGHT -The CPAN++ interface (of which this module is a part of) is copyright (c) +The CPAN++ interface (of which this module is a part of) is copyright (c) 2001 - 2007, Jos Boumans E<lt>kane@cpan.orgE<gt>. All rights reserved. -This library is free software; you may redistribute and/or modify it +This library is free software; you may redistribute and/or modify it under the same terms as Perl itself. =head1 SEE ALSO @@ -257,7 +256,7 @@ L<CPANPLUS::Shell::Default>, L<CPANPLUS::FAQ>, L<CPANPLUS::Backend>, L<CPANPLUS: I<bug-cpanplus@rt.cpan.org> =item * Questions & suggestions: -I<bug-cpanplus@rt.cpan.org> +I<cpanplus-devel@lists.sourceforge.net> =back diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Configure/Setup.pm b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Configure/Setup.pm index 8ac565a70ec..3bcf8f45090 100644 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Configure/Setup.pm +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Configure/Setup.pm @@ -1,9 +1,7 @@ package CPANPLUS::Configure::Setup; -use deprecate; use strict; -use vars qw[@ISA $VERSION]; -$VERSION = "0.9135"; +use vars qw(@ISA); use base qw[CPANPLUS::Internals::Utils]; use base qw[Object::Accessor]; @@ -13,6 +11,7 @@ use Term::UI; use Module::Load; use Term::ReadLine; + use CPANPLUS::Internals::Utils; use CPANPLUS::Internals::Constants; use CPANPLUS::Error; @@ -61,20 +60,20 @@ sub new { my $obj = $class->SUPER::new( keys %$tmpl ); for my $acc ( $obj->ls_accessors ) { $obj->$acc( $args->{$acc} ); - } - + } + ### otherwise there's a circular use ### load CPANPLUS::Configure; load CPANPLUS::Backend; $obj->configure_object( CPANPLUS::Configure->new() ) unless $obj->configure_object; - + $obj->backend( CPANPLUS::Backend->new( $obj->configure_object ) ) unless $obj->backend; ### use empty string in case user only has T::R::Stub -- it complains - $obj->term( Term::ReadLine->new('') ) + $obj->term( Term::ReadLine->new('') ) unless $obj->term; ### enable autoreply if that was passed ### @@ -86,10 +85,10 @@ sub new { sub init { my $self = shift; my $term = $self->term; - + ### default setting, unless changed $self->config_type( CONFIG_USER ) unless $self->config_type; - + my $save = loc('Save & exit'); my $exit = loc('Quit without saving'); my @map = ( @@ -100,45 +99,45 @@ sub init { [ loc('Setup FTP/Email settings') => '_setup_ftp' ], [ loc('Setup basic preferences') => '_setup_conf' ], [ loc('Setup installer settings') => '_setup_installer' ], - [ loc('Select mirrors'), => '_setup_hosts' ], - [ loc('Edit configuration file') => '_edit' ], + [ loc('Select mirrors'), => '_setup_hosts' ], + [ loc('Edit configuration file') => '_edit' ], [ $save => '_save' ], - [ $exit => 1 ], + [ $exit => 1 ], ); my @keys = map { $_->[0] } @map; # sorted keys my %map = map { @$_ } @map; # lookup hash - + PICK_SECTION: { print loc(" -=================> MAIN MENU <================= - +=================> MAIN MENU <================= + Welcome to the CPANPLUS configuration. Please select which parts you wish to configure Defaults are taken from your current configuration. If you would save now, your settings would be written to: - + %1 - + ", $self->config_type ); - + my $choice = $term->get_reply( prompt => "Section to configure:", choices => \@keys, default => $keys[0] - ); - + ); + ### exit configuration? if( $choice eq $exit ) { print loc(" Quitting setup, changes will not be saved. "); return 1; - } - + } + my $method = $map{$choice}; - + my $rv = $self->$method or print loc(" There was an error setting up this section. You might want to try again "); @@ -147,14 +146,14 @@ There was an error setting up this section. You might want to try again if( $choice eq $save and $rv ) { print loc(" Quitting setup, changes are saved to '%1' - ", $self->config_type + ", $self->config_type ); return 1; } ### otherwise, present choice again redo PICK_SECTION; - } + } return 1; } @@ -169,22 +168,22 @@ sub _save_where { ASK_CONFIG_TYPE: { - - print loc( q[ + + print loc( q[ Where would you like to save your CPANPLUS Configuration file? -If you want to configure CPANPLUS for this user only, +If you want to configure CPANPLUS for this user only, select the '%1' option. The file will then be saved in your homedirectory. -If you are the system administrator of this machine, -and would like to make this config available globally, +If you are the system administrator of this machine, +and would like to make this config available globally, select the '%2' option. -The file will be then be saved in your CPANPLUS +The file will be then be saved in your CPANPLUS installation directory. ], CONFIG_USER, CONFIG_SYSTEM ); - + ### ask what config type we should save to my $type = $term->get_reply( @@ -192,19 +191,19 @@ installation directory. default => $self->config_type || CONFIG_USER, choices => [CONFIG_USER, CONFIG_SYSTEM], ); - + my $file = $conf->_config_pm_to_file( $type ); - + ### can we save to this file? unless( $conf->can_save( $file ) ) { error(loc( "Can not save to file '%1'-- please check permissions " . - "and try again", $file + "and try again", $file )); - + redo ASK_CONFIG_FILE; - } - + } + ### you already have the file -- are we allowed to overwrite ### or should we try again? if ( -e $file and -w _ ) { @@ -215,18 +214,18 @@ I see you already have this file: The file will not be overwritten until you explicitly save it. ], $file ); - - redo ASK_CONFIG_TYPE + + redo ASK_CONFIG_TYPE unless $term->ask_yn( prompt => loc( "Do you wish to use this file?"), default => 'n', ); } - + print $/, loc("Using '%1' as your configuration type", $type); - + return $self->config_type($type); - } + } } @@ -238,10 +237,10 @@ sub _setup_base { my $base = $conf->get_conf('base'); my $home = File::Spec->catdir( $self->_home_dir, DOT_CPANPLUS ); - + print loc(" CPANPLUS needs a directory of its own to cache important index -files and maybe keep a temporary mirror of CPAN files. +files and maybe keep a temporary mirror of CPAN files. This may be a site-wide directory or a personal directory. For a single-user installation, we suggest using your home directory. @@ -267,7 +266,7 @@ For a single-user installation, we suggest using your home directory. print loc(" I see you already have a directory: %1 - + "), $where; my $yn = $term->ask_yn( @@ -339,7 +338,7 @@ First of all, I'd like to create this directory. print loc(q[ Your CPANPLUS build and cache directory has been set to: %1 - + ], $where); return 1; @@ -423,7 +422,7 @@ is required for the 'from' field, so choose wisely. unless (grep { $_ eq $current } @choices) { unshift @choices, $current; } - + my $email = $term->get_reply( prompt => loc('Which email address shall I use?'), default => $current || $choices[0], @@ -435,7 +434,7 @@ is required for the 'from' field, so choose wisely. $email = $term->get_reply( prompt => loc('Email address: '), ); - + unless( $self->_valid_email($email) ) { print loc(" You did not enter a valid email address, please try again! @@ -449,7 +448,7 @@ You did not enter a valid email address, please try again! print loc(" Your 'email' is now: %1 - + ", $email); $conf->set_conf( email => $email ); @@ -482,16 +481,16 @@ like '%1'. PROGRAM: { print "\n", loc("Where can I find your '%1' utility? ". "(Enter a single space to disable)", $prog ), "\n"; - + my $loc = $term->get_reply( prompt => "Path to your '$prog'", default => $conf->get_program( $prog ), - ); - - ### empty line clears it + ); + + ### empty line clears it my $cmd = $loc =~ /^\s*$/ ? undef : $loc; my ($bin) = $cmd =~ /^(\S+)/; - + ### did you provide a valid program ? if( $bin and not can_run( $bin ) ) { print "\n"; @@ -506,27 +505,27 @@ like '%1'. 'make' ); print loc("Please provide one!"); - + ### show win32 where to download - if ( $^O eq 'MSWin32' ) { + if ( $^O eq 'MSWin32' ) { print loc("You can get '%1' from:", NMAKE); print "\t". NMAKE_URL ."\n"; } print "\n"; - redo PROGRAM; + redo PROGRAM; } $conf->set_program( $prog => $cmd ); print $cmd - ? loc( "Your '%1' utility has been set to '%2'.", + ? loc( "Your '%1' utility has been set to '%2'.", $prog, $cmd ) - : loc( "Your '%1' has been disabled.", $prog ); + : loc( "Your '%1' has been disabled.", $prog ); print "\n"; } } - + return 1; -} +} sub _setup_installer { my $self = shift; @@ -534,7 +533,7 @@ sub _setup_installer { my $conf = $self->configure_object; my $none = 'None'; - { + { print loc(" CPANPLUS uses binary programs as well as Perl modules to accomplish various tasks. Normally, CPANPLUS will prefer the use of Perl modules @@ -544,7 +543,7 @@ You can change this setting by making CPANPLUS prefer the use of certain binary programs if they are available. "); - + ### default to using binaries if we don't have compress::zlib only ### -- it'll get very noisy otherwise my $type = 'prefer_bin'; @@ -671,7 +670,7 @@ Again, if you don't understand this question, just press ENTER. Some modules provide both a Build.PL (Module::Build) and a Makefile.PL (ExtUtils::MakeMaker). By default, CPANPLUS prefers Makefile.PL. -Module::Build support is not bundled standard with CPANPLUS, but +Module::Build support is not bundled standard with CPANPLUS, but requires you to install 'CPANPLUS::Dist::Build' from CPAN. Although Module::Build is a pure perl solution, which means you will @@ -723,10 +722,10 @@ pathnames to be added to your @INC, quoting any with embedded whitespace. $conf->set_conf( $type => $lib ); } - + return 1; -} - +} + sub _setup_conf { my $self = shift; @@ -835,37 +834,37 @@ Otherwise, select ASK to have us ask your permission to install them. "); my $type = 'prereqs'; - + my @map = ( - [ PREREQ_IGNORE, # conf value - loc('No, do not install prerequisites'), # UI Value + [ PREREQ_IGNORE, # conf value + loc('No, do not install prerequisites'), # UI Value loc("I won't install prerequisites") # diag message ], [ PREREQ_INSTALL, - loc('Yes, please install prerequisites'), - loc("I will install prerequisites") + loc('Yes, please install prerequisites'), + loc("I will install prerequisites") ], - [ PREREQ_ASK, - loc('Ask me before installing a prerequisite'), - loc("I will ask permission to install") + [ PREREQ_ASK, + loc('Ask me before installing a prerequisite'), + loc("I will ask permission to install") ], - [ PREREQ_BUILD, + [ PREREQ_BUILD, loc('Build prerequisites, but do not install them'), loc( "I will only build, but not install prerequisites" ) ], ); - + my %reply = map { $_->[1] => $_->[0] } @map; # choice => value my %diag = map { $_->[1] => $_->[2] } @map; # choice => diag message my %conf = map { $_->[0] => $_->[1] } @map; # value => ui choice - + my $reply = $term->get_reply( prompt => loc('Follow prerequisites?'), default => $conf{ $conf->get_conf( $type ) }, choices => [ @conf{ sort keys %conf } ], ); print "\n"; - + my $value = $reply{ $reply }; my $diag = $diag{ $reply }; @@ -881,7 +880,7 @@ CPANPLUS can do for you later); "); my $type = 'md5'; - + my $yn = $term->ask_yn( prompt => loc("Shall I use the MD5 checksums?"), default => $conf->get_conf( $type ), @@ -895,7 +894,7 @@ CPANPLUS can do for you later); } - + { ########################################### ## sally sells seashells by the seashore ## ########################################### @@ -910,7 +909,7 @@ please enter the full name for your shell module. my $type = 'shell'; my $other = 'Other'; my @choices = (qw| CPANPLUS::Shell::Default - CPANPLUS::Shell::Classic |, + CPANPLUS::Shell::Classic |, $other ); my $default = $conf->get_conf($type); @@ -930,9 +929,9 @@ please enter the full name for your shell module. ); unless( check_install( module => $reply ) ) { - print "\n", + print "\n", loc("Could not find '$reply' in your path " . - "-- please try again"), + "-- please try again"), "\n"; redo SHELL; } @@ -974,8 +973,8 @@ Would you like to do this? ################### print loc(" - -To limit the amount of RAM used by CPANPLUS, you can use the SQLite + +To limit the amount of RAM used by CPANPLUS, you can use the SQLite source backend instead. Note that it is currently still experimental. Would you like to do this? @@ -1198,26 +1197,26 @@ are done. } CHOICE: { - + ### doesn't play nice with Term::UI :( ### should make t::ui figure out pager opens #$self->_pager_open; # host lists might be long - + print loc(" -You can enter multiple sites by separating them by a space. +You can enter multiple sites by seperating them by a space. For example: 1 4 2 5 - "); - + "); + my @reply = $term->get_reply( prompt => loc('Please pick a site: '), - choices => [sort(keys %map), + choices => [sort(keys %map), qw|Custom View Up Quit|], default => $default, multi => 1, ); #$self->_pager_close; - + goto COUNTRY if grep { $_ eq 'Up' } @reply; goto CUSTOM if grep { $_ eq 'Custom' } @reply; @@ -1374,7 +1373,7 @@ This may take a while... "); - ### use the new configuration ### + ### use the enew configuratoin ### $cpan->configure_object( $conf ); load CPANPLUS::Module::Fake; @@ -1647,8 +1646,8 @@ post-configuration editing of the config file sub _save { my $self = shift; my $conf = $self->configure_object; - + return $conf->save( $self->config_type ); -} +} 1; diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Dist/Base.pm b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Dist/Base.pm index 73736d9e4da..c7108ed1392 100644 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Dist/Base.pm +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Dist/Base.pm @@ -1,11 +1,11 @@ package CPANPLUS::Dist::Base; -use deprecate; use strict; use base qw[CPANPLUS::Dist]; use vars qw[$VERSION]; -$VERSION = "0.9135"; +$VERSION = $CPANPLUS::Internals::VERSION = $CPANPLUS::Internals::VERSION; + =head1 NAME @@ -19,13 +19,13 @@ CPANPLUS::Dist::Base - Base class for custom distribution classes sub prepare { my $dist = shift; - + ### do the 'standard' things $dist->SUPER::prepare( @_ ) or return; - + ### do MY_IMPLEMENTATION specific things ... - + ### don't forget to set the status! return $dist->status->prepared( $SUCCESS ? 1 : 0 ); } @@ -34,7 +34,7 @@ CPANPLUS::Dist::Base - Base class for custom distribution classes =head1 DESCRIPTION CPANPLUS::Dist::Base functions as a base class for all custom -distribution implementations. It does all the mundane work +distribution implementations. It does all the mundane work CPANPLUS would have done without a custom distribution, so you can override just the parts you need to make your own implementation work. @@ -50,7 +50,7 @@ class are called: $dist->prepare; # find/write meta information $dist->create; # write the distribution file $dist->install; # install the distribution file - + $dist->uninstall; # remove the distribution (OPTIONAL) =head1 METHODS @@ -64,8 +64,8 @@ override. =cut -sub methods { - return qw[format_available init prepare create install uninstall] +sub methods { + return qw[format_available init prepare create install uninstall] } =head2 $bool = $Class->format_available @@ -82,7 +82,7 @@ Simply return true if the request can proceed and false if it can not. The C<CPANPLUS::Dist::Base> implementation always returns true. -=cut +=cut sub format_available { return 1 } @@ -91,21 +91,21 @@ sub format_available { return 1 } This method is called just after the new dist object is set up and before the C<prepare> method is called. This is the time to set up -the object so it can be used with your class. +the object so it can be used with your class. For example, you might want to add extra accessors to the C<status> object, which you might do as follows: $dist->status->mk_accessors( qw[my_implementation_accessor] ); - -The C<status> object is implemented as an instance of the -C<Object::Accessor> class. Please refer to its documentation for + +The C<status> object is implemented as an instance of the +C<Object::Accessor> class. Please refer to its documentation for details. - -Return true if the initialization was successful, and false if it was + +Return true if the initialization was successul, and false if it was not. - -The C<CPANPLUS::Dist::Base> implementation does not alter your object + +The C<CPANPLUS::Dist::Base> implementation does not alter your object and always returns true. =cut @@ -116,14 +116,14 @@ sub init { return 1; } This runs the preparation step of your distribution. This step is meant to set up the environment so the C<create> step can create the actual -distribution(file). -A C<prepare> call in the standard C<ExtUtils::MakeMaker> distribution +distribution(file). +A C<prepare> call in the standard C<ExtUtils::MakeMaker> distribution would, for example, run C<perl Makefile.PL> to find the dependencies -for a distribution. For a C<debian> distribution, this is where you +for a distribution. For a C<debian> distribution, this is where you would write all the metafiles required for the C<dpkg-*> tools. The C<CPANPLUS::Dist::Base> implementation simply calls the underlying -distribution class (Typically C<CPANPLUS::Dist::MM> or +distribution class (Typically C<CPANPLUS::Dist::MM> or C<CPANPLUS::Dist::Build>). Sets C<< $dist->status->prepared >> to the return value of this function. @@ -131,7 +131,7 @@ If you override this method, you should make sure to set this value. =cut -sub prepare { +sub prepare { ### just in case you already did a create call for this module object ### just via a different dist object my $dist = shift; @@ -147,18 +147,18 @@ sub prepare { =head2 $bool = $dist->create This runs the creation step of your distribution. This step is meant -to follow up on the C<prepare> call, that set up your environment so -the C<create> step can create the actual distribution(file). -A C<create> call in the standard C<ExtUtils::MakeMaker> distribution +to follow up on the C<prepare> call, that set up your environment so +the C<create> step can create the actual distribution(file). +A C<create> call in the standard C<ExtUtils::MakeMaker> distribution would, for example, run C<make> and C<make test> to build and test -a distribution. For a C<debian> distribution, this is where you +a distribution. For a C<debian> distribution, this is where you would create the actual C<.deb> file using C<dpkg>. The C<CPANPLUS::Dist::Base> implementation simply calls the underlying -distribution class (Typically C<CPANPLUS::Dist::MM> or +distribution class (Typically C<CPANPLUS::Dist::MM> or C<CPANPLUS::Dist::Build>). -Sets C<< $dist->status->dist >> to the location of the created +Sets C<< $dist->status->dist >> to the location of the created distribution. If you override this method, you should make sure to set this value. @@ -167,7 +167,7 @@ If you override this method, you should make sure to set this value. =cut -sub create { +sub create { ### just in case you already did a create call for this module object ### just via a different dist object my $dist = shift; @@ -193,13 +193,13 @@ sub create { This runs the install step of your distribution. This step is meant to follow up on the C<create> call, which prepared a distribution(file) to install. -A C<create> call in the standard C<ExtUtils::MakeMaker> distribution +A C<create> call in the standard C<ExtUtils::MakeMaker> distribution would, for example, run C<make install> to copy the distribution files -to their final destination. For a C<debian> distribution, this is where +to their final destination. For a C<debian> distribution, this is where you would run C<dpkg --install> on the created C<.deb> file. The C<CPANPLUS::Dist::Base> implementation simply calls the underlying -distribution class (Typically C<CPANPLUS::Dist::MM> or +distribution class (Typically C<CPANPLUS::Dist::MM> or C<CPANPLUS::Dist::Build>). Sets C<< $dist->status->installed >> to the return value of this function. @@ -207,12 +207,12 @@ If you override this method, you should make sure to set this value. =cut -sub install { +sub install { ### just in case you already did a create call for this module object ### just via a different dist object my $dist = shift; my $self = $dist->parent; - my $dist_cpan = $self->status->dist_cpan; + my $dist_cpan = $self->status->dist_cpan; my $cb = $self->parent; my $conf = $cb->configure_object; @@ -223,14 +223,14 @@ sub install { =head2 $bool = $dist->uninstall This runs the uninstall step of your distribution. This step is meant -to remove the distribution from the file system. -A C<uninstall> call in the standard C<ExtUtils::MakeMaker> distribution -would, for example, run C<make uninstall> to remove the distribution -files the file system. For a C<debian> distribution, this is where you +to remove the distribution from the file system. +A C<uninstall> call in the standard C<ExtUtils::MakeMaker> distribution +would, for example, run C<make uninstall> to remove the distribution +files the file system. For a C<debian> distribution, this is where you would run C<dpkg --uninstall PACKAGE>. The C<CPANPLUS::Dist::Base> implementation simply calls the underlying -distribution class (Typically C<CPANPLUS::Dist::MM> or +distribution class (Typically C<CPANPLUS::Dist::MM> or C<CPANPLUS::Dist::Build>). Sets C<< $dist->status->uninstalled >> to the return value of this function. @@ -238,12 +238,12 @@ If you override this method, you should make sure to set this value. =cut -sub uninstall { +sub uninstall { ### just in case you already did a create call for this module object ### just via a different dist object my $dist = shift; my $self = $dist->parent; - my $dist_cpan = $self->status->dist_cpan; + my $dist_cpan = $self->status->dist_cpan; my $cb = $self->parent; my $conf = $cb->configure_object; @@ -251,7 +251,7 @@ sub uninstall { $dist->status->uninstalled( $dist_cpan->uninstall( @_ ) ); } -1; +1; # Local variables: # c-indentation-style: bsd diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Dist/Sample.pm b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Dist/Sample.pm index e03d66f9836..0b0939208ff 100644 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Dist/Sample.pm +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Dist/Sample.pm @@ -1,8 +1,4 @@ package CPANPLUS::Dist::Sample; -use deprecate; - -use vars qw[$VERSION]; -$VERSION = "0.9135"; =pod diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Internals/Constants.pm b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Internals/Constants.pm index 09501c78e84..1a38200dfb7 100644 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Internals/Constants.pm +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Internals/Constants.pm @@ -1,5 +1,4 @@ package CPANPLUS::Internals::Constants; -use deprecate; use strict; @@ -14,18 +13,18 @@ use vars qw[$VERSION @ISA @EXPORT]; use Package::Constants; -$VERSION = "0.9135"; @ISA = qw[Exporter]; @EXPORT = Package::Constants->list( __PACKAGE__ ); + sub constants { @EXPORT }; use constant INSTALLER_BUILD => 'CPANPLUS::Dist::Build'; -use constant INSTALLER_MM => 'CPANPLUS::Dist::MM'; -use constant INSTALLER_SAMPLE +use constant INSTALLER_MM => 'CPANPLUS::Dist::MM'; +use constant INSTALLER_SAMPLE => 'CPANPLUS::Dist::Sample'; -use constant INSTALLER_BASE => 'CPANPLUS::Dist::Base'; +use constant INSTALLER_BASE => 'CPANPLUS::Dist::Base'; use constant INSTALLER_AUTOBUNDLE => 'CPANPLUS::Dist::Autobundle'; @@ -51,26 +50,26 @@ 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 DOT_CPANPLUS => ON_VMS ? '_cpanplus' : '.cpanplus'; use constant OPT_AUTOFLUSH => '-MCPANPLUS::Internals::Utils::Autoflush'; use constant UNKNOWN_DL_LOCATION - => 'UNKNOWN-ORIGIN'; + => 'UNKNOWN-ORIGIN'; use constant NMAKE => 'nmake.exe'; -use constant NMAKE_URL => +use constant NMAKE_URL => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/nmake15.exe'; -use constant INSTALL_VIA_PACKAGE_MANAGER +use constant INSTALL_VIA_PACKAGE_MANAGER => sub { my $fmt = $_[0] or return; return 1 if $fmt ne INSTALLER_BUILD and $fmt ne INSTALLER_MM; - }; + }; use constant IS_CODEREF => sub { ref $_[-1] eq 'CODE' }; -use constant IS_MODOBJ => sub { UNIVERSAL::isa($_[-1], - 'CPANPLUS::Module') }; +use constant IS_MODOBJ => sub { UNIVERSAL::isa($_[-1], + 'CPANPLUS::Module') }; use constant IS_FAKE_MODOBJ => sub { UNIVERSAL::isa($_[-1], 'CPANPLUS::Module::Fake') }; use constant IS_AUTHOBJ => sub { UNIVERSAL::isa($_[-1], @@ -84,48 +83,48 @@ use constant IS_CONFOBJ => sub { UNIVERSAL::isa($_[-1], use constant IS_RVOBJ => sub { UNIVERSAL::isa($_[-1], 'CPANPLUS::Backend::RV') }; - + use constant IS_INTERNALS_OBJ => sub { UNIVERSAL::isa($_[-1], - 'CPANPLUS::Internals') }; - -use constant IS_FILE => sub { return 1 if -e $_[-1] }; + 'CPANPLUS::Internals') }; + +use constant IS_FILE => sub { return 1 if -e $_[-1] }; -use constant FILE_EXISTS => sub { +use constant FILE_EXISTS => sub { my $file = $_[-1]; return 1 if IS_FILE->($file); - local $Carp::CarpLevel = + local $Carp::CarpLevel = $Carp::CarpLevel+2; error(loc( q[File '%1' does not exist], $file)); return; - }; + }; -use constant FILE_READABLE => sub { +use constant FILE_READABLE => sub { my $file = $_[-1]; return 1 if -e $file && -r _; - local $Carp::CarpLevel = + local $Carp::CarpLevel = $Carp::CarpLevel+2; error( loc( q[File '%1' is not readable ]. q[or does not exist], $file)); return; - }; + }; use constant IS_DIR => sub { return 1 if -d $_[-1] }; -use constant DIR_EXISTS => sub { +use constant DIR_EXISTS => sub { my $dir = $_[-1]; return 1 if IS_DIR->($dir); - local $Carp::CarpLevel = - $Carp::CarpLevel+2; + local $Carp::CarpLevel = + $Carp::CarpLevel+2; error(loc(q[Dir '%1' does not exist], $dir)); return; - }; - - ### On VMS, if the $Config{make} is either MMK + }; + + ### 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 + (ON_VMS and $Config::Config{make} =~ /MM[S|K]/i) ? 'DESCRIP.MMS' : 'Makefile'; @@ -133,80 +132,66 @@ use constant MAKEFILE => sub { my $file = return @_ ? File::Spec->catfile( @_, $file ) : $file; - }; + }; use constant MAKEFILE_PL => sub { return @_ ? File::Spec->catfile( @_, 'Makefile.PL' ) : 'Makefile.PL'; - }; + }; use constant BUILD_PL => sub { return @_ ? File::Spec->catfile( @_, 'Build.PL' ) : 'Build.PL'; }; - + use constant META_YML => sub { return @_ ? File::Spec->catfile( @_, 'META.yml' ) : 'META.yml'; - }; + }; use constant MYMETA_YML => sub { return @_ ? File::Spec->catfile( @_, 'MYMETA.yml' ) : 'MYMETA.yml'; - }; - -use constant META_JSON => sub { return @_ - ? File::Spec->catfile( @_, 'META.json' ) - : 'META.json'; - }; - -use constant MYMETA_JSON => sub { return @_ - ? File::Spec->catfile( @_, 'MYMETA.json' ) - : 'MYMETA.json'; - }; + }; use constant BLIB => sub { return @_ ? File::Spec->catfile(@_, 'blib') : 'blib'; - }; + }; use constant LIB => 'lib'; use constant LIB_DIR => sub { return @_ ? File::Spec->catdir(@_, LIB) : LIB; - }; -use constant AUTO => 'auto'; + }; +use constant AUTO => 'auto'; use constant LIB_AUTO_DIR => sub { return @_ ? File::Spec->catdir(@_, LIB, AUTO) : File::Spec->catdir(LIB, AUTO) - }; + }; use constant ARCH => 'arch'; use constant ARCH_DIR => sub { return @_ ? File::Spec->catdir(@_, ARCH) : ARCH; - }; + }; use constant ARCH_AUTO_DIR => sub { return @_ ? File::Spec->catdir(@_,ARCH,AUTO) : File::Spec->catdir(ARCH,AUTO) - }; + }; use constant BLIB_LIBDIR => sub { return @_ ? File::Spec->catdir( @_, BLIB->(), LIB ) : File::Spec->catdir( BLIB->(), LIB ); - }; - -use constant BIN => 'bin'; + }; -use constant SCRIPT => 'script'; - -use constant CONFIG_USER_LIB_DIR => sub { +use constant CONFIG_USER_LIB_DIR => sub { require CPANPLUS::Internals::Utils; LIB_DIR->( CPANPLUS::Internals::Utils->_home_dir, DOT_CPANPLUS ); - }; + }; use constant CONFIG_USER_FILE => sub { File::Spec->catfile( CONFIG_USER_LIB_DIR->(), @@ -219,13 +204,13 @@ use constant CONFIG_SYSTEM_FILE => sub { my $dir = File::Basename::dirname( $INC{'CPANPLUS/Internals.pm'} ); - + ### XXX use constants - File::Spec->catfile( + File::Spec->catfile( $dir, qw[Config System.pm] ); - }; - + }; + use constant README => sub { my $obj = $_[0]; my $pkg = $obj->package_name; $pkg .= '-' . $obj->package_version . @@ -239,8 +224,8 @@ use constant META => sub { my $obj = $_[0]; $pkg .= '-' . $obj->package_version . '.' . META_EXT; return $pkg; - }; - + }; + use constant OPEN_FILE => sub { my($file, $mode) = (@_, ''); my $fh; @@ -250,23 +235,23 @@ use constant OPEN_FILE => sub { $file, $!)); return $fh if $fh; return; - }; - -use constant OPEN_DIR => sub { + }; + +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 { +use constant READ_DIR => sub { my $dir = shift; my $dh = OPEN_DIR->( $dir ) or return; - + ### exclude . and .. my @files = grep { $_ !~ /^\.{1,2}/ } readdir($dh); @@ -276,27 +261,27 @@ use constant READ_DIR => sub { if( ON_VMS ) { s/(?<!\^)\.$// for @files; } - + return @files; - }; + }; -use constant STRIP_GZ_SUFFIX +use constant STRIP_GZ_SUFFIX => sub { my $file = $_[0] or return; $file =~ s/.gz$//i; return $file; - }; - + }; + use constant CHECKSUMS => 'CHECKSUMS'; use constant PGP_HEADER => '-----BEGIN PGP SIGNED MESSAGE-----'; use constant ENV_CPANPLUS_CONFIG => 'PERL5_CPANPLUS_CONFIG'; use constant ENV_CPANPLUS_IS_EXECUTING => 'PERL5_CPANPLUS_IS_EXECUTING'; -use constant DEFAULT_EMAIL => 'cpanplus@example.com'; +use constant DEFAULT_EMAIL => 'cpanplus@example.com'; use constant CPANPLUS_UA => sub { ### for the version number ### require CPANPLUS::Internals; - "CPANPLUS/$CPANPLUS::Internals::VERSION" + "CPANPLUS/$CPANPLUS::Internals::VERSION" }; use constant TESTERS_URL => sub { 'http://cpantesters.org/distro/'. @@ -306,15 +291,15 @@ use constant TESTERS_DETAILS_URL => sub { 'http://cpantesters.org/distro/'. uc(substr($_[0],0,1)) .'/'. $_[0]; - }; + }; -use constant CREATE_FILE_URI - => sub { +use constant CREATE_FILE_URI + => sub { my $dir = $_[0] or return; - return $dir =~ m|^/| + return $dir =~ m|^/| ? 'file://' . $dir - : 'file:///' . $dir; - }; + : 'file:///' . $dir; + }; use constant EMPTY_DSLIP => ' '; @@ -323,65 +308,64 @@ use constant CUSTOM_AUTHOR_ID use constant DOT_SHELL_DEFAULT_RC => '.shell-default.rc'; - + use constant SOURCE_SQLITE_DB => 'db.sql'; -use constant PREREQ_IGNORE => 0; +use constant PREREQ_IGNORE => 0; use constant PREREQ_INSTALL => 1; use constant PREREQ_ASK => 2; use constant PREREQ_BUILD => 3; use constant BOOLEANS => [0,1]; -use constant CALLING_FUNCTION +use constant CALLING_FUNCTION => sub { my $lvl = $_[0] || 0; - return join '::', (caller(2+$lvl))[3] + return join '::', (caller(2+$lvl))[3] }; use constant PERL_CORE => 'perl'; -use constant PERL_WRAPPER => 'use strict; BEGIN { my $old = select STDERR; $|++; select $old; $|++; $0 = shift(@ARGV); my $rv = do($0); die $@ if $@; }'; use constant STORABLE_EXT => '.stored'; use constant GET_XS_FILES => sub { my $dir = $_[0] or return; require File::Find; my @files; - File::Find::find( + File::Find::find( sub { push @files, $File::Find::name if $File::Find::name =~ /\.xs$/i }, $dir ); - + return @files; - }; + }; -use constant INSTALL_LOG_FILE +use constant INSTALL_LOG_FILE => sub { my $obj = shift or return; my $name = $obj->name; $name =~ s/::/-/g; $name .= '-'. $obj->version; $name .= '-'. scalar(time) . '.log'; return $name; - }; + }; -use constant ON_OLD_CYGWIN => do { ON_CYGWIN and $] < 5.008 +use constant ON_OLD_CYGWIN => do { ON_CYGWIN and $] < 5.008 ? loc( "Your perl version for %1 is too low; ". "Require %2 or higher for this function", $^O, '5.8.0' ) - : ''; + : ''; }; ### XXX these 2 are probably obsolete -- check & remove; -use constant DOT_EXISTS => '.exists'; +use constant DOT_EXISTS => '.exists'; -use constant QUOTE_PERL_ONE_LINER +use constant QUOTE_PERL_ONE_LINER => sub { my $line = shift or return; ### use double quotes on these systems - return qq["$line"] + return qq["$line"] if ON_WIN32 || ON_NETWARE || ON_VMS; ### single quotes on the rest return qq['$line']; - }; + }; -1; +1; # Local variables: # c-indentation-style: bsd diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Internals/Constants/Report.pm b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Internals/Constants/Report.pm index dc92ec6c31d..59a41a6083b 100644 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Internals/Constants/Report.pm +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Internals/Constants/Report.pm @@ -1,5 +1,4 @@ package CPANPLUS::Internals::Constants::Report; -use deprecate; use strict; use CPANPLUS::Error; @@ -15,10 +14,11 @@ use Package::Constants; ### for the version require CPANPLUS::Internals; -$VERSION = "0.9135"; +$VERSION = $CPANPLUS::Internals::VERSION = $CPANPLUS::Internals::VERSION; @ISA = qw[Exporter]; @EXPORT = Package::Constants->list( __PACKAGE__ ); + ### OS to regex map ### my %OS = ( Amiga => 'amigaos', @@ -80,10 +80,10 @@ use constant RELEVANT_TEST_RESULT my $name = $mod->module; my $specific; for my $platform (keys %OS) { - if( $name =~ /^$platform\b/i ) { + if( $name =~ /\b$platform\b/i ) { # beware the Mac != MAC next if($platform eq 'Mac' && - $name !~ /^$platform\b/); + $name !~ /\b$platform\b/); $specific++; return 1 if $^O =~ /^(?:$OS{$platform})$/ @@ -100,7 +100,7 @@ use constant UNSUPPORTED_OS return 1; } return 0; - }; + }; use constant PERL_VERSION_TOO_LOW => sub { @@ -116,7 +116,7 @@ use constant PERL_VERSION_TOO_LOW return 1; } return 0; - }; + }; use constant NO_TESTS_DEFINED => sub { @@ -125,10 +125,10 @@ use constant NO_TESTS_DEFINED /(No tests defined( for [\w:]+ extension)?\.)/ and $buffer !~ /\*\.t/m and $buffer !~ /test\.pl/m - ) { - return $1 + ) { + return $1 } - + return; }; @@ -149,8 +149,8 @@ use constant MISSING_PREREQS_LIST my @list = map { s/.pm$//; s|/|::|g; $_ } ($last =~ m/\bCan\'t locate (\S+) in \@INC/g); - - ### make sure every missing prereq is only + + ### make sure every missing prereq is only ### listed once { my %seen; @list = grep { !$seen{$_}++ } @list @@ -162,7 +162,7 @@ use constant MISSING_PREREQS_LIST use constant MISSING_EXTLIBS_LIST => sub { my $buffer = shift; - my @list = + my @list = ($buffer =~ m/No library found for -l([-\w]+)/g); @@ -175,9 +175,9 @@ use constant REPORT_MESSAGE_HEADER return << "."; Dear $author, - + This is a computer-generated error report created automatically by -CPANPLUS, version $version. Testers personal comments may appear +CPANPLUS, version $version. Testers personal comments may appear at the end of this report. . @@ -200,32 +200,15 @@ $buffer . }; -use constant REPORT_MESSAGE_PASS_HEADER - => sub { - my($stage, $buffer) = @_; - return << "."; - -Thank you for uploading your work to CPAN. Congratulations! -All tests were successful. - -TEST RESULTS: - -Below is the error stack from stage '$stage': - -$buffer - -. - }; - use constant REPORT_MISSING_PREREQS => sub { my ($author,$email,@missing) = @_; - $author = ($author && $email) - ? "$author ($email)" + $author = ($author && $email) + ? "$author ($email)" : 'Your Name Here'; - + my $modules = join "\n", @missing; - my $prereqs = join "\n", + my $prereqs = join "\n", map {"\t'$_'\t=> '0',". " # or a minimum working version"} @missing; @@ -259,7 +242,7 @@ use constant REPORT_MISSING_TESTS return << "."; RECOMMENDATIONS: -It would be very helpful if you could include even a simple test +It would be very helpful if you could include even a simple test script in the next release, so people can verify which platforms can successfully install them, as well as avoid regression bugs? @@ -283,7 +266,7 @@ Thanks! :-) . }; -use constant REPORT_LOADED_PREREQS +use constant REPORT_LOADED_PREREQS => sub { my $mod = shift; my $cb = $mod->parent; @@ -291,13 +274,13 @@ use constant REPORT_LOADED_PREREQS ### not every prereq may be coming from CPAN ### so maybe we wont find it in our module - ### tree at all... + ### tree at all... ### skip ones that cant be found in teh list ### as reported in #12723 my @prq = grep { defined } map { $cb->module_tree($_) } sort keys %$prq; - + ### no prereqs? return '' unless @prq; @@ -305,27 +288,27 @@ use constant REPORT_LOADED_PREREQS my $str = << "."; PREREQUISITES: -Here is a list of prerequisites you specified and versions we +Here is a list of prerequisites you specified and versions we managed to load: - + . - $str .= join '', - map { sprintf "\t%s %-30s %8s %8s\n", + $str .= join '', + map { sprintf "\t%s %-30s %8s %8s\n", @$_ - + } [' ', 'Module Name', 'Have', 'Want'], map { my $want = $prq->{$_->name}; - [ do { $_->is_uptodate( + [ do { $_->is_uptodate( version => $want - ) ? ' ' : '!' + ) ? ' ' : '!' }, $_->name, $_->installed_version, $want ], ### might be empty entries in there - } grep { $_ } @prq; - + } grep { $_ } @prq; + return $str; }; @@ -347,8 +330,6 @@ use constant REPORT_TOOLCHAIN_VERSIONS ExtUtils::ParseXS File::Spec Module::Build - Pod::Parser - Pod::Simple Test::Harness Test::More version @@ -367,23 +348,23 @@ use constant REPORT_TOOLCHAIN_VERSIONS Perl module toolchain versions installed: . - $str .= join '', - map { sprintf "\t%-30s %8s\n", + $str .= join '', + map { sprintf "\t%-30s %8s\n", @$_ - + } ['Module Name', 'Have'], map { [ $_->name, $_->installed_version, ], ### might be empty entries in there - } @toolchain; - + } @toolchain; + return $str; }; -use constant REPORT_TESTS_SKIPPED +use constant REPORT_TESTS_SKIPPED => sub { return << "."; @@ -395,7 +376,7 @@ use constant REPORT_TESTS_SKIPPED . }; - + use constant REPORT_MESSAGE_FOOTER => sub { return << "."; @@ -403,7 +384,7 @@ use constant REPORT_MESSAGE_FOOTER ******************************** NOTE ******************************** The comments above are created mechanically, possibly without manual checking by the sender. As there are many people performing automatic -tests on each upload to CPAN, it is likely that you will receive +tests on each upload to CPAN, it is likely that you will receive identical messages about the same problem. If you believe that the message is mistaken, please reply to the first @@ -412,7 +393,7 @@ it personally. We appreciate your patience. :) ********************************************************************** Additional comments: - + . }; diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Internals/Source/SQLite.pm b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Internals/Source/SQLite.pm index 50f82f485c9..a0ddf499bf6 100644 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Internals/Source/SQLite.pm +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Internals/Source/SQLite.pm @@ -1,5 +1,4 @@ package CPANPLUS::Internals::Source::SQLite; -use deprecate; use strict; use warnings; @@ -17,12 +16,9 @@ use DBD::SQLite; use Params::Check qw[allow check]; use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext'; -use vars qw[$VERSION]; -$VERSION = "0.9135"; - use constant TXN_COMMIT => 1000; -=head1 NAME +=head1 NAME CPANPLUS::Internals::Source::SQLite - SQLite implementation @@ -31,23 +27,23 @@ CPANPLUS::Internals::Source::SQLite - SQLite implementation { my $Dbh; my $DbFile; - sub __sqlite_file { + sub __sqlite_file { return $DbFile if $DbFile; my $self = shift; my $conf = $self->configure_object; - $DbFile = File::Spec->catdir( + $DbFile = File::Spec->catdir( $conf->get_conf('base'), SOURCE_SQLITE_DB ); - + return $DbFile; }; - sub __sqlite_dbh { + sub __sqlite_dbh { return $Dbh if $Dbh; - + my $self = shift; $Dbh = DBIx::Simple->connect( "dbi:SQLite:dbname=" . $self->__sqlite_file, @@ -55,17 +51,9 @@ CPANPLUS::Internals::Source::SQLite - SQLite implementation { AutoCommit => 1 } ); #$Dbh->dbh->trace(1); - $Dbh->query(qq{PRAGMA synchronous = OFF}); - return $Dbh; + return $Dbh; }; - - sub __sqlite_disconnect { - return unless $Dbh; - $Dbh->disconnect; - $Dbh = undef; - return; - } } { my $used_old_copy = 0; @@ -74,7 +62,7 @@ CPANPLUS::Internals::Source::SQLite - SQLite implementation my $self = shift; my $conf = $self->configure_object; my %hash = @_; - + my($path,$uptodate,$verbose,$use_stored); my $tmpl = { path => { default => $conf->get_conf('base'), store => \$path }, @@ -82,60 +70,59 @@ CPANPLUS::Internals::Source::SQLite - SQLite implementation uptodate => { required => 1, store => \$uptodate }, use_stored => { default => 1, store => \$use_stored }, }; - + check( $tmpl, \%hash ) or return; ### if it's not uptodate, or the file doesn't exist, we need to create ### a new sqlite db - if( not $uptodate or not -e $self->__sqlite_file ) { + if( not $uptodate or not -e $self->__sqlite_file ) { $used_old_copy = 0; ### chuck the file - $self->__sqlite_disconnect; 1 while unlink $self->__sqlite_file; - + ### and create a new one $self->__sqlite_create_db or do { error(loc("Could not create new SQLite DB")); - return; - } + return; + } } else { $used_old_copy = 1; - } - + } + ### set up the author tree { my %at; tie %at, 'CPANPLUS::Internals::Source::SQLite::Tie', - dbh => $self->__sqlite_dbh, table => 'author', + dbh => $self->__sqlite_dbh, table => 'author', key => 'cpanid', cb => $self; - + $self->_atree( \%at ); } ### set up the author tree { my %mt; tie %mt, 'CPANPLUS::Internals::Source::SQLite::Tie', - dbh => $self->__sqlite_dbh, table => 'module', + dbh => $self->__sqlite_dbh, table => 'module', key => 'module', cb => $self; $self->_mtree( \%mt ); } - + ### start a transaction $self->__sqlite_dbh->query('BEGIN'); - - return 1; - + + return 1; + } - + sub _standard_trees_completed { return $used_old_copy } sub _custom_trees_completed { return } ### finish transaction - sub _finalize_trees { $_[0]->__sqlite_dbh->commit; return 1 } + sub _finalize_trees { $_[0]->__sqlite_dbh->query('COMMIT'); return 1 } ### saves current memory state, but not implemented in sqlite - sub _save_state { - error(loc("%1 has not implemented writing state to disk", __PACKAGE__)); + sub _save_state { + error(loc("%1 has not implemented writing state to disk", __PACKAGE__)); return; } } @@ -149,7 +136,7 @@ CPANPLUS::Internals::Source::SQLite - SQLite implementation class => { default => 'CPANPLUS::Module::Author', store => \$class }, map { $_ => { required => 1 } } @keys }; - + ### dbix::simple's expansion of (??) is REALLY expensive, so do it manually my $ph = join ',', map { '?' } @keys; @@ -158,9 +145,9 @@ CPANPLUS::Internals::Source::SQLite - SQLite implementation my $self = shift; my %hash = @_; my $dbh = $self->__sqlite_dbh; - + my $href = do { - local $Params::Check::NO_DUPLICATES = 1; + local $Params::Check::NO_DUPLICATES = 1; local $Params::Check::SANITY_CHECK_TEMPLATE = 0; check( $tmpl, \%hash ) or return; }; @@ -168,18 +155,18 @@ CPANPLUS::Internals::Source::SQLite - SQLite implementation ### keep counting how many we inserted unless( ++$txn_count % TXN_COMMIT ) { #warn "Committing transaction $txn_count"; - $dbh->commit or error( $dbh->error ); # commit previous transaction - $dbh->begin_work or error( $dbh->error ); # and start a new one + $dbh->query('COMMIT') or error( $dbh->error ); # commit previous transaction + $dbh->query('BEGIN') or error( $dbh->error ); # and start a new one } - - $dbh->query( + + $dbh->query( "INSERT INTO author (". join(',',keys(%$href)) .") VALUES ($ph)", values %$href ) or do { error( $dbh->error ); return; }; - + return 1; } } @@ -187,13 +174,13 @@ CPANPLUS::Internals::Source::SQLite - SQLite implementation { my $txn_count = 0; ### XXX move this outside the sub, so we only compute it once - my $class; + my $class; my @keys = qw[ module version path comment author package description dslip mtime ]; my $tmpl = { class => { default => 'CPANPLUS::Module', store => \$class }, map { $_ => { required => 1 } } @keys }; - + ### dbix::simple's expansion of (??) is REALLY expensive, so do it manually my $ph = join ',', map { '?' } @keys; @@ -201,50 +188,51 @@ CPANPLUS::Internals::Source::SQLite - SQLite implementation my $self = shift; my %hash = @_; my $dbh = $self->__sqlite_dbh; - + my $href = do { local $Params::Check::NO_DUPLICATES = 1; local $Params::Check::SANITY_CHECK_TEMPLATE = 0; check( $tmpl, \%hash ) or return; }; - + ### fix up author to be 'plain' string $href->{'author'} = $href->{'author'}->cpanid; ### keep counting how many we inserted unless( ++$txn_count % TXN_COMMIT ) { #warn "Committing transaction $txn_count"; - $dbh->commit or error( $dbh->error ); # commit previous transaction - $dbh->begin_work or error( $dbh->error ); # and start a new one + $dbh->query('COMMIT') or error( $dbh->error ); # commit previous transaction + $dbh->query('BEGIN') or error( $dbh->error ); # and start a new one } - - $dbh->query( - "INSERT INTO module (". join(',',keys(%$href)) .") VALUES ($ph)", + + $dbh->query( + "INSERT INTO module (". join(',',keys(%$href)) .") VALUES ($ph)", values %$href ) or do { error( $dbh->error ); return; }; - + return 1; } } { my %map = ( - _source_search_module_tree + _source_search_module_tree => [ module => module => 'CPANPLUS::Module' ], - _source_search_author_tree + _source_search_author_tree => [ author => cpanid => 'CPANPLUS::Module::Author' ], - ); + ); while( my($sub, $aref) = each %map ) { no strict 'refs'; - + my($table, $key, $class) = @$aref; *$sub = sub { my $self = shift; my %hash = @_; - + my $dbh = $self->__sqlite_dbh; + my($list,$type); my $tmpl = { allow => { required => 1, default => [ ], strict_type => 1, @@ -252,25 +240,19 @@ CPANPLUS::Internals::Source::SQLite - SQLite implementation type => { required => 1, allow => [$class->accessors()], store => \$type }, }; - + check( $tmpl, \%hash ) or return; - - + + ### we aliased 'module' to 'name', so change that here too $type = 'module' if $type eq 'name'; - - my $meth = $table .'_tree'; - - { - my $throw = $self->$meth; - } - - my $dbh = $self->__sqlite_dbh; + my $res = $dbh->query( "SELECT * from $table" ); - - my @rv = map { $self->$meth( $_->{$key} ) } + + my $meth = $table .'_tree'; + my @rv = map { $self->$meth( $_->{$key} ) } grep { allow( $_->{$type} => $list ) } $res->hashes; - + return @rv; } } @@ -281,29 +263,29 @@ CPANPLUS::Internals::Source::SQLite - SQLite implementation sub __sqlite_create_db { my $self = shift; my $dbh = $self->__sqlite_dbh; - - ### we can ignore the result/error; not all sqlite implementations - ### support this + + ### we can ignore the result/error; not all sqlite implemantation + ### support this $dbh->query( qq[ DROP TABLE IF EXISTS author; \n] ) or do { msg( $dbh->error ); - }; + }; $dbh->query( qq[ DROP TABLE IF EXISTS module; \n] ) or do { msg( $dbh->error ); - }; - + }; + $dbh->query( qq[ /* the author information */ CREATE TABLE author ( id INTEGER PRIMARY KEY AUTOINCREMENT, - + author varchar(255), email varchar(255), cpanid varchar(255) @@ -319,7 +301,7 @@ sub __sqlite_create_db { /* the module information */ CREATE TABLE module ( id INTEGER PRIMARY KEY AUTOINCREMENT, - + module varchar(255), version varchar(255), path varchar(255), @@ -330,54 +312,15 @@ sub __sqlite_create_db { dslip varchar(255), mtime varchar(255) ); - - \n] - - ) or do { - error( $dbh->error ); - return; - }; - - $dbh->query( qq[ - /* the module index */ - CREATE INDEX IX_module_module ON module ( - module - ); - - \n] - - ) or do { - error( $dbh->error ); - return; - }; - - $dbh->query( qq[ - /* the version index */ - CREATE INDEX IX_module_version ON module ( - version - ); - - \n] - - ) or do { - error( $dbh->error ); - return; - }; - - $dbh->query( qq[ - /* the module-version index */ - CREATE INDEX IX_module_module_version ON module ( - module, version - ); - + \n] ) or do { error( $dbh->error ); return; - }; - - return 1; + }; + + return 1; } 1; diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Internals/Source/SQLite/Tie.pm b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Internals/Source/SQLite/Tie.pm index b44b04bd58e..f908c9803e4 100644 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Internals/Source/SQLite/Tie.pm +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Internals/Source/SQLite/Tie.pm @@ -1,5 +1,4 @@ package CPANPLUS::Internals::Source::SQLite::Tie; -use deprecate; use strict; use warnings; @@ -10,21 +9,24 @@ use CPANPLUS::Module::Fake; use CPANPLUS::Module::Author::Fake; use CPANPLUS::Internals::Constants; + use Params::Check qw[check]; use Module::Load::Conditional qw[can_load]; use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext'; -use vars qw[@ISA $VERSION]; -$VERSION = "0.9135"; + +use Data::Dumper; +$Data::Dumper::Indent = 1; require Tie::Hash; +use vars qw[@ISA]; push @ISA, 'Tie::StdHash'; sub TIEHASH { my $class = shift; my %hash = @_; - + my $tmpl = { dbh => { required => 1 }, table => { required => 1 }, @@ -32,12 +34,12 @@ sub TIEHASH { cb => { required => 1 }, offset => { default => 0 }, }; - + my $args = check( $tmpl, \%hash ) or return; my $obj = bless { %$args, store => {} } , $class; return $obj; -} +} sub FETCH { my $self = shift; @@ -45,28 +47,28 @@ sub FETCH { my $dbh = $self->{dbh}; my $cb = $self->{cb}; my $table = $self->{table}; - - + + ### did we look this one up before? if( my $obj = $self->{store}->{$key} ) { return $obj; } - + my $res = $dbh->query( "SELECT * from $table where $self->{key} = ?", $key ) or do { error( $dbh->error ); return; }; - + my $href = $res->hash; - + ### get rid of the primary key delete $href->{'id'}; - + ### no results? return unless keys %$href; - + ### expand author if needed ### XXX no longer generic :( if( $table eq 'module' ) { @@ -78,16 +80,16 @@ sub FETCH { author => 'CPANPLUS::Module::Author', }->{ $table }; - my $obj = $self->{store}->{$key} = $class->new( %$href, _id => $cb->_id ); - + my $obj = $self->{store}->{$key} = $class->new( %$href, _id => $cb->_id ); + return $obj; } -sub STORE { +sub STORE { my $self = shift; my $key = shift; my $val = shift; - + $self->{store}->{$key} = $val; } @@ -102,7 +104,7 @@ sub FIRSTKEY { ); $self->{offset} = 0; - + my $key = $res->flat->[0]; return $key; @@ -128,7 +130,7 @@ sub NEXTKEY { sub EXISTS { !!$_[0]->FETCH( $_[1] ) } -sub SCALAR { +sub SCALAR { my $self = shift; my $dbh = $self->{'dbh'}; diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Internals/Utils/Autoflush.pm b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Internals/Utils/Autoflush.pm index 8aa9030dfa3..56566436a14 100644 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Internals/Utils/Autoflush.pm +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Internals/Utils/Autoflush.pm @@ -1,8 +1,4 @@ package CPANPLUS::Internals::Utils::Autoflush; -use deprecate; - -use vars qw[$VERSION]; -$VERSION = "0.9135"; BEGIN { $|++ }; diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Module/Signature.pm b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Module/Signature.pm index 802d8cc2a60..cec6f2906b0 100644 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Module/Signature.pm +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Module/Signature.pm @@ -1,14 +1,13 @@ package CPANPLUS::Module::Signature; -use deprecate; use strict; + use Cwd; use CPANPLUS::Error; use Params::Check qw[check]; use Module::Load::Conditional qw[can_load]; -use vars qw[$VERSION]; -$VERSION = "0.9135"; + ### detached sig, not actually used afaik --kane ### #sub get_signature { diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Shell/Classic.pm b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Shell/Classic.pm index 6cdc6f69cca..08c03bcf383 100644 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Shell/Classic.pm +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Shell/Classic.pm @@ -5,7 +5,6 @@ ################################################## package CPANPLUS::Shell::Classic; -use deprecate; use strict; @@ -31,7 +30,7 @@ $Params::Check::ALLOW_UNKNOWN = 1; BEGIN { use vars qw[ $VERSION @ISA ]; @ISA = qw[ CPANPLUS::Shell::_Base::ReadLine ]; - $VERSION = "0.9135"; + $VERSION = '0.0562'; } load CPANPLUS::Shell; @@ -98,20 +97,6 @@ sub new { code => \&__ask_about_test_report, ); - if (my $histfile = $self->configure_object->get_conf( 'histfile' )) { - my $term = $self->term; - if ($term->can('AddHistory')) { - if (open my $fh, '<', $histfile) { - local $/ = "\n"; - while (my $line = <$fh>) { - chomp($line); - $term->AddHistory($line); - } - close($fh); - } - } - } - return $self; } @@ -209,24 +194,6 @@ sub _dispatch_on_input { ### displays quit message sub _quit { - my $self = shift; - my $term = $self->term; - - if ($term->can('GetHistory')) { - my @history = $term->GetHistory; - - my $histfile = $self->configure_object->get_conf('histfile'); - - if (open my $fh, '>', $histfile) { - foreach my $line (@history) { - print {$fh} "$line\n"; - } - close($fh); - } - else { - warn "Cannot open history file '$histfile' - $!"; - } - } ### well, that's what CPAN.pm says... print "Lockfile removed\n"; @@ -1240,10 +1207,10 @@ This module by Jos Boumans E<lt>kane@cpan.orgE<gt>. =head1 COPYRIGHT -The CPAN++ interface (of which this module is a part of) is copyright (c) +The CPAN++ interface (of which this module is a part of) is copyright (c) 2001 - 2007, Jos Boumans E<lt>kane@cpan.orgE<gt>. All rights reserved. -This library is free software; you may redistribute and/or modify it +This library is free software; you may redistribute and/or modify it under the same terms as Perl itself. =head1 SEE ALSO diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Shell/Default/Plugins/HOWTO.pod b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Shell/Default/Plugins/HOWTO.pod index 8000aac9884..ca765f9e0ac 100644 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Shell/Default/Plugins/HOWTO.pod +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Shell/Default/Plugins/HOWTO.pod @@ -5,20 +5,20 @@ CPANPLUS::Shell::Default::Plugins::HOWTO -- documentation on how to write your o =head1 SYNOPSIS package CPANPLUS::Shell::Default::Plugins::MyPlugin; - + ### return command => method mapping sub plugins { ( myplugin1 => 'mp1', myplugin2 => 'mp2' ) } - + ### method called when the command '/myplugin1' is issued sub mp1 { .... } ### method called when the command '/? myplugin1' is issued sub mp1_help { return "Help Text" } - + =head1 DESCRIPTION -This pod text explains how to write your own plugins for -C<CPANPLUS::Shell::Default>. +This pod text explains how to write your own plugins for +C<CPANPLUS::Shell::Default>. =head1 HOWTO @@ -34,18 +34,18 @@ C<.pm> file. =head2 Registering Plugin Commands To register any plugin commands, a list of key value pairs must be returned -by a C<plugins> method in your package. The keys are the commands you wish +by a C<plugins> method in your package. The keys are the commands you wish to register, the values are the methods in the plugin package you wish to have called when the command is issued. For example, a simple 'Hello, World!' plugin: package CPANPLUS::Shell::Default::Plugins::HW; - + sub plugins { return ( helloworld => 'hw' ) }; - + sub hw { print "Hello, world!\n" } - + When the user in the default shell now issues the C</helloworld> command, this command will be dispatched to the plugin, and its C<hw> method will be called @@ -60,7 +60,7 @@ For example, extending the above example, when a user calls C</? helloworld>, the function C<hw_help> will be called, which might look like this: sub hw_help { " /helloworld # prints "Hello, world!\n" } - + If you dont provide a corresponding _help function to your commands, the default shell will handle it gracefully, but the user will be stuck without usage information on your commands, so it's considered undesirable to omit @@ -90,8 +90,8 @@ are all positional: For example, the following command: /helloworld bob --nofoo --bar=2 joe - -Would yield the following arguments: + +Would yield the following arguments: sub hw { my $class = shift; # CPANPLUS::Shell::Default::Plugins::HW @@ -115,10 +115,10 @@ This module by Jos Boumans E<lt>kane@cpan.orgE<gt>. =head1 COPYRIGHT -The CPAN++ interface (of which this module is a part of) is copyright (c) +The CPAN++ interface (of which this module is a part of) is copyright (c) 2001 - 2007, Jos Boumans E<lt>kane@cpan.orgE<gt>. All rights reserved. -This library is free software; you may redistribute and/or modify it +This library is free software; you may redistribute and/or modify it under the same terms as Perl itself. =head1 SEE ALSO diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/t/00_CPANPLUS-Internals-Utils.t b/gnu/usr.bin/perl/cpan/CPANPLUS/t/00_CPANPLUS-Internals-Utils.t index e15dcb2fc06..8e372fe0fdc 100755 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/t/00_CPANPLUS-Internals-Utils.t +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/t/00_CPANPLUS-Internals-Utils.t @@ -1,6 +1,6 @@ ### make sure we can find our conf.pl file -BEGIN { - use FindBin; +BEGIN { + use FindBin; require "$FindBin::Bin/inc/conf.pl"; } @@ -8,7 +8,7 @@ use strict; ### 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 => 48; +use Test::More tests => 40; use Cwd; use Data::Dumper; @@ -67,11 +67,11 @@ rmdir $Dir if -d $Dir; } ### test _chdir ### -{ ok( $Class->_chdir( dir => $Dir), "Chdir to '$Dir'" ); +{ ok( $Class->_chdir( dir => $Dir), "Chdir to '$Dir'" ); my $abs = File::Spec->rel2abs(File::Spec->catdir($Cwd,$Dir)); paths_are_same( File::Spec->rel2abs(cwd()), $abs, - " Cwd() is '$Dir'"); + " Cwd() is '$Dir'"); ok( $Class->_chdir( dir => $Cwd), "Chdir back to '$Cwd'" ); paths_are_same( File::Spec->rel2abs(cwd()), $Cwd, @@ -83,18 +83,18 @@ rmdir $Dir if -d $Dir; "Move from '$Dir' to '$Move'" ); ok( -d $Move, " Dir '$Move' exists" ); ok( !-d $Dir, " Dir '$Dir' no longer exists" ); - - + + { local $CPANPLUS::Error::ERROR_FH = output_handle(); - + ### now try to move it somewhere it can't ### ok( !$Class->_move( file => $Move, to => 'inc' ), " Impossible move detected" ); like( CPANPLUS::Error->stack_as_string, qr/Failed to move/, " Expected error found" ); } -} - +} + ### test _rmdir ### { ok( -d $Move, "Dir '$Move' exists" ); ok( $Class->_rmdir( dir => $Move ), " Deleted dir '$Move'" ); @@ -107,75 +107,71 @@ rmdir $Dir if -d $Dir; like( $contents, qr/BEGIN/, " Proper contents found" ); like( $contents, qr/CPANPLUS/, " Proper contents found" ); } - + ### _perl_version tests ### { my $version = $Class->_perl_version( perl => $^X ); ok( $version, "Perl version found" ); like( $version, qr/\d.\d+.\d+/, " Looks like a proper version" ); -} - +} + ### _version_to_number tests ### { my $map = { - '1' => '1', - '1.2' => '1.2', - '.2' => '.2', - 'foo' => '0.0', - 'a.1' => '0.0', - '1.2.3' => '1.002003', - 'v1.2.3' => '1.002003', - 'v1.5' => '1.005000', - '1.5-a' => '1.500', - }; + '1' => '1', + '1.2' => '1.2', + '.2' => '.2', + 'foo' => '0.0', + 'a.1' => '0.0', + }; while( my($try,$expect) = each %$map ) { my $ver = $Class->_version_to_number( version => $try ); ok( $ver, "Version returned" ); is( $ver, $expect, " Value as expected" ); - } + } } ### _whoami tests ### -{ sub foo { - my $me = $Class->_whoami; +{ sub foo { + my $me = $Class->_whoami; ok( $me, "_whoami returned a result" ); - is( $me, 'foo', " Value as expected" ); - } + is( $me, 'foo', " Value as expected" ); + } foo(); } - + ### _mode_plus_w tests ### { open my $fh, ">$File" or die "Could not open $File for writing: $!"; close $fh; - + ### remove perms ok( -e $File, "File '$File' created" ); ok( chmod( 000, $File ), " File permissions set to 000" ); - + ok( $Class->_mode_plus_w( file => $File ), " File permissions set to +w" ); ok( -w $File, " File is writable" ); 1 while unlink $File; - + ok( !-e $File, " File removed" ); } -### uri encode/decode tests +### 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" ); -} - - +} + + # Local variables: # c-indentation-style: bsd # c-basic-offset: 4 diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/t/01_CPANPLUS-Configure.t b/gnu/usr.bin/perl/cpan/CPANPLUS/t/01_CPANPLUS-Configure.t index 152a9ac632f..fc02640c7aa 100755 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/t/01_CPANPLUS-Configure.t +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/t/01_CPANPLUS-Configure.t @@ -1,6 +1,6 @@ ### make sure we can find our conf.pl file -BEGIN { - use FindBin; +BEGIN { + use FindBin; require "$FindBin::Bin/inc/conf.pl"; } @@ -15,7 +15,7 @@ my $Config_pm = 'CPANPLUS/Config.pm'; for my $mod (qw[CPANPLUS::Configure]) { use_ok($mod) or diag qq[Can't load $mod]; -} +} my $c = CPANPLUS::Configure->new(); isa_ok($c, 'CPANPLUS::Configure'); @@ -38,33 +38,33 @@ for my $cat ( $r->ls_accessors ) { ### copy for use on the config object itself my $accessor = $cat; my $prepend = ($cat =~ s/^_//) ? '_' : ''; - + my $getmeth = $prepend . 'get_'. $cat; my $setmeth = $prepend . 'set_'. $cat; my $addmeth = $prepend . 'add_'. $cat; - + ok( scalar(@options), "Possible options obtained" ); - + ### test adding keys too ### { my $add_key = 'test_key'; my $add_val = [1..3]; - + my $found = grep { $add_key eq $_ } @options; ok( !$found, "Key '$add_key' not yet defined" ); ok( $c->$addmeth( $add_key => $add_val ), - " $addmeth('$add_key' => VAL)" ); + " $addmeth('$add_key' => VAL)" ); ### this one now also exists ### push @options, $add_key } - ### poke in the object, get the actual hashref out ### + ### poke in the object, get the actual hashref out ### my %hash = map { - $_ => $r->$accessor->$_ + $_ => $r->$accessor->$_ } $r->$accessor->ls_accessors; - + while( my ($key,$val) = each %hash ) { - my $is = $c->$getmeth($key); + my $is = $c->$getmeth($key); is_deeply( $val, $is, "deep check for '$key'" ); ok( $c->$setmeth($key => 1 ), " $setmeth('$key' => 1)" ); is( $c->$getmeth($key), 1, " $getmeth('$key')" ); @@ -74,15 +74,15 @@ for my $cat ( $r->ls_accessors ) { ### now check if we found all the keys with options or not ### delete $hash{$_} for @options; ok( !(scalar keys %hash), "All possible keys found" ); - -} + +} ### see if we can save the config ### { my $dir = File::Spec->rel2abs('dummy-cpanplus'); my $pm = 'CPANPLUS::Config::Test' . $$; my $file = $c->save( $pm, $dir ); - + ok( $file, "Config $pm saved" ); ok( -e $file, " File exists" ); ok( -s $file, " File has size" ); @@ -92,23 +92,23 @@ for my $cat ( $r->ls_accessors ) { ok( $c->init( rescan => 1 ), "Reran ->init()" ); } - + ### make sure this file is now loaded - ### XXX can't trust bloody dir separators on Win32 in %INC, + ### XXX can't trust bloody dir seperators on Win32 in %INC, ### so rather than an exact match, do a grep... - my ($found) = grep /\bTest$$/, values %INC; + my ($found) = grep /\bTest$$/, values %INC; ok( $found, " Found $file in \%INC" ); ok( -e $file, " File exists" ); 1 while unlink $file; ok(!-e $file, " File removed" ); - + } { my $env = ENV_CPANPLUS_CONFIG; local $ENV{$env} = $$; my $ok = $c->init; my $stack = CPANPLUS::Error->stack_as_string; - + ok( $ok, "Reran init again" ); like( $stack, qr/Specifying a config file in your environment/, " Warning logged" ); @@ -116,16 +116,16 @@ for my $cat ( $r->ls_accessors ) { { CPANPLUS::Error->flush; - - { ### try a bogus method call + + { ### try a bogus method call my $x = $c->flubber('foo'); my $err = CPANPLUS::Error->stack_as_string; is ($x, undef, "Bogus method call returns undef"); like($err, "/flubber/", " Bogus method call recognized"); } - + CPANPLUS::Error->flush; -} +} # Local variables: diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/t/02_CPANPLUS-Internals.t b/gnu/usr.bin/perl/cpan/CPANPLUS/t/02_CPANPLUS-Internals.t index 46a7cb6e208..84b78f3ade3 100755 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/t/02_CPANPLUS-Internals.t +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/t/02_CPANPLUS-Internals.t @@ -1,6 +1,6 @@ ### make sure we can find our conf.pl file -BEGIN { - use FindBin; +BEGIN { + use FindBin; require "$FindBin::Bin/inc/conf.pl"; } @@ -23,21 +23,21 @@ is($cb->_id, $cb->_last_id, "Comparing ID's"); ok( $del, "ID deleted" ); isa_ok( $del, "CPANPLUS::Internals" ); is( $del, $cb, " Deleted ID matches last object" ); - + my $id = $cb->_store_id( $del ); ok( $id, "ID stored" ); is( $id, $cb->_id, " Stored proper ID" ); - + my $obj = $cb->_retrieve_id( $id ); ok( $obj, "Object retrieved from ID" ); isa_ok( $obj, 'CPANPLUS::Internals' ); is( $obj->_id, $id, " Retrieved ID properly" ); - + my @obs = $cb->_return_all_objects(); ok( scalar(@obs), "Returned objects" ); is( scalar(@obs), 1, " Proper amount of objects found" ); is( $obs[0]->_id, $id, " Proper ID found on object" ); - + my $lid = $cb->_last_id; ok( $lid, "Found last registered ID" ); is( $lid, $id, " ID matches last object" ); @@ -45,29 +45,29 @@ is($cb->_id, $cb->_last_id, "Comparing ID's"); my $iid = $cb->_inc_id; ok( $iid, "Incremented ID" ); is( $iid, $id+1, " ID matched last ID + 1" ); -} +} ### host ok test ### { my $host = $cb->configure_object->get_conf('hosts')->[0]; - + is( $cb->_host_ok( host => $host ), 1, "Host ok" ); is( $cb->_add_fail_host(host => $host), 1, " Host now marked as bad" ); is( $cb->_host_ok( host => $host ), 0, " Host still bad" ); ok( $cb->_flush( list => ['hosts'] ), " Hosts flushed" ); is( $cb->_host_ok( host => $host ), 1, " Host now ok again" ); -} +} ### flush loads test { my $mod = 'Benchmark'; my $file = $mod . '.pm'; - + ### XXX whitebox test -- mark this module as unloadable $Module::Load::Conditional::CACHE->{$mod}->{usable} = 0; ok( !can_load( modules => { $mod => 0 }, verbose => 0 ), "'$mod' not loaded" ); - + ok( $cb->flush('load'), " 'load' cache flushed" ); ok( can_load( modules => { $mod => 0 }, verbose => 0 ), " '$mod' loaded" ); @@ -76,30 +76,30 @@ is($cb->_id, $cb->_last_id, "Comparing ID's"); ### add to inc path tests { my $meth = '_add_to_includepath'; can_ok( $cb, $meth ); - + my $p5lib = $ENV{PERL5LIB} || ''; - my $inc = "@INC"; - ok( $cb->$meth( directories => [$$] ), + my $inc = "@INC"; + ok( $cb->$meth( directories => [$$] ), " CB->$meth( $$ )" ); - + my $new_p5lib = $ENV{PERL5LIB}; - my $new_inc = "@INC"; + my $new_inc = "@INC"; isnt( $p5lib, $new_p5lib, " PERL5LIB is now: $new_p5lib" ); like( $new_p5lib, qr/$$/, " Matches $$" ); isnt( $inc, $new_inc, ' @INC is expanded with: ' . $$ ); like( $new_inc, qr/$$/, " Matches $$" ); - - ok( $cb->$meth( directories => [$$] ), + + ok( $cb->$meth( directories => [$$] ), " CB->$meth( $$ ) again" ); is( "@INC", $new_inc, ' @INC unchanged' ); is( $new_p5lib, $ENV{PERL5LIB}, " PERL5LIB unchanged" ); -} +} ### callback registering tests ### { my $callback_map = { - ### name default value + ### name default value install_prerequisite => 1, # install prereqs when 'ask' is set? edit_test_report => 0, # edit the prepared test report? send_test_report => 1, # send the test report? @@ -110,32 +110,32 @@ is($cb->_id, $cb->_last_id, "Comparing ID's"); }; for my $callback ( keys %$callback_map ) { - + { my $rv = $callback_map->{$callback}; is( $rv, $cb->_callbacks->$callback->( $0, $$ ), "Default callback '$callback' called" ); - like( CPANPLUS::Error->stack_as_string, qr/DEFAULT '\S+' HANDLER/s, - " Default handler warning recorded" ); + like( CPANPLUS::Error->stack_as_string, qr/DEFAULT '\S+' HANDLER/s, + " Default handler warning recorded" ); CPANPLUS::Error->flush; } - + ### try to register the callback my $ok = $cb->_register_callback( name => $callback, code => sub { return $callback } ); - + ok( $ok, "Registered callback '$callback' ok" ); - + my $sub = $cb->_callbacks->$callback; ok( $sub, " Retrieved callback" ); ok( IS_CODEREF->($sub), " Callback is a sub" ); - + my $rv = $sub->(); ok( $rv, " Callback called ok" ); is( $rv, $callback, " Got expected return value" ); - } + } } diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/t/03_CPANPLUS-Internals-Source.t b/gnu/usr.bin/perl/cpan/CPANPLUS/t/03_CPANPLUS-Internals-Source.t index d6ad2ea94f6..65f1e54c352 100755 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/t/03_CPANPLUS-Internals-Source.t +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/t/03_CPANPLUS-Internals-Source.t @@ -1,14 +1,14 @@ ### make sure we can find our conf.pl file -BEGIN { - use FindBin; +BEGIN { + use FindBin; require "$FindBin::Bin/inc/conf.pl"; } use strict; use Module::Load; -use Test::More eval { - load $ENV{CPANPLUS_SOURCE_ENGINE} if $ENV{CPANPLUS_SOURCE_ENGINE}; 1 +use Test::More eval { + load $ENV{CPANPLUS_SOURCE_ENGINE} if $ENV{CPANPLUS_SOURCE_ENGINE}; 1 } ? 'no_plan' : (skip_all => "SQLite engine not available"); @@ -20,7 +20,6 @@ use Data::Dumper; use File::Basename qw[dirname]; my $conf = gimme_conf(); -$conf->set_conf( enable_custom_sources => 1 ); my $cb = CPANPLUS::Backend->new( $conf ); ### XXX temp @@ -36,12 +35,12 @@ my $modname = TEST_CONF_MODULE; ### source files should be copied from the 'server' now for my $name (qw[auth mod dslip] ) { - my $file = File::Spec->catfile( + my $file = File::Spec->catfile( $conf->get_conf('base'), $conf->_get_source($name) - ); + ); ok( (-e $file && -f _ && -s _), "$file exists" ); - } + } ok( $at, "Authortree loaded successfully" ); ok( scalar keys %$at, " Authortree has items in it" ); @@ -56,7 +55,7 @@ my $modname = TEST_CONF_MODULE; } ### save state tests -SKIP: { +SKIP: { skip "Save state tests for custom engine $ENV{CPANPLUS_SOURCE_ENGINE}", 7 if $ENV{CPANPLUS_SOURCE_ENGINE}; @@ -74,44 +73,44 @@ SKIP: { my $rv = $cb->save_state; ok( $rv, " State information saved" ); - - like( CPANPLUS::Error->stack_as_string, qr/Writing compiled source/, + + like( CPANPLUS::Error->stack_as_string, qr/Writing compiled source/, " Diagnostics confirmed" ); } - + ### now we rebuild the trees from disk and ### check if the module object has a status saved with it { CPANPLUS::Error->flush; ok( $cb->_build_trees( uptodate => 1, use_stored => 1), " Trees are rebuilt" ); - like( CPANPLUS::Error->stack_as_string, qr/Retrieving/, + like( CPANPLUS::Error->stack_as_string, qr/Retrieving/, " Diagnostics confirmed" ); - + my $mod = $cb->_module_tree->{$modname}; ok( $mod->status, " Status now set in module object" ); - } + } } ### check custom sources ### XXX whitebox test -SKIP: { +SKIP: { ### first, find a file to serve as a source my $mod = $cb->_module_tree->{$modname}; my $package = File::Spec->rel2abs( - File::Spec->catfile( + 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 + ### remote uri my $uri = $cb->_host_to_uri( scheme => 'file', host => '', @@ -119,25 +118,25 @@ SKIP: { ); my $expected_file = $cb->__custom_module_source_index_file( uri => $uri ); - + ok( $expected_file, "Sources should be written to '$uri'" ); - + skip( "Index file size too long (>260 chars). Can't write to disk", 28 ) if length $expected_file > 260 and ON_WIN32; + - - ### local file + ### local file ### 2 tests 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 + ok( $src_file, "Sources written to '$src_file'" ); + ok( -e $src_file, " File exists" ); + + ### and write the file ### 5 tests { my $meth = '__write_custom_module_index'; can_ok( $cb, $meth ); - my $rv = $cb->$meth( + my $rv = $cb->$meth( path => dirname( $package ), to => $src_file ); @@ -146,26 +145,26 @@ SKIP: { 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 ### 3 tests { my $meth = '__list_custom_module_sources'; can_ok( $cb, $meth ); - + my %files = $cb->$meth; ok( scalar(keys(%files)), " Got list of sources" ); - + ### on VMS, we can't predict the case unfortunately ### so grep for it instead; - my $found = map { + my $found = map { my $src_re = quotemeta($src_file); $_ =~ /$src_re/i; } keys %files; ok( $found, " Found proper entry for $src_file" ); - } + } ### now we can have it be loaded in ### 6 tests @@ -179,7 +178,7 @@ SKIP: { my $add = $cb->_module_tree->{$add_name}; ok( $add, " Found added module" ); - ok( $add->status->_fetch_from, + ok( $add->status->_fetch_from, " Full download path set" ); is( $add->author->cpanid, CUSTOM_AUTHOR_ID, " Attributed to custom author" ); @@ -194,60 +193,60 @@ SKIP: { ### 3 tests { 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; + 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" ); + " Timestamp on sourcefile updated" ); } - + ### now update it individually - ### 3 tests + ### 3 tests { 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; + 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" ); + " Timestamp on sourcefile updated" ); } ### now update using the higher level API, see if it's part of the update - ### 3 tests + ### 3 tests { CPANPLUS::Error->flush; ### mark what time it is now, sleep 1 second for better measuring - my $now = time; + 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" ); + " Timestamp on sourcefile updated" ); like( CPANPLUS::Error->stack_as_string, qr/Updating sources from/, " Update recorded in the log" ); } - + ### now remove the index file; - ### 3 tests + ### 3 tests { 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" ); diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/t/04_CPANPLUS-Module.t b/gnu/usr.bin/perl/cpan/CPANPLUS/t/04_CPANPLUS-Module.t index 1014e62bdab..f45755143b5 100755 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/t/04_CPANPLUS-Module.t +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/t/04_CPANPLUS-Module.t @@ -1,6 +1,6 @@ ### make sure we can find our conf.pl file -BEGIN { - use FindBin; +BEGIN { + use FindBin; require "$FindBin::Bin/inc/conf.pl"; } @@ -21,7 +21,7 @@ my $Conf = gimme_conf(); my $CB = CPANPLUS::Backend->new( $Conf ); ### start with fresh sources ### -ok( $CB->reload_indices( update_source => 0 ), "Rebuilding trees" ); +ok( $CB->reload_indices( update_source => 0 ), "Rebuilding trees" ); my $AuthName = TEST_CONF_AUTHOR; my $Auth = $CB->author_tree( $AuthName ); @@ -48,17 +48,17 @@ isa_ok( $Auth->parent, 'CPANPLUS::Backend' ); name => $ModName, comment => undef, package => 'Foo-Bar-0.01.tar.gz', - path => 'authors/id/EUNOXS', + path => 'authors/id/EUNOXS', version => '0.01', dslip => 'cdpO ', - description => 'CPANPLUS Test Package', + description => 'CPANPLUS Test Package', mtime => '', author => $Auth, - ); + ); my @acc = $Mod->accessors; ok( scalar(@acc), "Retrieved module accessors" ); - + ### remove private accessors is_deeply( [ sort keys %map ], [ sort grep { $_ !~ /^_/ } @acc ], " About to test all accessors" ); @@ -71,7 +71,7 @@ isa_ok( $Auth->parent, 'CPANPLUS::Backend' ); ### check accessor objects ### isa_ok( $Mod->parent, 'CPANPLUS::Backend' ); isa_ok( $Mod->author, 'CPANPLUS::Module::Author' ); - is( $Mod->author->author, $Auth->author, + is( $Mod->author->author, $Auth->author, "Module eq Author" ); } @@ -89,18 +89,18 @@ isa_ok( $Auth->parent, 'CPANPLUS::Backend' ); { my $clone = $Mod->clone; ok( $clone, "Module cloned" ); isa_ok( $clone, 'CPANPLUS::Module' ); - + for my $acc ( $Mod->accessors ) { is( $clone->$acc, $Mod->$acc, " Clone->$acc matches Mod->$acc " ); } - - ### XXX whitebox test + + ### XXX whitebox test ok( !$clone->_status, "Status object empty on start" ); - + my $status = $clone->status; ok( $status, " Status object defined after query" ); - is( $status, $clone->_status, + is( $status, $clone->_status, " Object stored as expected" ); isa_ok( $status, 'Object::Accessor' ); } @@ -109,18 +109,18 @@ isa_ok( $Auth->parent, 'CPANPLUS::Backend' ); ok( !$Mod->extract(), "Cannot extract unfetched file" ); like( CPANPLUS::Error->stack_as_string, qr/You have not fetched/, " Error properly logged" ); -} +} { ### fetch tests ### ### enable signature checks for checksums ### my $old = $Conf->get_conf('signature'); - $Conf->set_conf(signature => 1); - + $Conf->set_conf(signature => 1); + my $where = $Mod->fetch( force => 1 ); ok( $where, "Module fetched" ); ok( -f $where, " Module is a file" ); ok( -s $where, " Module has size" ); - + $Conf->set_conf( signature => $old ); } @@ -142,26 +142,26 @@ isa_ok( $Auth->parent, 'CPANPLUS::Backend' ); SKIP: { skip(q[You chose not to enable checksum verification], 5) unless $Conf->get_conf('md5'); - + my $cksum_file = $Mod->checksums; ok( $cksum_file, "Checksum file found" ); is( $cksum_file, $Mod->status->checksums, " File stored in module object" ); ok( -e $cksum_file, " File exists" ); ok( -s $cksum_file, " File has size" ); - + ### XXX test checksum_value if there's digest::md5 + config wants it ok( $Mod->status->checksum_ok, " Checksum is ok" ); - - ### check ttl code for checksums; fetching it now means the cache + + ### check ttl code for checksums; fetching it now means the cache ### should kick in { CPANPLUS::Error->flush; - ok( $Mod->checksums, + ok( $Mod->checksums, " Checksums re-fetched" ); like( CPANPLUS::Error->stack_as_string, qr/Using cached file/, " Cached file used" ); - } + } } } @@ -177,14 +177,14 @@ isa_ok( $Auth->parent, 'CPANPLUS::Backend' ); SKIP: { skip(q[You chose not to enable signature checks], 1) unless $Conf->get_conf('signature'); - + ok( $Mod->check_signature, "Signature check OK" ); } } ### dslip & related -{ my $dslip = $Mod->dslip; +{ my $dslip = $Mod->dslip; ok( $dslip, "Got dslip information from $ModName ($dslip)" ); ### now find it for a submodule @@ -193,33 +193,33 @@ isa_ok( $Auth->parent, 'CPANPLUS::Backend' ); ok( $submod->dslip, " Got dslip info (".$submod->dslip.")" ); is( $submod->dslip, $dslip, " It's identical to $ModName" ); - } + } } -{ ### details() test ### +{ ### details() test ### my $href = { 'Support Level' => 'Developer', 'Package' => $Mod->package, 'Description' => $Mod->description, - 'Development Stage' => + 'Development Stage' => 'under construction but pre-alpha (not yet released)', 'Author' => sprintf("%s (%s)", $Auth->author, $Auth->email), 'Version on CPAN' => $Mod->version, - 'Language Used' => + 'Language Used' => 'Perl-only, no compiler needed, should be platform independent', - 'Interface Style' => + 'Interface Style' => 'Object oriented using blessed references and/or inheritance', - 'Public License' => 'Unknown', + 'Public License' => 'Unknown', ### XXX we can't really know what you have installed ### #'Version Installed' => '0.06', - }; + }; my $res = $Mod->details; - + ### delete they key of which we don't know the value ### delete $res->{'Version Installed'}; - - is_deeply( $res, $href, "Details OK" ); + + is_deeply( $res, $href, "Details OK" ); } { ### contians() test ### @@ -227,9 +227,9 @@ isa_ok( $Auth->parent, 'CPANPLUS::Backend' ); ### we use 4x the same package name for different modules. So use ### the only unique package name here, which is the one for the core mod my @list = $CoreMod->contains; - + ok( scalar(@list), "Found modules contained in this one" ); - is_deeply( \@list, [$CoreMod], + is_deeply( \@list, [$CoreMod], " Found all modules expected" ); } @@ -263,9 +263,9 @@ isa_ok( $Auth->parent, 'CPANPLUS::Backend' ); my @objs = $bundle->bundle_modules; is( scalar(@objs), 5, " Found all prerequisites" ); - + for( @objs ) { - isa_ok( $_, 'CPANPLUS::Module', + isa_ok( $_, 'CPANPLUS::Module', " Prereq " . $_->module ); ok( defined $bundle->status->prereqs->{$_->module}, " Prereq was registered" ); @@ -273,21 +273,21 @@ isa_ok( $Auth->parent, 'CPANPLUS::Backend' ); } { ### testing autobundles - my $file = File::Spec->catfile( - dummy_cpan_dir(), + my $file = File::Spec->catfile( + dummy_cpan_dir(), $Conf->_get_build('autobundle'), - 'Snapshot.pm' + 'Snapshot.pm' ); my $uri = $CB->_host_to_uri( scheme => 'file', path => $file ); my $bundle = $CB->parse_module( module => $uri ); - + ok( -e $file, "Creating bundle from '$file'" ); ok( $bundle, " Object created" ); isa_ok( $bundle, 'CPANPLUS::Module', " Object" ); ok( $bundle->is_bundle, " Recognized as bundle" ); ok( $bundle->is_autobundle, " Recognized as autobundle" ); - + my $type = $bundle->get_installer_type; ok( $type, " Found installer type" ); is( $type, INSTALLER_AUTOBUNDLE, @@ -303,7 +303,7 @@ isa_ok( $Auth->parent, 'CPANPLUS::Backend' ); is( scalar(@list), 1, " Right number of prereqs" ); isa_ok( $list[0], 'CPANPLUS::Module', " Object" ); - + ### skiptests to make sure we don't get any test header mismatches my $rv = $bundle->create( prereq_target => 'create', skiptest => 1 ); ok( $rv, " Tested prereqs" ); @@ -313,28 +313,28 @@ isa_ok( $Auth->parent, 'CPANPLUS::Backend' ); ### test module from perl core ### { isa_ok( $CoreMod, 'CPANPLUS::Module', "Core module " . $CoreName ); - ok( $CoreMod->package_is_perl_core, + ok( $CoreMod->package_is_perl_core, " Package found in perl core" ); - + ### check if it's core with 5.6.1 { local $] = '5.006001'; ok( $CoreMod->module_is_supplied_with_perl_core, " Module also found in perl core"); } - + ok( !$CoreMod->install, " Package not installed" ); like( CPANPLUS::Error->stack_as_string, qr/core Perl/, " Error properly logged" ); -} +} ### test third-party modules SKIP: { - skip "Module::ThirdParty not installed", 10 + skip "Module::ThirdParty not installed", 10 unless eval { require Module::ThirdParty; 1 }; - ok( !$Mod->is_third_party, + ok( !$Mod->is_third_party, "Not a 3rd party module: ". $Mod->name ); - + my $fake = $CB->parse_module( module => 'LOCAL/SVN-Core-1.0' ); ok( $fake, "Created module object for ". $fake->name ); ok( $fake->is_third_party, @@ -343,11 +343,11 @@ SKIP: { my $info = $fake->third_party_information; ok( $info, "Got 3rd party package information" ); isa_ok( $info, 'HASH' ); - + for my $item ( qw[name url author author_url] ) { ok( length($info->{$item}), " $item field is filled" ); - } + } } ### testing EU::Installed methods in Dist::MM tests ### diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/t/05_CPANPLUS-Internals-Fetch.t b/gnu/usr.bin/perl/cpan/CPANPLUS/t/05_CPANPLUS-Internals-Fetch.t index 7a6b1acb86f..9d648fc38f7 100755 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/t/05_CPANPLUS-Internals-Fetch.t +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/t/05_CPANPLUS-Internals-Fetch.t @@ -1,6 +1,6 @@ ### make sure we can find our conf.pl file -BEGIN { - use FindBin; +BEGIN { + use FindBin; require "$FindBin::Bin/inc/conf.pl"; } @@ -26,11 +26,11 @@ isa_ok( $mod, 'CPANPLUS::Module' ); ### fail host tests ### { my $host = {}; my $rv = $cb->_add_fail_host( host => $host ); - + ok( $rv, "Failed host added " ); - ok(!$cb->_host_ok( host => $host), + ok(!$cb->_host_ok( host => $host), " Host registered as failed" ); - ok( $cb->_host_ok( host => {} ), + ok( $cb->_host_ok( host => {} ), " Fresh host unregistered" ); } @@ -38,7 +38,7 @@ isa_ok( $mod, 'CPANPLUS::Module' ); { my $where = $cb->_fetch( module => $mod, force => 1 ); ok( $where, "File downloaded to '$where'" ); - ok( -s $where, " File exists" ); + ok( -s $where, " File exists" ); unlink $where; ok(!-e $where, " File removed" ); } @@ -46,24 +46,24 @@ isa_ok( $mod, 'CPANPLUS::Module' ); ### try to fetch something that doesn't exist ### { ### set up a bogus host first ### my $hosts = $conf->get_conf('hosts'); - my $fail = { scheme => 'file', + my $fail = { scheme => 'file', path => "$0/$0" }; - + unshift @$hosts, $fail; $conf->set_conf( hosts => $hosts ); - + ### the fallback host will get it ### my $where = $cb->_fetch( module => $mod, force => 1, verbose => 0 ); ok($where, "File downloaded to '$where'" ); - ok( -s $where, " File exists" ); - + ok( -s $where, " File exists" ); + ### but the error should be recorded ### like( CPANPLUS::Error->stack_as_string, qr/Fetching of .*? failed/s, - " Error recorded appropriately" ); + " Error recorded appropriately" ); ### host marked as bad? ### - ok(!$cb->_host_ok( host => $fail ), - " Failed host logged properly" ); + ok(!$cb->_host_ok( host => $fail ), + " Failed host logged properly" ); ### restore the hosts ### shift @$hosts; $conf->set_conf( hosts => $hosts ); @@ -82,23 +82,23 @@ isa_ok( $mod, 'CPANPLUS::Module' ); : File::Spec::Unix->catfile( File::Spec::Unix->catdir( File::Spec->splitdir( $cwd ) ), $base - ); - + ); + my $target = CREATE_FILE_URI->($in_file); my $fake = $cb->parse_module( module => $target ); - - ok( IS_FAKE_MODOBJ->(mod => $fake), + + ok( IS_FAKE_MODOBJ->(mod => $fake), "Fake module created from $0" ); is( $fake->status->_fetch_from, $target, - " Fetch from set ok" ); - + " Fetch from set ok" ); + my $where = $fake->fetch; ok( $where, " $target fetched ok" ); ok( -s $where, " $where exists" ); like( $where, '/'. UNKNOWN_DL_LOCATION .'/', " Saved to proper location" ); - like( $where, qr/$base$/, " Saved with proper name" ); + like( $where, qr/$base$/, " Saved with proper name" ); } diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/t/06_CPANPLUS-Internals-Constants.t b/gnu/usr.bin/perl/cpan/CPANPLUS/t/06_CPANPLUS-Internals-Constants.t index 993b2dc4ac0..65bde1181ab 100755 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/t/06_CPANPLUS-Internals-Constants.t +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/t/06_CPANPLUS-Internals-Constants.t @@ -1,6 +1,6 @@ ### make sure we can find our conf.pl file -BEGIN { - use FindBin; +BEGIN { + use FindBin; require "$FindBin::Bin/inc/conf.pl"; } @@ -40,7 +40,7 @@ ok( IS_CONFOBJ->( conf => $conf ), "IS_CONFOBJ recognizes conf object" ); ok( FILE_EXISTS->( file => basename($0) ), "FILE_EXISTS finds file" ); ok( FILE_READABLE->( file => basename($0) ), "FILE_READABLE finds file" ); ok( DIR_EXISTS->( dir => cwd() ), "DIR_EXISTS finds dir" ); - + { no strict 'refs'; @@ -56,18 +56,18 @@ ok( DIR_EXISTS->( dir => cwd() ), "DIR_EXISTS finds dir" ); : 'Makefile' }, }; - + while ( my($sub,$res) = each %$tmpl ) { is( &{$sub}->(), $res, "$sub returns proper result without args" ); - + my $long = File::Spec->catfile( cwd(), $res ); is( &{$sub}->( cwd() ), $long, "$sub returns proper result with args" ); - } -} - + } +} + # Local variables: # c-indentation-style: bsd # c-basic-offset: 4 # indent-tabs-mode: nil # End: -# vim: expandtab shiftwidth=4: +# vim: expandtab shiftwidth=4: diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/t/07_CPANPLUS-Internals-Extract.t b/gnu/usr.bin/perl/cpan/CPANPLUS/t/07_CPANPLUS-Internals-Extract.t index 3c18a3b9443..b03befa8ac7 100755 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/t/07_CPANPLUS-Internals-Extract.t +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/t/07_CPANPLUS-Internals-Extract.t @@ -1,6 +1,6 @@ ### make sure we can find our conf.pl file -BEGIN { - use FindBin; +BEGIN { + use FindBin; require "$FindBin::Bin/inc/conf.pl"; } diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/t/08_CPANPLUS-Backend.t b/gnu/usr.bin/perl/cpan/CPANPLUS/t/08_CPANPLUS-Backend.t index aba3a475f77..73611e872bf 100755 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/t/08_CPANPLUS-Backend.t +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/t/08_CPANPLUS-Backend.t @@ -1,6 +1,6 @@ ### make sure we can find our conf.pl file -BEGIN { - use FindBin; +BEGIN { + use FindBin; require "$FindBin::Bin/inc/conf.pl"; } @@ -25,8 +25,8 @@ isa_ok( $cb, $Class ); my $mt = $cb->module_tree; my $at = $cb->author_tree; -ok( scalar keys %$mt, "Module tree has entries" ); -ok( scalar keys %$at, "Author tree has entries" ); +ok( scalar keys %$mt, "Module tree has entries" ); +ok( scalar keys %$at, "Author tree has entries" ); ### module_tree tests ### my $Name = TEST_CONF_MODULE; @@ -35,7 +35,7 @@ my $mod = $cb->module_tree($Name); ### XXX SOURCEFILES FIX { my @mods = $cb->module_tree($Name,$Name); my $none = $cb->module_tree( TEST_CONF_INVALID_MODULE ); - + ok( IS_MODOBJ->(mod => $mod), "Module object found" ); is( scalar(@mods), 2, " Module list found" ); ok( IS_MODOBJ->(mod => $mods[0]), " ISA module object" ); @@ -46,7 +46,7 @@ my $mod = $cb->module_tree($Name); { my @auths = $cb->author_tree( $mod->author->cpanid, $mod->author->cpanid ); my $none = $cb->author_tree( 'fnurk' ); - + ok( IS_AUTHOBJ->(auth => $mod->author), "Author object found" ); is( scalar(@auths), 2, " Author list found" ); ok( IS_AUTHOBJ->( author => $auths[0] )," ISA author object" ); @@ -59,122 +59,122 @@ ok( IS_CONFOBJ->(conf => $conf_obj), "Configure object found" ); ### parse_module tests ### -{ my @map = ( - $Name => [ +{ my @map = ( + $Name => [ $mod->author->cpanid, # author $mod->package_name, # package name $mod->version, # version ], - $mod => [ - $mod->author->cpanid, - $mod->package_name, - $mod->version, + $mod => [ + $mod->author->cpanid, + $mod->package_name, + $mod->version, ], - 'Foo-Bar-EU-NOXS' => [ - $mod->author->cpanid, - $mod->package_name, + 'Foo-Bar-EU-NOXS' => [ + $mod->author->cpanid, + $mod->package_name, $mod->version, ], - 'Foo-Bar-EU-NOXS-0.01' => [ - $mod->author->cpanid, - $mod->package_name, + 'Foo-Bar-EU-NOXS-0.01' => [ + $mod->author->cpanid, + $mod->package_name, '0.01', ], - 'EUNOXS/Foo-Bar-EU-NOXS' => [ + 'EUNOXS/Foo-Bar-EU-NOXS' => [ 'EUNOXS', - $mod->package_name, + $mod->package_name, $mod->version, ], - 'EUNOXS/Foo-Bar-EU-NOXS-0.01' => [ - 'EUNOXS', - $mod->package_name, + 'EUNOXS/Foo-Bar-EU-NOXS-0.01' => [ + 'EUNOXS', + $mod->package_name, '0.01', ], ### existing module, no extension given ### this used to create a modobj with no package extension - 'EUNOXS/Foo-Bar-0.02' => [ - 'EUNOXS', + 'EUNOXS/Foo-Bar-0.02' => [ + 'EUNOXS', 'Foo-Bar', '0.02', ], - 'Foo-Bar-EU-NOXS-0.09' => [ - $mod->author->cpanid, - $mod->package_name, + 'Foo-Bar-EU-NOXS-0.09' => [ + $mod->author->cpanid, + $mod->package_name, '0.09', ], - 'MBXS/Foo-Bar-EU-NOXS-0.01' => [ - 'MBXS', - $mod->package_name, + 'MBXS/Foo-Bar-EU-NOXS-0.01' => [ + 'MBXS', + $mod->package_name, '0.01', ], - 'EUNOXS/Foo-Bar-EU-NOXS-0.09' => [ + 'EUNOXS/Foo-Bar-EU-NOXS-0.09' => [ 'EUNOXS', - $mod->package_name, + $mod->package_name, '0.09', ], - 'EUNOXS/Foo-Bar-EU-NOXS-0.09.zip' => [ + 'EUNOXS/Foo-Bar-EU-NOXS-0.09.zip' => [ 'EUNOXS', - $mod->package_name, + $mod->package_name, '0.09', ], - 'FROO/Flub-Flob-1.1.zip' => [ - 'FROO', - 'Flub-Flob', - '1.1', + 'FROO/Flub-Flob-1.1.zip' => [ + 'FROO', + 'Flub-Flob', + '1.1', ], - 'G/GO/GOYALI/SMS_API_3_01.tar.gz' => [ - 'GOYALI', - 'SMS_API', - '3_01', + 'G/GO/GOYALI/SMS_API_3_01.tar.gz' => [ + 'GOYALI', + 'SMS_API', + '3_01', ], - 'E/EY/EYCK/Net/Lite/Net-Lite-FTP-0.091' => [ - 'EYCK', - 'Net-Lite-FTP', + 'E/EY/EYCK/Net/Lite/Net-Lite-FTP-0.091' => [ + 'EYCK', + 'Net-Lite-FTP', '0.091', ], - 'EYCK/Net/Lite/Net-Lite-FTP-0.091' => [ + 'EYCK/Net/Lite/Net-Lite-FTP-0.091' => [ 'EYCK', - 'Net-Lite-FTP', + 'Net-Lite-FTP', '0.091', ], - 'M/MA/MAXDB/DBD-MaxDB-7.5.0.24a' => [ + 'M/MA/MAXDB/DBD-MaxDB-7.5.0.24a' => [ 'MAXDB', 'DBD-MaxDB', - '7.5.0.24a', + '7.5.0.24a', ], - 'EUNOXS/perl5.005_03.tar.gz' => [ - 'EUNOXS', + 'EUNOXS/perl5.005_03.tar.gz' => [ + 'EUNOXS', 'perl', '5.005_03', ], - 'FROO/Flub-Flub-v1.1.0.tbz' => [ - 'FROO', - 'Flub-Flub', - 'v1.1.0', + 'FROO/Flub-Flub-v1.1.0.tbz' => [ + 'FROO', + 'Flub-Flub', + 'v1.1.0', ], - 'FROO/Flub-Flub-1.1_2.tbz' => [ - 'FROO', - 'Flub-Flub', + 'FROO/Flub-Flub-1.1_2.tbz' => [ + 'FROO', + 'Flub-Flub', '1.1_2', - ], - 'LDS/CGI.pm-3.27.tar.gz' => [ + ], + 'LDS/CGI.pm-3.27.tar.gz' => [ 'LDS', 'CGI', - '3.27', + '3.27', ], - 'FROO/Text-Tabs+Wrap-2006.1117.tar.gz' => [ - 'FROO', + 'FROO/Text-Tabs+Wrap-2006.1117.tar.gz' => [ + 'FROO', 'Text-Tabs+Wrap', - '2006.1117', - ], - 'JETTERO/Crypt-PBC-0.7.20.0-0.4.9' => [ + '2006.1117', + ], + 'JETTERO/Crypt-PBC-0.7.20.0-0.4.9' => [ 'JETTERO', 'Crypt-PBC', '0.7.20.0-0.4.9' , ], - 'GRICHTER/HTML-Embperl-1.2.1.tar.gz' => [ - 'GRICHTER', - 'HTML-Embperl', + 'GRICHTER/HTML-Embperl-1.2.1.tar.gz' => [ + 'GRICHTER', + 'HTML-Embperl', '1.2.1', ], 'KANE/File-Fetch-0.15_03' => [ @@ -186,18 +186,13 @@ ok( IS_CONFOBJ->(conf => $conf_obj), "Configure object found" ); 'AUSCHUTZ', 'IO-Stty', '.02', - ], + ], '.' => [ 'CPANPLUS', 't', '', - ], - 'Foo/Bar.pm' => [ - $mod->author->cpanid, # author - $mod->package_name, # package name - $mod->version, # version - ], - ); + ], + ); while ( my($guess, $attr) = splice @map, 0, 2 ) { my( $author, $pkg_name, $version ) = @$attr; @@ -205,11 +200,11 @@ ok( IS_CONFOBJ->(conf => $conf_obj), "Configure object found" ); ok( $guess, "Attempting to parse $guess" ); my $obj = $cb->parse_module( module => $guess ); - + ok( $obj, " Result returned" ); - ok( IS_MODOBJ->( mod => $obj ), - " parse_module success by '$guess'" ); - + ok( IS_MODOBJ->( mod => $obj ), + " parse_module success by '$guess'" ); + is( $obj->version, $version, " Proper version found: $version" ); is( $obj->package_version, $version, @@ -223,10 +218,10 @@ ok( IS_CONFOBJ->(conf => $conf_obj), "Configure object found" ); { my $ext = $obj->package_extension; ok( $ext, " Has extension as well: $ext" ); } - - like( $obj->author->cpanid, "/$author/i", + + like( $obj->author->cpanid, "/$author/i", " Proper author found: $author"); - like( $obj->path, "/$author/i", + like( $obj->path, "/$author/i", " Proper path found: " . $obj->path ); } @@ -238,49 +233,49 @@ ok( IS_CONFOBJ->(conf => $conf_obj), "Configure object found" ); [qr/Cannot find .+? in the module tree/,"Unable to find module"] ] ], [ {}, => [ - [ qr/module string from reference/,"Unable to parse ref"] + [ qr/module string from reference/,"Unable to parse ref"] ] ], ); for my $entry ( @map ) { my($mod,$aref) = @$entry; - + my $none = $cb->parse_module( module => $mod ); - ok( !IS_MODOBJ->(mod => $none), - "Non-existent module detected" ); + ok( !IS_MODOBJ->(mod => $none), + "Non-existant module detected" ); ok( !IS_FAKE_MODOBJ->(mod => $none), - "Non-existent fake module detected" ); - + "Non-existant fake module detected" ); + my $str = CPANPLUS::Error->stack_as_string; for my $pair (@$aref) { my($re,$diag) = @$pair; like( $str, $re," $diag" ); } - } + } } - + ### test parsing of arbitrary URI for my $guess ( qw[ http://foo/bar.gz http://a/b/c/d/e/f/g/h/i/j flub://floo ] ) { my $obj = $cb->parse_module( module => $guess ); - ok( IS_FAKE_MODOBJ->(mod => $obj), + ok( IS_FAKE_MODOBJ->(mod => $obj), "parse_module success by '$guess'" ); is( $obj->status->_fetch_from, $guess, " Fetch from set ok" ); - } -} + } +} ### RV tests ### { my $method = 'readme'; - my %args = ( modules => [$Name] ); - + my %args = ( modules => [$Name] ); + my $rv = $cb->$method( %args ); ok( IS_RVOBJ->( $rv ), "Got an RV object" ); ok( $rv->ok, " Overall OK" ); cmp_ok( $rv, '==', 1, " Overload OK" ); - is( $rv->function, $method, " Function stored OK" ); + is( $rv->function, $method, " Function stored OK" ); is_deeply( $rv->args, \%args, " Arguments stored OK" ); is( $rv->rv->{$Name}, $mod->readme, " RV as expected" ); } @@ -290,18 +285,18 @@ ok( IS_CONFOBJ->(conf => $conf_obj), "Configure object found" ); my $file = File::Spec->catfile( $conf->get_conf('base'), $conf->_get_source('mod'), ); - - ok( $cb->reload_indices( update_source => 0 ), "Rebuilding trees" ); + + ok( $cb->reload_indices( update_source => 0 ), "Rebuilding trees" ); my $age = -M $file; - + ### make sure we are 'newer' on faster machines with a sleep.. ### apparently Win32's FAT isn't granual enough on intervals ### < 2 seconds, so it may give the same answer before and after ### the sleep, causing the test to fail. so sleep atleast 2 seconds. sleep 2; - ok( $cb->reload_indices( update_source => 1 ), + ok( $cb->reload_indices( update_source => 1 ), "Rebuilding and refetching trees" ); - cmp_ok( $age, '>', -M $file, " Source file '$file' updated" ); + cmp_ok( $age, '>', -M $file, " Source file '$file' updated" ); } ### flush tests ### @@ -313,8 +308,8 @@ ok( IS_CONFOBJ->(conf => $conf_obj), "Configure object found" ); ### installed tests ### { ok( scalar($cb->installed), "Found list of installed modules" ); -} - +} + ### autobudle tests ### { my $where = $cb->autobundle; @@ -323,17 +318,17 @@ ok( IS_CONFOBJ->(conf => $conf_obj), "Configure object found" ); } ### local_mirror tests ### -{ ### turn off md5 checks for the 'fake' packages we have +{ ### turn off md5 checks for the 'fake' packages we have my $old_md5 = $conf->get_conf('md5'); $conf->set_conf( md5 => 0 ); ### otherwise 'status->fetch' might be undef! ### my $rv = $cb->local_mirror( path => 'dummy-localmirror' ); ok( $rv, "Local mirror created" ); - + for my $mod ( values %{ $cb->module_tree } ) { my $name = $mod->module; - + my $cksum = File::Spec->catfile( dirname($mod->status->fetch), CHECKSUMS ); @@ -341,10 +336,10 @@ ok( IS_CONFOBJ->(conf => $conf_obj), "Configure object found" ); ok( -s _, " Module '$name' has size" ); ok( -e $cksum, " Checksum fetched for '$name'" ); ok( -s _, " Checksum for '$name' has size" ); - } + } $conf->set_conf( md5 => $old_md5 ); -} +} ### check ENV variable { ### process id @@ -353,23 +348,23 @@ ok( IS_CONFOBJ->(conf => $conf_obj), "Configure object found" ); is( $ENV{$name}, $$, " Set to current process id" ); } - ### Version + ### Version { my $name = 'PERL5_CPANPLUS_IS_VERSION'; ok( $ENV{$name}, "Env var '$name' set" ); ### version.pm formats ->VERSION output... *sigh* - is( $ENV{$name}, $Class->VERSION, + is( $ENV{$name}, $Class->VERSION, " Set to current process version" ); } - + } -__END__ - +__END__ + # Local variables: # c-indentation-style: bsd # c-basic-offset: 4 # indent-tabs-mode: nil # End: -# vim: expandtab shiftwidth=4: - +# vim: expandtab shiftwidth=4: + diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/t/09_CPANPLUS-Internals-Search.t b/gnu/usr.bin/perl/cpan/CPANPLUS/t/09_CPANPLUS-Internals-Search.t index e5ef37cb686..c00437d09a7 100755 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/t/09_CPANPLUS-Internals-Search.t +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/t/09_CPANPLUS-Internals-Search.t @@ -1,6 +1,6 @@ ### make sure we can find our conf.pl file -BEGIN { - use FindBin; +BEGIN { + use FindBin; require "$FindBin::Bin/inc/conf.pl"; } @@ -37,7 +37,7 @@ for my $type ( CPANPLUS::Module->accessors() ) { ### search for authors ### my $auth = $Mod->author; for my $type ( CPANPLUS::Module::Author->accessors() ) { - + ### don't muck around with references/objects ### or private identifiers next if ref $auth->$type() or $type =~/^_/; diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/t/10_CPANPLUS-Error.t b/gnu/usr.bin/perl/cpan/CPANPLUS/t/10_CPANPLUS-Error.t index 355ca7aad49..800a126c0d2 100755 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/t/10_CPANPLUS-Error.t +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/t/10_CPANPLUS-Error.t @@ -1,6 +1,6 @@ ### make sure we can find our conf.pl file -BEGIN { - use FindBin; +BEGIN { + use FindBin; require "$FindBin::Bin/inc/conf.pl"; } @@ -19,7 +19,7 @@ my $map = { error => ["This is just a test error"], }; -### check if CPANPLUS::Error can do what we expect +### check if CPANPLUS::Error can do what we expect { for my $name ( keys %$map ) { can_ok('CPANPLUS::Error', $name); can_ok('main', $name); # did it get exported? @@ -28,8 +28,8 @@ my $map = { ### make sure we start with an empty stack { CPANPLUS::Error->flush; - is( scalar(()=CPANPLUS::Error->stack), 0, - "Starting with empty stack" ); + is( scalar(()=CPANPLUS::Error->stack), 0, + "Starting with empty stack" ); } ### global variables test ### @@ -37,9 +37,9 @@ my $map = { ### this *has* to be set, as we're testing the contents of the file ### to see if it matches what's stored in the buffer. - local $CPANPLUS::Error::MSG_FH = output_handle(); + local $CPANPLUS::Error::MSG_FH = output_handle(); local $CPANPLUS::Error::ERROR_FH = output_handle(); - + ok( -e $file, "Output redirect file exists" ); ok( !-s $file, " Output file is empty" ); @@ -51,40 +51,40 @@ my $map = { } ### must close it for Win32 tests! - close output_handle; + close output_handle; ok( -s $file, " Output file now has size" ); - + my $fh = FileHandle->new( $file ); ok( $fh, "Opened output file for reading " ); - + my $contents = do { local $/; <$fh> }; my $string = CPANPLUS::Error->stack_as_string; my $trace = CPANPLUS::Error->stack_as_string(1); - + ok( $contents, " Got the file contents" ); ok( $string, "Got the error stack as string" ); - - + + for my $type ( keys %$map ) { my $tag = $type; $tag =~ s/.+?_//g; - + for my $str (@{ $map->{$type} } ) { like( $contents, qr/\U\Q$tag/, - " Contents matches for '$type'" ); + " Contents matches for '$type'" ); like( $contents, qr/\Q$str/, - " Contents matches for '$type'" ); - + " Contents matches for '$type'" ); + like( $string, qr/\U\Q$tag/, - " String matches for '$type'" ); + " String matches for '$type'" ); like( $string, qr/\Q$str/, " String matches for '$type'" ); like( $trace, qr/\U\Q$tag/, - " Trace matches for '$type'" ); + " Trace matches for '$type'" ); like( $trace, qr/\Q$str/, " Trace matches for '$type'" ); - + ### extra trace tests ### like( $trace, qr/\Q$str\E.*?\Q$str/s, " Trace holds proper traceback" ); @@ -92,17 +92,17 @@ my $map = { " Trace holds program name" ); like( $trace, qr/line/, " Trace holds line number information" ); - } + } } ### check the stack, flush it, check again ### - is( scalar(()=CPANPLUS::Error->stack), scalar(keys(%$map)), + is( scalar(()=CPANPLUS::Error->stack), scalar(keys(%$map)), "All items on stack" ); is( scalar(()=CPANPLUS::Error->flush), scalar(keys(%$map)), "All items flushed" ); - is( scalar(()=CPANPLUS::Error->stack), 0, - "No items on stack" ); - + is( scalar(()=CPANPLUS::Error->stack), 0, + "No items on stack" ); + } diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/t/15_CPANPLUS-Shell.t b/gnu/usr.bin/perl/cpan/CPANPLUS/t/15_CPANPLUS-Shell.t index 51283c67275..2a7e8c6b87f 100755 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/t/15_CPANPLUS-Shell.t +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/t/15_CPANPLUS-Shell.t @@ -1,8 +1,8 @@ ### 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; +BEGIN { + use FindBin; require "$FindBin::Bin/inc/conf.pl"; } @@ -17,7 +17,7 @@ BEGIN { sub _out { $out } sub _reset_out { $out = '' } -} +} use strict; use Test::More 'no_plan'; @@ -37,25 +37,22 @@ my $Default = SHELL_DEFAULT; my $TestMod = TEST_CONF_MODULE; my $TestAuth= TEST_CONF_AUTHOR; -unless ( -t ) { - ok('We are not on a terminal'); - exit 0; -} - + ### basic load tests 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( + File::Spec->catfile( $FindBin::Bin, TEST_CONF_CPAN_DIR, ) @@ -65,10 +62,10 @@ isa_ok( $Shell, $Default, " Object" ); host => '', path => $cs_path, ); + + my $base = $Conf->get_conf('base'); - my $base = $Conf->get_conf('base'); - - ### XXX have to keep the list ordered, as some methods only work as + ### XXX have to keep the list ordered, as some methods only work as ### expected *after* others have run my @map = ( 'v' => qr/CPANPLUS/, @@ -95,7 +92,7 @@ isa_ok( $Shell, $Default, " Object" ); '! die $$; p' => qr/$$/, '/plugins' => qr/Available plugins:/i, '/? ?' => qr/usage/i, - + ### custom source plugin tests ### lower case path matching, as on VMS we can't predict case "/? cs" => qr|/cs|, @@ -113,21 +110,21 @@ isa_ok( $Shell, $Default, " Object" ); 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'" ); } @@ -135,18 +132,18 @@ isa_ok( $Shell, $Default, " Object" ); __END__ -#### test separately, they have side effects +#### 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 +'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', +'c' => '_reports', +'i' => '_install', 'u' => '_uninstall', 'z' => '_shell', ### might not have any out of date modules... 'o' => '_uptodate', - + diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/t/19_CPANPLUS-Dist.t b/gnu/usr.bin/perl/cpan/CPANPLUS/t/19_CPANPLUS-Dist.t index b551741eef6..cb0cd333050 100755 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/t/19_CPANPLUS-Dist.t +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/t/19_CPANPLUS-Dist.t @@ -1,6 +1,6 @@ ### make sure we can find our conf.pl file -BEGIN { - use FindBin; +BEGIN { + use FindBin; require "$FindBin::Bin/inc/conf.pl"; } @@ -21,7 +21,7 @@ BEGIN { require CPANPLUS::Dist; CPANPLUS::Dist->_add_dist_types( __PACKAGE__ ); - sub init { $_[0]->status->mk_accessors( + sub init { $_[0]->status->mk_accessors( qw[prepared created installed _prepare_args _install_args _create_args]); return $Init }; @@ -50,7 +50,7 @@ my $cb = CPANPLUS::Backend->new( $conf ); ### obsolete #my $Format = '_test'; my $Module = 'CPANPLUS::Dist::_Test'; -my $ModName = TEST_CONF_MODULE; +my $ModName = TEST_CONF_MODULE; my $ModPrereq = TEST_CONF_INST_MODULE; ### XXX this version doesn't exist, but we don't check for it either ### my $Prereq = { $ModPrereq => '1000' }; @@ -96,7 +96,7 @@ ok( $Mod, "Got module object" ); { local $CPANPLUS::Dist::_Test::Available = 0; ok( !$Module->format_available, - "Format availability turned off" ); + "Format availabillity turned off" ); { $conf->_set_build('sanity_check' => 0); @@ -108,9 +108,9 @@ ok( $Mod, "Got module object" ); } { $conf->_set_build('sanity_check' => 1); - + my $dist = $Module->new( module => $Mod ); - + ok( !$dist, "Dist not created with sanity check on" ); like( CPANPLUS::Error->stack_as_string, qr/Format '$Module' is not available/, @@ -122,7 +122,7 @@ ok( $Mod, "Got module object" ); { local $CPANPLUS::Dist::_Test::Init = 0; my $dist = $Module->new( module => $Mod ); - + ok( !$dist, "No dist created by failed init" ); like( CPANPLUS::Error->stack_as_string, qr/Dist initialization of '$Module' failed for/s, @@ -132,36 +132,36 @@ ok( $Mod, "Got module object" ); ### configure_requires tests { my $meta = META->( $Mod ); ok( $meta, "Reading 'configure_requires' from '$meta'" ); - + my $clone = $Mod->clone; ok( $clone, " Package cloned" ); ### set the new location to fetch from $clone->package( $meta ); - + my $file = $clone->fetch; ok( $file, " Meta file fetched" ); ok( -e $file, " File '$file' exits" ); - + my $dist = $Module->new( module => $Mod ); ok( $dist, " Dist object created" ); - - my $meth = 'find_configure_requires'; + + my $meth = 'find_configure_requires'; can_ok( $dist, $meth ); - + my $href = $dist->$meth( file => $file ); ok( $href, " '$meth' returned hashref" ); - + ok( scalar(keys(%$href)), " Contains entries" ); ok( $href->{ +TEST_CONF_PREREQ }, " Contains the right prereq" ); -} +} ### test _resolve prereqs, in a somewhat simulated set of circumstances { my $old_prereq = $conf->get_conf('prereqs'); - + my $map = { 0 => { 'Previous install failed' => [ @@ -199,6 +199,13 @@ ok( $Mod, "Got module object" ); " Dist installation failed recorded ok" ) }, ], + "Set dependency to be perl-core" => [ + sub { $cb->module_tree( $ModPrereq )->package( + 'perl-5.8.1.tar.gz' ); 'install' }, + sub { like( CPANPLUS::Error->stack_as_string, + qr/Prerequisite '$ModPrereq' is perl-core/s, + " Dist installation failed recorded ok" ) }, + ], 'Simple ignore' => [ sub { 'ignore' }, sub { ok( !$_[0]->status->prepared, @@ -222,10 +229,10 @@ ok( $Mod, "Got module object" ); 'Perl binary version too low' => [ sub { $cb->module_tree( $ModName ) ->status->prereqs({ PERL_CORE, 10000000000 }); '' }, - sub { like( CPANPLUS::Error->stack_as_string, + sub { like( CPANPLUS::Error->stack_as_string, qr/needs perl version/, " Perl version not high enough" ) }, - ], + ], }, 1 => { 'Simple create' => [ @@ -247,14 +254,6 @@ ok( $Mod, "Got module object" ); " Module status says installed" ) }, ], - "Set dependency to be perl-core" => [ - sub { $cb->module_tree( $ModPrereq )->package( - 'perl-5.8.1.tar.gz' ); 'install' }, - sub { like( CPANPLUS::Error->stack_as_string, - qr/Prerequisite '$ModPrereq' is perl-core/s, - " Dist installation failed recorded ok" ) }, - ], - 'Install from conf' => [ sub { $conf->set_conf(prereqs => PREREQ_INSTALL); '' }, sub { ok( $_[0]->status->prepared, @@ -316,10 +315,10 @@ ok( $Mod, "Got module object" ); 'Perl binary version sufficient' => [ sub { $cb->module_tree( $ModName ) ->status->prereqs({ PERL_CORE, 1 }); '' }, - sub { unlike( CPANPLUS::Error->stack_as_string, + sub { unlike( CPANPLUS::Error->stack_as_string, qr/needs perl version/, " Perl version sufficient" ) }, - ], + ], }, }; @@ -372,7 +371,7 @@ ok( $Mod, "Got module object" ); 0 => undef, 1 => undef, 2 => qr/have to resolve/, - }; + }; my $mod = CPANPLUS::Module::Fake->new( module => $$, @@ -382,37 +381,37 @@ ok( $Mod, "Got module object" ); ok( $mod, "Fake module created" ); is( $mod->version, 1, " Version set correctly" ); - + my $dist = $Module->new( module => $Mod ); - + ok( $dist, "Dist object created" ); isa_ok( $dist, $Module ); - - + + ### scope it for the locals { local $^W; # quell sub redefined warnings; - + ### is_uptodate will need to return false for this test local *CPANPLUS::Module::Fake::is_uptodate = sub { return }; local *CPANPLUS::Module::Fake::is_uptodate = sub { return }; - CPANPLUS::Error->flush; - - + CPANPLUS::Error->flush; + + ### it's satisfied while( my($ver, $re) = each %$map ) { - + my $rv = $dist->prereq_satisfied( version => $ver, modobj => $mod ); - - ok( 1, "Testing ver: $ver" ); + + ok( 1, "Testing ver: $ver" ); is( $rv, undef, " Return value as expected" ); - + if( $re ) { like( CPANPLUS::Error->stack_as_string, $re, " Error as expected" ); } - + CPANPLUS::Error->flush; } } diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/t/20_CPANPLUS-Dist-MM.t b/gnu/usr.bin/perl/cpan/CPANPLUS/t/20_CPANPLUS-Dist-MM.t index 5bba1371597..a203c88ffe3 100755 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/t/20_CPANPLUS-Dist-MM.t +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/t/20_CPANPLUS-Dist-MM.t @@ -1,6 +1,6 @@ ### make sure we can find our conf.pl file -BEGIN { - use FindBin; +BEGIN { + use FindBin; require "$FindBin::Bin/inc/conf.pl"; } @@ -103,7 +103,7 @@ ok( $Mod->extract, "Extracting module to ".$Mod->status->extract ); ok( $dist, "Dist created with target => " . TARGET_INIT ); ok( !$dist->status->prepared, " Prepare was not run" ); -} +} ok( $Mod->test, "Testing module" ); @@ -141,20 +141,20 @@ SKIP: { ### 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 + ### 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'}; local $ENV{'PERL_MM_OPT'}; - + { local $ENV{'PERL5_MM_OPT'}; + ### add the new dir to the configuration too, so eu::installed tests ### work as they should $conf->set_conf( lib => [ TEST_CONF_INSTALL_DIR ] ); - - ok( $Mod->install( force => 1, - makemakerflags => 'PREFIX='.TEST_CONF_INSTALL_DIR, + + ok( $Mod->install( force => 1, + makemakerflags => 'PREFIX='.TEST_CONF_INSTALL_DIR, ), "Installing module" ); - } - + } + ok( $Mod->status->installed," Module installed according to status" ); @@ -164,8 +164,8 @@ SKIP: { ### #46890: ExtUtils::Installed + EU::MM PREFIX= don't always work ### well together skip( "ExtUtils::Installed issue #46890 prevents these tests from running reliably", 8 ); - - + + skip( "Old perl on cygwin detected " . "-- tests will fail due to known bugs", 8 ) if ON_OLD_CYGWIN; @@ -225,7 +225,7 @@ SKIP: { ### test exceptions in Dist::MM->create ### { ok( $Mod->status->mk_flush, "Old status info flushed" ); my $dist = INSTALLER_MM->new( module => $Mod ); - + ok( $dist, "New dist object made" ); ok(!$dist->prepare, " Dist->prepare failed" ); like( CPANPLUS::Error->stack_as_string, qr/No dir found to operate on/, @@ -268,7 +268,7 @@ SKIP: { ok( $dist->write_makefile_pl( force => 0 ), " Makefile.PL written" ); like( CPANPLUS::Error->stack_as_string, qr/Already created/, - " Prior existence noted" ); + " Prior existance noted" ); ### ok, unlink the makefile.pl, now really write one 1 while unlink $makefile; @@ -308,7 +308,7 @@ SKIP: { { 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" ); @@ -339,7 +339,7 @@ SKIP: { ### now let's write a makefile.pl that just does 'die' { local $^W; - local *CPANPLUS::Dist::MM::write_makefile_pl = + local *CPANPLUS::Dist::MM::write_makefile_pl = __PACKAGE__->_custom_makefile_pl_sub( "exit 1;" ); ### there's no makefile.pl now, since the previous test failed @@ -360,8 +360,8 @@ SKIP: { { my $unlink_sts = unlink($makefile_pl); 1 while unlink $makefile_pl; ok( $unlink_sts, "Deleting Makefile.PL"); - } - + } + $dist->status->mk_flush; } @@ -370,21 +370,21 @@ SKIP: { my $env = ENV_CPANPLUS_IS_EXECUTING; my $sub = __PACKAGE__->_custom_makefile_pl_sub( "print qq[ENV=\$ENV{$env}\n]; exit 1;" ); - + my $clone = $Mod->clone; $clone->status->fetch( $Mod->status->fetch ); - + ok( $clone, 'Testing ENV settings $dist->prepare' ); ok( $clone->extract, ' Files extracted' ); ok( $clone->prepare, ' $mod->prepare worked first time' ); - + my $dist = $clone->status->dist; my $makefile_pl = MAKEFILE_PL->( $clone->status->extract ); ok( $sub->($dist), " Custom Makefile.PL written" ); ok( -e $makefile_pl, " File exists" ); - ### clear errors + ### clear errors CPANPLUS::Error->flush; my $rv = $dist->prepare( force => 1, verbose => 0 ); @@ -401,20 +401,20 @@ SKIP: { ### and the ENV var should no longer be set now ok( !$ENV{$env}, " ENV var now unset" ); -} +} sub _custom_makefile_pl_sub { my $pkg = shift; my $txt = shift or return; - + return sub { - my $dist = shift; + my $dist = shift; my $self = $dist->parent; my $fh = OPEN_FILE->( MAKEFILE_PL->($self->status->extract), '>' ); print $fh $txt; close $fh; - + return 1; } } diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/t/21_CPANPLUS-Dist-No-Build.t b/gnu/usr.bin/perl/cpan/CPANPLUS/t/21_CPANPLUS-Dist-No-Build.t index 10a2745d80d..55007ba5666 100755 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/t/21_CPANPLUS-Dist-No-Build.t +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/t/21_CPANPLUS-Dist-No-Build.t @@ -1,6 +1,6 @@ ### make sure we can find our conf.pl file -BEGIN { - use FindBin; +BEGIN { + use FindBin; require "$FindBin::Bin/inc/conf.pl"; } @@ -27,27 +27,27 @@ my $Inst = INSTALLER_BUILD; my $Mod = $CB->module_tree( 'Foo::Bar::MB::NOXS' ); -ok( $Mod, "Module object retrieved" ); +ok( $Mod, "Module object retrieved" ); ok( not grep { $_ eq $Inst } CPANPLUS::Dist->dist_types, " $Inst installer not returned" ); - -### fetch the file first + +### fetch the file first { my $where = $Mod->fetch; ok( -e $where, " Tarball '$where' exists" ); } - -### extract it, silence warnings/messages + +### extract it, silence warnings/messages { my $where = $Mod->extract; ok( -e $where, " Tarball extracted to '$where'" ); } -### check the installer type -{ is( $Mod->status->installer_type, $Inst, +### check the installer type +{ is( $Mod->status->installer_type, $Inst, "Proper installer type found: $Inst" ); my $href = $Mod->status->configure_requires; ok( scalar(keys(%$href)), " Dependencies recorded" ); - + ok( defined $href->{$Inst}, " Dependency on $Inst" ); cmp_ok( $href->{$Inst}, '>', 0, " Minimum version: $href->{$Inst}" ); @@ -55,7 +55,7 @@ ok( not grep { $_ eq $Inst } CPANPLUS::Dist->dist_types, my $err = CPANPLUS::Error->stack_as_string; like( $err, qr/$Inst/, " Message mentions $Inst" ); like( $err, qr/prerequisites list/, - " Message mentions adding prerequisites" ); + " Message mentions adding prerequisites" ); } ### now run the test, it should trigger the installation of the installer @@ -65,30 +65,30 @@ ok( not grep { $_ eq $Inst } CPANPLUS::Dist->dist_types, ### bootstrapping creates a call to $cb->module_tree('c::d::build')->install ### we need to intercept that call my $org_mt = CPANPLUS::Backend->can('module_tree'); - local *CPANPLUS::Backend::module_tree = sub { + local *CPANPLUS::Backend::module_tree = sub { my $self = shift; my $mod = shift; - + ### return a dummy object if this is the bootstrap call return CPANPLUS::Test::Module->new if $mod eq $Inst; - + ### otherwise do a regular call return $org_mt->( $self, $mod, @_ ); }; - + ### bootstrap install call will abort the ->create() call, so catch ### that here eval { $Mod->create( skiptest => 1) }; - + ok( $@, "Create call aborted at bootstrap phase" ); like( $@, qr/$Inst/, " Diagnostics confirmed" ); - + my $diag = CPANPLUS::Error->stack_as_string; like( $diag, qr/This module requires.*$Inst/, " Dependency on $Inst recorded" ); like( $diag, qr/Bootstrapping installer.*$Inst/, " Bootstrap notice recorded" ); - like( $diag, qr/Installer '$Inst' successfully bootstrapped/, + like( $diag, qr/Installer '$Inst' succesfully bootstrapped/, " Successful bootstrap recorded" ); } @@ -97,18 +97,18 @@ END { 1 while unlink output_file() } ### place holder package to serve as a module object for C::D::Build { package CPANPLUS::Test::Module; sub new { return bless {} } - sub install { + sub install { ### at load time we ignored C::D::Build. Reset the ignore here ### so a 'rescan' after the 'install' picks up C::D::Build CPANPLUS::Dist->_reset_dist_ignore; - return 1; + return 1; } } ### test package for cpanplus::dist::build { package CPANPLUS::Dist::Build; use base 'CPANPLUS::Dist::Base'; - + ### shortcut out of the installation procedure sub new { die __PACKAGE__ }; sub format_available { 1 } diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/t/25_CPANPLUS.t b/gnu/usr.bin/perl/cpan/CPANPLUS/t/25_CPANPLUS.t index b6723d35c64..9cbd15c7e3f 100755 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/t/25_CPANPLUS.t +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/t/25_CPANPLUS.t @@ -1,6 +1,6 @@ ### make sure we can find our conf.pl file -BEGIN { - use FindBin; +BEGIN { + use FindBin; require "$FindBin::Bin/inc/conf.pl"; } @@ -24,16 +24,16 @@ use_ok( $Class ); for my $meth ( qw[fetch get install] ) { my $sub = $Class->can( $meth ); ok( $sub, "$Class->can( $meth )" ); - + my %map = ( 0 => qr/failed/, 1 => qr/successful/, ); - + ok( 1, "Trying '$meth' in different configurations" ); - + while( my($rv, $re) = each %map ) { - + ### don't actually install, just test logic no warnings 'redefine'; local *CPANPLUS::Module::install = sub { $rv }; @@ -45,7 +45,7 @@ for my $meth ( qw[fetch get install] ) { is( $ok, $rv, " Expected RV: $rv" ); like( CPANPLUS::Error->stack_as_string, $re, " With expected diagnostic" ); - } + } ### does not take objects / references { CPANPLUS::Error->flush; @@ -74,15 +74,15 @@ for my $meth ( qw[fetch get install] ) { { ### test package for shell() method package CPANPLUS::Shell::Test; - + ### ->shell() looks in %INC use Module::Loaded qw[mark_as_loaded]; mark_as_loaded( __PACKAGE__ ); - sub new { bless {}, __PACKAGE__ }; + sub new { bless {}, __PACKAGE__ }; sub shell { $$ }; } - + my $rv = $sub->( 'Test' ); ok( $rv, " Shell started" ); is( $rv, $$, " Proper shell called" ); diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/t/30_CPANPLUS-Internals-Selfupdate.t b/gnu/usr.bin/perl/cpan/CPANPLUS/t/30_CPANPLUS-Internals-Selfupdate.t index 6347daa21cd..a816faa1766 100755 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/t/30_CPANPLUS-Internals-Selfupdate.t +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/t/30_CPANPLUS-Internals-Selfupdate.t @@ -1,6 +1,6 @@ ### make sure we can find our conf.pl file -BEGIN { - use FindBin; +BEGIN { + use FindBin; require "$FindBin::Bin/inc/conf.pl"; } @@ -35,7 +35,7 @@ my $Prereq = { $Dep => 0 }; } -### check specifically if our bundled shells dont trigger a +### check specifically if our bundled shells dont trigger a ### dependency (see #26077). ### do this _before_ changing the built in conf! { my $meth = 'modules_for_feature'; @@ -44,15 +44,15 @@ my $Prereq = { $Dep => 0 }; my $cur = $cobj->get_conf( $type ); for my $shell ( SHELL_DEFAULT, SHELL_CLASSIC ) { - ok( $cobj->set_conf( $type => $shell ), + ok( $cobj->set_conf( $type => $shell ), "Testing dependencies for '$shell'" ); my $rv = $CB->$Acc->$meth( $type => 1); ok( !$rv, " No dependencies for '$shell' -- bundled" ); - } - + } + for my $shell ( 'CPANPLUS::Test::Shell' ) { - ok( $cobj->set_conf( $type => $shell ), + ok( $cobj->set_conf( $type => $shell ), "Testing dependencies for '$shell'" ); my $rv = $CB->$Acc->$meth( $type => 1 ); @@ -62,7 +62,7 @@ my $Prereq = { $Dep => 0 }; is_deeply( $rv, { $shell => '0.0' }, " With the proper entries" ); } -} +} ### test the feature list { ### start with defining our OWN type of config, as not all mentioned @@ -75,7 +75,7 @@ my $Prereq = { $Dep => 0 }; } is_deeply( $Conf, $Class->_get_config, - "Config updated successfully" ); + "Config updated succesfully" ); my @cat = $CB->$Acc->list_categories; ok( scalar(@cat), "Category list returned" ); @@ -87,18 +87,18 @@ my $Prereq = { $Dep => 0 }; for my $feat (@feat) { my $meth = 'modules_for_feature'; my @mods = $CB->$Acc->$meth( $feat ); - + ok( $feat, "Testing feature '$feat'" ); ok( scalar( @mods ), " Module list returned" ); - + my $acc = 'is_installed_version_sufficient'; for my $mod (@mods) { isa_ok( $mod, "CPANPLUS::Module" ); isa_ok( $mod, $ModClass ); can_ok( $mod, $acc ); ok( $mod->$acc, " Module uptodate" ); - } - + } + ### check if we can get a hashref { my $href = $CB->$Acc->$meth( $feat, 1 ); ok( $href, "Got result as hash" ); @@ -106,7 +106,7 @@ my $Prereq = { $Dep => 0 }; is_deeply( $href, $Prereq, " With the proper entries" ); - } + } } ### see if we can get a list of modules to be updated @@ -124,7 +124,7 @@ my $Prereq = { $Dep => 0 }; cmp_ok( scalar(keys(%list)), '==', 1, "Got modules for '$cat' from '$meth'" ); - + my $aref = $list{$cat}; ok( $aref, " Got module list" ); cmp_ok( scalar(@$aref), '==', 1, @@ -136,22 +136,22 @@ my $Prereq = { $Dep => 0 }; ### find enabled features { my $meth = 'list_enabled_features'; - can_ok( $Class, $meth ); - + can_ok( $Class, $meth ); + my @list = $CB->$Acc->$meth; ok( scalar(@list), "Retrieved enabled features" ); is_deeply( [$Feat], \@list, " Proper features found" ); } - + ### find dependencies/core modules for my $meth ( qw[list_core_dependencies list_core_modules] ) { - can_ok( $Class, $meth ); - + can_ok( $Class, $meth ); + my @list = $CB->$Acc->$meth; ok( scalar(@list), "Retrieved modules" ); is( scalar(@list), 1, " 1 Found" ); - isa_ok( $list[0], $ModClass ); + isa_ok( $list[0], $ModClass ); is( $list[0]->name, $Dep, " Correct module found" ); @@ -163,7 +163,7 @@ my $Prereq = { $Dep => 0 }; " With the proper entries" ); } } - + ### now selfupdate ourselves { ### XXX just test the mechanics, make sure install returns true @@ -171,11 +171,11 @@ my $Prereq = { $Dep => 0 }; ### declare in a block to quelch 'sub redefined' warnings. { local *CPANPLUS::Selfupdate::Module::install = sub { 1 }; } local *CPANPLUS::Selfupdate::Module::install = sub { 1 }; - + my $meth = 'selfupdate'; can_ok( $Class, $meth ); - ok( $CB->$Acc->$meth( update => 'all'), + ok( $CB->$Acc->$meth( update => 'all'), " Selfupdate successful" ); } -} +} diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/t/40_CPANPLUS-Internals-Report.t b/gnu/usr.bin/perl/cpan/CPANPLUS/t/40_CPANPLUS-Internals-Report.t index a8823351d1e..ecce8a5b7cb 100755 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/t/40_CPANPLUS-Internals-Report.t +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/t/40_CPANPLUS-Internals-Report.t @@ -1,6 +1,6 @@ ### make sure we can find our conf.pl file -BEGIN { - use FindBin; +BEGIN { + use FindBin; require "$FindBin::Bin/inc/conf.pl"; } @@ -25,7 +25,7 @@ my $CB = CPANPLUS::Backend->new( $conf ); my $ModName = TEST_CONF_MODULE; my $ModPrereq = TEST_CONF_PREREQ; -### pick a high number, but not ~0 as possibly ~0 is unsigned, and we cause +### pick a high number, but not ~0 as possibly ~0 is unsigned, and we cause ### an overflow, as happens to version.pm 0.7203 among others. ### ANOTHER bug in version.pm, this time for 64bit: ### https://rt.cpan.org/Ticket/Display.html?id=45241 @@ -53,7 +53,7 @@ my $map = { check => 0, skiptests => 1, # did we skip the tests? - }, + }, missing_prereq => { buffer => missing_prereq_buffer(), failed => 1, @@ -87,7 +87,7 @@ my $map = { '/NA/', ], check => 0, - }, + }, perl_version_too_low_build1 => { buffer => perl_version_too_low_buffer_build(1), failed => 1, @@ -96,7 +96,7 @@ my $map = { '/NA/', ], check => 0, - }, + }, perl_version_too_low_build2 => { buffer => perl_version_too_low_buffer_build(2), failed => 1, @@ -105,7 +105,7 @@ my $map = { '/NA/', ], check => 0, - }, + }, prereq_versions_too_low => { ### set the prereq version incredibly high pre_hook => sub { @@ -119,14 +119,14 @@ my $map = { '/http://testers.cpan.org/', '/NA/', ], - check => 0, + check => 0, }, prereq_not_on_cpan => { pre_hook => sub { my $mod = shift; my $clone = $mod->clone; - $clone->status->prereqs( - { TEST_CONF_INVALID_MODULE, 0 } + $clone->status->prereqs( + { TEST_CONF_INVALID_MODULE, 0 } ); return $clone; }, @@ -135,14 +135,14 @@ my $map = { '/http://testers.cpan.org/', '/NA/', ], - check => 0, + check => 0, }, prereq_not_on_cpan_but_core => { pre_hook => sub { my $mod = shift; my $clone = $mod->clone; - $clone->status->prereqs( - { TEST_CONF_PREREQ, 0 } + $clone->status->prereqs( + { TEST_CONF_PREREQ, 0 } ); return $clone; }, @@ -151,11 +151,11 @@ my $map = { '/http://testers.cpan.org/', '/UNKNOWN/', ], - check => 0, + check => 0, }, }; -### test config settings +### test config settings { for my $opt ( qw[cpantest cpantest_mx] ) { my $warnings; local $SIG{__WARN__} = sub { $warnings .= "@_" }; @@ -167,7 +167,7 @@ my $map = { " Retrieved properly" ); ok( $conf->set_conf( $opt => $org ), " Option $opt set back to original" ); - ok( !$warnings, " No warnings" ); + ok( !$warnings, " No warnings" ); } } @@ -180,7 +180,7 @@ my $map = { ### test non-relevant tests ### my $cp = $Mod->clone; - $cp->module( ($^O eq 'beos' ? 'MSDOS' : 'Be') . '::' . $cp->module ); + $cp->module( $Mod->module . '::' . ($^O eq 'beos' ? 'MSDOS' : 'Be') ); ok(!RELEVANT_TEST_RESULT->($cp),"Test is irrelevant"); } @@ -219,15 +219,15 @@ my $map = { "Proper test fail stage found" ); } - ### test missing prereqs + ### test missing prereqs { my $str = q[Can't locate Foo/Bar.pm in @INC]; - + ### standard test { my @list = MISSING_PREREQS_LIST->( $str ); is( scalar(@list), 1, " List of missing prereqs found" ); is( $list[0], 'Foo::Bar', " Proper prereq found" ); } - + ### multiple mentions of same prereq { my @list = MISSING_PREREQS_LIST->( $str . $str ); @@ -256,14 +256,14 @@ my $map = { { my $prereqs = REPORT_MISSING_PREREQS->('foo','bar@example.com','Foo::Bar'); ok( $prereqs, "Test output generated" ); - like( $prereqs, qr/'foo \(bar\@example\.com\)'/, + like( $prereqs, qr/'foo \(bar\@example\.com\)'/, " Proper content found" ); like( $prereqs, qr/Foo::Bar/, " Proper content found" ); like( $prereqs, qr/prerequisi/, " Proper content found" ); like( $prereqs, qr/PREREQ_PM/, " Proper content found" ); } - { my $prereqs = REPORT_MISSING_PREREQS->(undef,undef,'Foo::Bar'); + { my $prereqs = REPORT_MISSING_PREREQS->(undef,undef,'Foo::Bar'); ok( $prereqs, "Test output generated" ); like( $prereqs, qr/Your Name/, " Proper content found" ); like( $prereqs, qr/Foo::Bar/, " Proper content found" ); @@ -291,15 +291,15 @@ my $map = { my @list = qw(foo bar); is_deeply( \@libs, \@list, " Proper content found" ); } - + { my $clone = $Mod->clone; my $prereqs = { $ModPrereq => $HighVersion }; - + $clone->status->prereqs( $prereqs ); my $str = REPORT_LOADED_PREREQS->( $clone ); - + like($str, qr/PREREQUISITES:/, "Listed loaded prerequisites" ); like($str, qr/\! $ModPrereq\s+\S+\s+\S+/, " Proper content found" ); @@ -308,7 +308,7 @@ my $map = { { my $clone = $Mod->clone; my $str = REPORT_TOOLCHAIN_VERSIONS->( $clone ); - + like($str, qr/toolchain/, "Correct message in report" ); use Cwd; like($str, qr/Cwd\s+\Q$Cwd::VERSION\E/, @@ -317,10 +317,10 @@ my $map = { } ### callback tests -{ ### as reported in bug 13086, this callback returned the wrong item +{ ### as reported in bug 13086, this callback returned the wrong item ### from the list: - ### $self->_callbacks->munge_test_report->($Mod, $message, $grade); - my $rv = $CB->_callbacks->munge_test_report->( 1..4 ); + ### $self->_callbacks->munge_test_report->($Mod, $message, $grade); + my $rv = $CB->_callbacks->munge_test_report->( 1..4 ); is( $rv, 2, "Default 'munge_test_report' callback OK" ); } @@ -334,14 +334,14 @@ SKIP: { unless $CB->_have_query_report_modules(verbose => 0); - SKIP: { + SKIP: { my $mod = $CB->module_tree( TEST_CONF_PREREQ ); # is released to CPAN ok( $mod, "Module retrieved" ); - + ### so we're not pinned down to this specific version of perl my @list = $mod->fetch_report( all_versions => 1 ); skip "Possibly no net connection, or server down", 7 unless @list; - + my $href = $list[0]; ok( scalar(@list), "Fetched test report" ); is( ref $href, ref {}, " Return value has hashrefs" ); @@ -389,7 +389,7 @@ SKIP: { : $Mod; my $file = do { - ### so T::R does not try to resolve our maildomain, which can + ### so T::R does not try to resolve our maildomain, which can ### lead to large timeouts for *every* invocation in T::R < 1.51_01 ### see: http://code.google.com/p/test-reporter/issues/detail?id=15 local $ENV{MAILDOMAIN} ||= 'example.com'; @@ -477,7 +477,7 @@ BEGIN failed--compilation aborted at Makefile.PL line 1. BEGIN failed--compilation aborted at Makefile.PL line 1. -- cannot continue ]; -} +} sub perl_version_too_low_buffer_build { my $type = shift; @@ -493,7 +493,7 @@ ERROR: version: Prerequisite version isn't installed ERRORS/WARNINGS FOUND IN PREREQUISITES. You may wish to install the versions of the modules indicated above before proceeding with this installation. ] if($type == 2); -} +} # Local variables: # c-indentation-style: bsd diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/t/inc/conf.pl b/gnu/usr.bin/perl/cpan/CPANPLUS/t/inc/conf.pl index 4cce0efcb43..ca6473157cd 100644 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/t/inc/conf.pl +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/t/inc/conf.pl @@ -2,9 +2,9 @@ ### So reset it here explicitly my ($old_env_path, $old_env_perl5lib); BEGIN { - use FindBin; + use FindBin; use File::Spec; - + ### paths to our own 'lib' and 'inc' dirs ### include them, relative from t/ my @paths = map { "$FindBin::Bin/$_" } qw[../lib inc]; @@ -12,21 +12,21 @@ BEGIN { ### absolute'ify the paths in @INC; my @rel2abs = map { File::Spec->rel2abs( $_ ) } grep { not File::Spec->file_name_is_absolute( $_ ) } @INC; - + ### use require to make devel::cover happy require lib; - for ( @paths, @rel2abs ) { - my $l = 'lib'; - $l->import( $_ ) + for ( @paths, @rel2abs ) { + my $l = 'lib'; + $l->import( $_ ) } use Config; ### and add them to the environment, so shellouts get them $old_env_perl5lib = $ENV{'PERL5LIB'}; - $ENV{'PERL5LIB'} = join $Config{'path_sep'}, + $ENV{'PERL5LIB'} = join $Config{'path_sep'}, 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 $old_env_path = $ENV{PATH}; @@ -42,10 +42,10 @@ BEGIN { ### Fix up the path to perl, as we're about to chdir ### but only under perlcore, or if the path contains delimiters, ### meaning it's relative, but not looked up in your $PATH - $^X = File::Spec->rel2abs( $^X ) + $^X = File::Spec->rel2abs( $^X ) if $ENV{PERL_CORE} or ( $^X =~ m|[/\\]| ); - ### chdir to our own test dir, so we know all files are relative + ### chdir to our own test dir, so we know all files are relative ### to this point, no matter whether run from perlcore tests or ### regular CPAN installs chdir "$FindBin::Bin" if -d "$FindBin::Bin" @@ -53,7 +53,7 @@ BEGIN { BEGIN { use IPC::Cmd; - + ### Win32 has issues with redirecting FD's properly in IPC::Run: ### Can't redirect fd #4 on Win32 at IPC/Run.pm line 2801 $IPC::Cmd::USE_IPC_RUN = 0 if $^O eq 'MSWin32'; @@ -94,7 +94,7 @@ use File::Basename qw[basename]; 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_PREREQ => 'Cwd'; use constant TEST_CONF_MODULE => 'Foo::Bar::EU::NOXS'; use constant TEST_CONF_MODULE_SUB => 'Foo::Bar::EU::NOXS::Sub'; use constant TEST_CONF_AUTHOR => 'EUNOXS'; @@ -104,7 +104,7 @@ use constant TEST_CONF_MIRROR_DIR => 'dummy-localmirror'; use constant TEST_CONF_CPAN_DIR => 'dummy-CPAN'; use constant TEST_CONF_CPANPLUS_DIR => 'dummy-cpanplus'; use constant TEST_CONF_INSTALL_DIR => File::Spec->rel2abs( - File::Spec->catdir( + File::Spec->catdir( TEST_CONF_CPANPLUS_DIR, 'install' ) @@ -118,41 +118,36 @@ sub dummy_cpan_dir { ### Convert to an absolute file specification my $abs_test_dir = File::Spec->rel2abs($test_dir); - - ### According to John M: the hosts path needs to be in UNIX format. + + ### According to John M: the hosts path needs to be in UNIX format. ### File::Spec::Unix->rel2abs does not work at all on VMS $abs_test_dir = VMS::Filespec::unixify( $abs_test_dir ) if $^O eq 'VMS'; return $abs_test_dir; } -sub gimme_conf { +sub gimme_conf { ### don't load any other configs than the heuristic one ### during tests. They might hold broken/incorrect data ### for our test suite. Bug [perl #43629] showed this. - local $ENV{PERL5_CPANPLUS_HOME} = ''; - my $conf = CPANPLUS::Configure->new( load_configs => 0 ); my $dummy_cpan = dummy_cpan_dir(); - - $conf->set_conf( hosts => [ { + + $conf->set_conf( hosts => [ { path => $dummy_cpan, scheme => 'file', - } ], + } ], ); $conf->set_conf( base => File::Spec->rel2abs(TEST_CONF_CPANPLUS_DIR)); $conf->set_conf( dist_type => '' ); $conf->set_conf( signature => 0 ); - $conf->set_conf( allow_unknown_prereqs => 1 ); # just to make sure, eh $conf->set_conf( verbose => 1 ) if $ENV{ $Env }; - + ### never use a pager in the test suite $conf->set_program( pager => '' ); - $conf->set_conf( enable_custom_sources => 0 ); - ### dmq tells us that we should run with /nologo ### if using nmake, as it's very noisy otherwise. { my $make = $conf->get_program('make'); @@ -170,7 +165,7 @@ sub gimme_conf { ### cpanp-run-perl installed the same amount of 'uplevels' ### as the /tmp/foo prefix, we'll pull in the wrong script ### by accident. - ### Since we set the path to cpanp-run-perl explicitly + ### Since we set the path to cpanp-run-perl explicitily ### at the top of this script, it's best to update the config ### ourselves with a path lookup, rather than rely on its ### heuristics. Thanks to David Wheeler, Josh Jore and Vincent @@ -181,16 +176,16 @@ sub gimme_conf { $conf->set_conf( source_engine => $ENV{CPANPLUS_SOURCE_ENGINE} ) if $ENV{CPANPLUS_SOURCE_ENGINE}; - + _clean_test_dir( [ - $conf->get_conf('base'), + $conf->get_conf('base'), TEST_CONF_MIRROR_DIR, # TEST_INSTALL_DIR_LIB, # TEST_INSTALL_DIR_BIN, -# TEST_INSTALL_DIR_MAN1, +# TEST_INSTALL_DIR_MAN1, # TEST_INSTALL_DIR_MAN3, ], ( $ENV{PERL_CORE} ? 0 : 1 ) ); - + return $conf; }; @@ -199,47 +194,47 @@ sub gimme_conf { my $file = ".".basename($0).".output"; sub output_handle { return $fh if $fh; - + $fh = FileHandle->new(">$file") or warn "Could not open output file '$file': $!"; - + $fh->autoflush(1); return $fh; } - + sub output_file { return $file } - - - + + + ### redirect output from msg() and error() output to file unless( $ENV{$Env} ) { - + print "# To run tests in verbose mode, set ". "\$ENV{$Env} = 1\n" unless $ENV{PERL_CORE}; - + 1 while unlink $file; # just in case - + $CPANPLUS::Error::ERROR_FH = $CPANPLUS::Error::ERROR_FH = output_handle(); - + $CPANPLUS::Error::MSG_FH = $CPANPLUS::Error::MSG_FH = output_handle(); - - } + + } } ### clean these files if we're under perl core -END { +END { if ( $ENV{PERL_CORE} ) { close output_handle(); 1 while unlink output_file(); _clean_test_dir( [ - gimme_conf->get_conf('base'), + gimme_conf->get_conf('base'), TEST_CONF_MIRROR_DIR, # TEST_INSTALL_DIR_LIB, # TEST_INSTALL_DIR_BIN, - # TEST_INSTALL_DIR_MAN1, + # TEST_INSTALL_DIR_MAN1, # TEST_INSTALL_DIR_MAN3, ], 0 ); # DO NOT be verbose under perl core -- makes tests fail } @@ -258,47 +253,47 @@ sub _clean_test_dir { my $dh; opendir $dh, $dir or die "Could not open basedir '$dir': $!"; - while( my $file = readdir $dh ) { + while( my $file = readdir $dh ) { next if $file =~ /^\./; # skip dot files - + my $path = File::Spec->catfile( $dir, $file ); - + ### directory, rmtree it if( -d $path ) { ### John Malmberg reports yet another VMS issue: - ### A directory name on VMS in VMS format ends with .dir + ### 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 + ### 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. - + ### 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. + ### according to John. M. $file =~ s/\.dir$//i if $^O eq 'VMS'; - + my $dirpath = File::Spec->catdir( $dir, $file ); print "# Deleting directory '$dirpath'\n" if $verbose; eval { rmtree( $dirpath ) }; - warn "Could not delete '$dirpath' while cleaning up '$dir'" + warn "Could not delete '$dirpath' while cleaning up '$dir'" if $@; - + ### regular file } else { print "# Deleting file '$path'\n" if $verbose; 1 while unlink $path; - } - } - + } + } + close $dh; } - + return 1; } 1; |