use vars qw( @EXPORT @ISA $VERSION );
@EXPORT = qw( shell fetch get install );
@ISA = qw( Exporter );
- $VERSION = "0.87_02"; #have to hardcode or cpan.org gets unhappy
+ $VERSION = "0.87_03"; #have to hardcode or cpan.org gets unhappy
}
### purely for backward compatibility, so we can call it from the commandline:
use FileHandle;
use File::Spec ();
use File::Spec::Unix ();
-use File::Basename ();
+use File::Basename ();
use Params::Check qw[check];
use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';
my $dir = File::Spec->rel2abs($mod);
my $parent = File::Spec->rel2abs( File::Spec->catdir( $dir, '..' ) );
+ ### fix paths on VMS
+ if (ON_VMS) {
+ $dir = VMS::Filespec::unixify($dir);
+ $parent = VMS::Filespec::unixify($parent);
+ }
+
my $dist = $mod = File::Basename::basename($dir);
$dist .= '-0' unless $dist =~ /\-[0-9._]+$/;
$dist .= '.tar.gz' unless $dist =~ /\.[A-Za-z]+$/;
CPANPLUS::Internals::Report
];
-$VERSION = "0.87_02";
+$VERSION = "0.87_03";
=pod
"CPANPLUS/$CPANPLUS::Internals::VERSION"
};
use constant TESTERS_URL => sub {
- "http://testers.cpan.org/show/" .
- $_[0] .".yaml"
+ 'http://cpantesters.org/distro/'.
+ uc(substr($_[0],0,1)) .'/'. $_[0] . '.yaml';
};
use constant TESTERS_DETAILS_URL
=> sub {
- 'http://testers.cpan.org/show/' .
- $_[0] . '.html';
+ 'http://cpantesters.org/distro/'.
+ uc(substr($_[0],0,1)) .'/'. $_[0];
};
use constant CREATE_FILE_URI
$href->{'details'} = $details;
### backwards compatibility :(
- $href->{'dist'} = delete $href->{'distversion'};
- $href->{'grade'} = delete $href->{'action'};
+ $href->{'dist'} ||= $href->{'distversion'};
+ $href->{'grade'} ||= $href->{'action'} || $href->{'status'};
push @rv, $href;
}
BEGIN {
use vars qw[ $VERSION @ISA ];
@ISA = qw[ CPANPLUS::Shell::_Base::ReadLine ];
- $VERSION = "0.87_02";
+ $VERSION = "0.87_03";
}
load CPANPLUS::Shell;
### prompt after the command has finished.
$self->noninteractive($noninteractive) if defined $noninteractive;
- my @cmds = split ';', $string;
+ my $rv = 1;
+
+ my @cmds = split ';', $string;
while( my $input = shift @cmds ) {
### to send over the socket ###
my $method = $map->{$key};
### dispatch meta locally at all times ###
- $self->$method(input => $input, options => $options), next
- if $key eq '/';
+ if( $key eq '/' ) {
+ ### keep track of failures
+ $rv *= length $self->$method(input => $input, options => $options);
+ next;
+ }
### flush unless we're trying to print the stack
CPANPLUS::Error->flush unless $key eq 'p';
$self->__print( "\n", loc("Command failed!"), "\n\n" )
unless $status;
+ ### keep track of failures
+ $rv *= length $status;
+
$self->_pager_open if $buff =~ tr/\n// > $self->_term_rowcount;
$self->__print( $buff );
$self->_pager_close;
@mods = $self->_select_modules($input)
unless grep {$key eq $_} qw[! m a v w x p s b / ? h];
- eval { $self->$method( modules => \@mods,
+ ### keep track of failures
+ $rv *= defined eval { $self->$method(
+ modules => \@mods,
options => $options,
input => $input,
choice => $key )
}
}
+ ### outside the shell loop, we can return the actual return value;
+ return $rv if $self->noninteractive;
+
return;
}
} else {
$self->__print( loc("No results to display"), "\n" );
}
+
+ return 1;
}
if defined $rc->{'logout'};
$self->__print( loc("Exiting CPANPLUS shell"), "\n" );
+
+ return 1;
}
###########################
$self->__print( map {"$_\n"} @help );
$self->__print( $/ );
$self->_pager_close;
+
+ return 1;
}
}
eval $input;
error( $@ ) if $@;
$self->__print( "\n" );
- return;
+
+ return if $@;
+ return 1;
}
sub _search_module {
}
$self->_pager_open if @$mods >= $self->_term_rowcount;
+ my $rv = 1;
for my $mod (@$mods) {
my $where = $mod->fetch( %$opts );
+ $rv *= length $where;
+
$self->__print(
$where
? loc("Successfully fetched '%1' to '%2'",
$self->__print( "\n" );
}
$self->_pager_close;
-
+
+ return 1 if $rv;
+ return;
}
sub _shell {
$self->cache([undef,@rv]);
$self->__display_results;
- return; 1;
+ return 1;
}
sub _reload_indices {
return 1;
}
-
### Load plugins
{ my @PluginModules;
my %Dispatch = (
my $init_done;
sub _plugins_init {
+
### only initialize once
return if $init_done++;
### strip the leading dash
$input =~ s/^\s*-//;
### pass the command line to the shell
- $shell->dispatch_on_input(input => $input, noninteractive => 1);
+ ### exit with a useful return value on return
+ exit not $shell->dispatch_on_input(input => $input, noninteractive => 1);
} else {
### open a shell for the user
$shell->shell();
" Proper version found: $version" );
is( $obj->package_version, $version,
" Found in package_version as well" );
- is( $obj->package_name, $pkg_name,
+
+ ### VMS doesn't preserve case, so match them after normalizing case
+ is( uc($obj->package_name), uc($pkg_name),
" Proper package_name found: $pkg_name" );
unlike( $obj->package_name, qr/\d/,
" No digits in package name" );
uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/authors/01mailrc.txt.gz lib/CPANPLUS/t/dummy-CPAN/authors/01mailrc.txt.gz.packed
-Created at Sat Jun 13 13:18:28 2009
+Created at Sat Jun 27 16:51:08 2009
#########################################################################
__UU__
M'XL("%_EO$4``S`Q;6%I;')C+G1X=`!+S,E,+%9P#8T(5@`#)=>*DM"2S)QB
uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/Bundle-Foo-Bar-0.01.tar.gz lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/Bundle-Foo-Bar-0.01.tar.gz.packed
-Created at Sat Jun 13 13:18:28 2009
+Created at Sat Jun 27 16:51:08 2009
#########################################################################
__UU__
M'XL("!1%OT4"`T)U;F1L92U&;V\M0F%R+3`N,#$N=&%R`.V7:V_:,!2&^8I_
uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/Foo-Bar-0.01.tar.gz lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/Foo-Bar-0.01.tar.gz.packed
-Created at Sat Jun 13 13:18:28 2009
+Created at Sat Jun 27 16:51:08 2009
#########################################################################
__UU__
M'XL(`#P*BD<``^V:;6_B1A"`\WE_Q214(I$.QQ@;)*<YE;M"$^E(JB37GG0]
uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/perl5.005_03.tar.gz lib/CPANPLUS/t/dummy-CPAN/authors/id/EUNOXS/perl5.005_03.tar.gz.packed
-Created at Sat Jun 13 13:18:28 2009
+Created at Sat Jun 27 16:51:08 2009
#########################################################################
__UU__
M'XL(`'3DO44``^W/,0J`,`Q`T1RE)Y"T-O4XXN"DB%2]OR(*NNC4[;_E#\F0
uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/authors/id/EUXS/Foo-Bar-0.01.tar.gz lib/CPANPLUS/t/dummy-CPAN/authors/id/EUXS/Foo-Bar-0.01.tar.gz.packed
-Created at Sat Jun 13 13:18:28 2009
+Created at Sat Jun 27 16:51:08 2009
#########################################################################
__UU__
M'XL("`DY34("`T9O;RU"87(M,"XP,2YT87(`[5IK3]M(%,U7YE=<H%5``A.;
uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/authors/id/MBNOXS/Foo-Bar-0.01.tar.gz lib/CPANPLUS/t/dummy-CPAN/authors/id/MBNOXS/Foo-Bar-0.01.tar.gz.packed
-Created at Sat Jun 13 13:18:28 2009
+Created at Sat Jun 27 16:51:08 2009
#########################################################################
__UU__
M'XL("-<X34(``T9O;RU"87(M,"XP,2YT87(`[9E;;]HP%,=Y]J<X+9722@-R
uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/authors/id/MBXS/Foo-Bar-0.01.tar.gz lib/CPANPLUS/t/dummy-CPAN/authors/id/MBXS/Foo-Bar-0.01.tar.gz.packed
-Created at Sat Jun 13 13:18:28 2009
+Created at Sat Jun 27 16:51:08 2009
#########################################################################
__UU__
M'XL("-\X34(``T9O;RU"87(M,"XP,2YT87(`[5K_3QI)%/=7YZ]XU39H(BN[
uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/modules/02packages.details.txt.gz lib/CPANPLUS/t/dummy-CPAN/modules/02packages.details.txt.gz.packed
-Created at Sat Jun 13 13:18:28 2009
+Created at Sat Jun 27 16:51:08 2009
#########################################################################
__UU__
M'XL("#=P,DH``S`R<&%C:V%G97,N9&5T86EL<RYT>'0`G=-1;],P$`#@=_^*
uupacktool.pl -p lib/CPANPLUS/t/dummy-CPAN/modules/03modlist.data.gz lib/CPANPLUS/t/dummy-CPAN/modules/03modlist.data.gz.packed
-Created at Sat Jun 13 13:18:28 2009
+Created at Sat Jun 27 16:51:08 2009
#########################################################################
__UU__
M'XL("#'FO$4``S`S;6]D;&ES="YD871A`%U3_6O;,!#].?HKCBXC"20A=<@&
projects / platform / upstream / perl.git / commitdiff