diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/CPANPLUS/Shell/Default.pm')
-rw-r--r-- | Master/tlpkg/tlperl/lib/CPANPLUS/Shell/Default.pm | 1938 |
1 files changed, 1938 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Shell/Default.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Shell/Default.pm new file mode 100644 index 00000000000..a9d51422f66 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/CPANPLUS/Shell/Default.pm @@ -0,0 +1,1938 @@ +package CPANPLUS::Shell::Default; + +use strict; + + +use CPANPLUS::Error; +use CPANPLUS::Backend; +use CPANPLUS::Configure::Setup; +use CPANPLUS::Internals::Constants; +use CPANPLUS::Internals::Constants::Report qw[GRADE_FAIL]; + +use Cwd; +use IPC::Cmd; +use Term::UI; +use Data::Dumper; +use Term::ReadLine; + +use Module::Load qw[load]; +use Params::Check qw[check]; +use Module::Load::Conditional qw[can_load check_install]; +use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext'; + +local $Params::Check::VERBOSE = 1; +local $Data::Dumper::Indent = 1; # for dumpering from ! + +BEGIN { + use vars qw[ $VERSION @ISA ]; + @ISA = qw[ CPANPLUS::Shell::_Base::ReadLine ]; + $VERSION = "0.90"; +} + +load CPANPLUS::Shell; + + +my $map = { + 'm' => '_search_module', + 'a' => '_search_author', + '!' => '_bang', + '?' => '_help', + 'h' => '_help', + 'q' => '_quit', + 'r' => '_readme', + 'v' => '_show_banner', + 'w' => '__display_results', + 'd' => '_fetch', + 'z' => '_shell', + 'f' => '_distributions', + 'x' => '_reload_indices', + 'i' => '_install', + 't' => '_install', + 'l' => '_details', + 'p' => '_print', + 's' => '_set_conf', + 'o' => '_uptodate', + 'b' => '_autobundle', + 'u' => '_uninstall', + '/' => '_meta', # undocumented for now + 'c' => '_reports', +}; +### free letters: e g j k n y ### + + +### will be filled if you have a .default-shell.rc and +### Config::Auto installed +my $rc = {}; + +### the shell object, scoped to the file ### +my $Shell; +my $Brand = loc('CPAN Terminal'); +my $Prompt = $Brand . '> '; + +=pod + +=head1 NAME + +CPANPLUS::Shell::Default + +=head1 SYNOPSIS + + ### loading the shell: + $ cpanp # run 'cpanp' from the command line + $ perl -MCPANPLUS -eshell # load the shell from the command line + + + use CPANPLUS::Shell qw[Default]; # load this shell via the API + # always done via CPANPLUS::Shell + + my $ui = CPANPLUS::Shell->new; + $ui->shell; # run the shell + $ui->dispatch_on_input( input => 'x'); # update the source using the + # dispatch method + + ### when in the shell: + ### Note that all commands can also take options. + ### Look at their underlying CPANPLUS::Backend methods to see + ### what options those are. + cpanp> h # show help messages + cpanp> ? # show help messages + + cpanp> m Acme # find acme modules, allows regexes + cpanp> a KANE # find modules by kane, allows regexes + cpanp> f Acme::Foo # get a list of all releases of Acme::Foo + + cpanp> i Acme::Foo # install Acme::Foo + cpanp> i Acme-Foo-1.3 # install version 1.3 of Acme::Foo + cpanp> i <URI> # install from URI, like ftp://foo.com/X.tgz + cpanp> i <DIR> # install from an absolute or relative directory + cpanp> i 1 3..5 # install search results 1, 3, 4 and 5 + cpanp> i * # install all search results + cpanp> a KANE; i *; # find modules by kane, install all results + cpanp> t Acme::Foo # test Acme::Foo, without installing it + cpanp> u Acme::Foo # uninstall Acme::Foo + cpanp> d Acme::Foo # download Acme::Foo + cpanp> z Acme::Foo # download & extract Acme::Foo, then open a + # shell in the extraction directory + + cpanp> c Acme::Foo # get a list of test results for Acme::Foo + cpanp> l Acme::Foo # view details about the Acme::Foo package + cpanp> r Acme::Foo # view Acme::Foo's README file + cpanp> o # get a list of all installed modules that + # are out of date + cpanp> o 1..3 # list uptodateness from a previous search + + cpanp> s conf # show config settings + cpanp> s conf md5 1 # enable md5 checks + cpanp> s program # show program settings + cpanp> s edit # edit config file + cpanp> s reconfigure # go through initial configuration again + cpanp> s selfupdate # update your CPANPLUS install + cpanp> s save # save config to disk + cpanp> s mirrors # show currently selected mirrors + + cpanp> ! [PERL CODE] # execute the following perl code + + cpanp> b # create an autobundle for this computers + # perl installation + cpanp> x # reload index files (purges cache) + cpanp> x --update_source # reload index files, get fresh source files + cpanp> p [FILE] # print error stack (to a file) + cpanp> v # show the banner + cpanp> w # show last search results again + + cpanp> q # quit the shell + + cpanp> /plugins # list avialable plugins + cpanp> /? PLUGIN # list help test of <PLUGIN> + + ### common options: + cpanp> i ... --skiptest # skip tests + cpanp> i ... --force # force all operations + cpanp> i ... --verbose # run in verbose mode + +=head1 DESCRIPTION + +This module provides the default user interface to C<CPANPLUS>. You +can start it via the C<cpanp> binary, or as detailed in the L<SYNOPSIS>. + +=cut + +sub new { + my $class = shift; + + my $cb = CPANPLUS::Backend->new( @_ ); + my $self = $class->SUPER::_init( + brand => $Brand, + term => Term::ReadLine->new( $Brand ), + prompt => $Prompt, + backend => $cb, + format => "%4s %-55s %8s %-10s\n", + dist_format => "%4s %-42s %-12s %8s %-10s\n", + ); + ### make it available package wide ### + $Shell = $self; + + my $rc_file = File::Spec->catfile( + $cb->configure_object->get_conf('base'), + DOT_SHELL_DEFAULT_RC, + ); + + + if( -e $rc_file && -r _ ) { + $rc = $self->_read_configuration_from_rc( $rc_file ); + } + + ### register install callback ### + $cb->_register_callback( + name => 'install_prerequisite', + code => \&__ask_about_install, + ); + + ### execute any login commands specified ### + $self->dispatch_on_input( input => $rc->{'login'} ) + if defined $rc->{'login'}; + + ### register test report callbacks ### + $cb->_register_callback( + name => 'edit_test_report', + code => \&__ask_about_edit_test_report, + ); + + $cb->_register_callback( + name => 'send_test_report', + code => \&__ask_about_send_test_report, + ); + + $cb->_register_callback( + name => 'proceed_on_test_failure', + code => \&__ask_about_test_failure, + ); + + ### load all the plugins + $self->_plugins_init; + + return $self; +} + +sub shell { + my $self = shift; + my $term = $self->term; + my $conf = $self->backend->configure_object; + + $self->_show_banner; + $self->__print( "*** Type 'p' now to show start up log\n" ); # XXX add to banner? + $self->_show_random_tip if $conf->get_conf('show_startup_tip'); + $self->_input_loop && $self->__print( "\n" ); + $self->_quit; +} + +sub _input_loop { + my $self = shift; + my $term = $self->term; + my $cb = $self->backend; + + my $normal_quit = 0; + while ( + defined (my $input = eval { $term->readline($self->prompt) } ) + or $self->_signals->{INT}{count} == 1 + ) { + ### re-initiate all signal handlers + while (my ($sig, $entry) = each %{$self->_signals} ) { + $SIG{$sig} = $entry->{handler} if exists($entry->{handler}); + } + + $self->__print( "\n" ); + last if $self->dispatch_on_input( input => $input ); + + ### flush the lib cache ### + $cb->_flush( list => [qw|lib load|] ); + + } continue { + ### clear the sigint count + $self->_signals->{INT}{count}-- + if $self->_signals->{INT}{count}; + + ### reset the 'install prereq?' cached answer + $self->settings->{'install_all_prereqs'} = undef; + + } + + return 1; +} + +### return 1 to quit ### +sub dispatch_on_input { + my $self = shift; + my $conf = $self->backend->configure_object(); + my $term = $self->term; + my %hash = @_; + + my($string, $noninteractive); + my $tmpl = { + input => { required => 1, store => \$string }, + noninteractive => { required => 0, store => \$noninteractive }, + }; + + check( $tmpl, \%hash ) or return; + + ### indicates whether or not the user will receive a shell + ### prompt after the command has finished. + $self->noninteractive($noninteractive) if defined $noninteractive; + + my $rv = 1; + + my @cmds = split ';', $string; + while( my $input = shift @cmds ) { + + ### to send over the socket ### + my $org_input = $input; + + my $key; my $options; + { ### make whitespace not count when using special chars + { $input =~ s|^\s*([!?/])|$1 |; } + + ### get the first letter of the input + $input =~ s|^\s*([\w\?\!/])\w*||; + + chomp $input; + $key = lc($1); + + ### we figured out what the command was... + ### if we have more input, that DOES NOT start with a white + ### space char, we misparsed.. like 'Test::Foo::Bar', which + ### would turn into 't', '::Foo::Bar'... + if( $input and $input !~ s/^\s+// ) { + $self->__print( loc("Could not understand command: %1\n". + "Possibly missing command before argument(s)?\n", + $org_input) ); + return; + } + + ### allow overrides from the config file ### + if( defined $rc->{$key} ) { + $input = $rc->{$key} . $input; + } + + ### grab command line options like --no-force and --verbose ### + ($options,$input) = $term->parse_options($input) + unless $key eq '!'; + } + + ### emtpy line? ### + return unless $key; + + ### time to quit ### + return 1 if $key eq 'q'; + + my $method = $map->{$key}; + + ### dispatch meta locally at all times ### + 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'; + + ### connected over a socket? ### + if( $self->remote ) { + + ### unsupported commands ### + if( $key eq 'z' or + ($key eq 's' and $input =~ /^\s*edit/) + ) { + $self->__print( "\n", + loc( "Command '%1' not supported over remote connection", + join ' ', $key, $input + ), "\n\n" ); + + } else { + my($status,$buff) = $self->__send_remote_command($org_input); + + $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; + } + + ### or just a plain local shell? ### + } else { + + unless( $self->can($method) ) { + $self->__print(loc("Unknown command '%1'. Usage:", $key), "\n"); + $self->_help; + + } else { + + ### some methods don't need modules ### + my @mods; + @mods = $self->_select_modules($input) + unless grep {$key eq $_} qw[! m a v w x p s b / ? h]; + + ### keep track of failures + $rv *= defined eval { $self->$method( + modules => \@mods, + options => $options, + input => $input, + choice => $key ) + }; + error( $@ ) if $@; + } + } + } + + ### outside the shell loop, we can return the actual return value; + return $rv if $self->noninteractive; + + return; +} + +sub _select_modules { + my $self = shift; + my $input = shift or return; + my $cache = $self->cache; + my $cb = $self->backend; + + ### expand .. in $input + $input =~ s{\b(\d+)\s*\.\.\s*(\d+)\b} + {join(' ', ($1 < 1 ? 1 : $1) .. ($2 > $#{$cache} ? $#{$cache} : $2))}eg; + + $input = join(' ', 1 .. $#{$cache}) if $input eq '*'; + $input =~ s/'/::/g; # perl 4 convention + + my @rv; + for my $mod (split /\s+/, $input) { + + ### it's a cache look up ### + if( $mod =~ /^\d+/ and $mod > 0 ) { + unless( scalar @$cache ) { + $self->__print( loc("No search was done yet!"), "\n" ); + + } elsif ( my $obj = $cache->[$mod] ) { + push @rv, $obj; + + } else { + $self->__print( loc("No such module: %1", $mod), "\n" ); + } + + } else { + my $obj = $cb->parse_module( module => $mod ); + + unless( $obj ) { + $self->__print( loc("No such module: %1", $mod), "\n" ); + + } else { + push @rv, $obj; + } + } + } + + unless( scalar @rv ) { + $self->__print( loc("No modules found to operate on!\n") ); + return; + } else { + return @rv; + } +} + +sub _format_version { + my $self = shift; + my $version = shift || 0; + + ### fudge $version into the 'optimal' format + $version = 0 if $version eq 'undef'; + $version =~ s/_//g; # everything after gets stripped off otherwise + + ### allow 6 digits after the dot, as that's how perl stringifies + ### x.y.z numbers. + $version = sprintf('%3.6f', $version); + $version = '' if $version == '0.00'; + $version =~ s/(00{0,3})$/' ' x (length $1)/e; + + return $version; +} + +sub __display_results { + my $self = shift; + my $cache = $self->cache; + + my @rv = @$cache; + + if( scalar @rv ) { + + $self->_pager_open if $#{$cache} >= $self->_term_rowcount; + + my $i = 1; + for my $mod (@rv) { + next unless $mod; # first one is undef + # humans start counting at 1 + + ### for dists only -- we have checksum info + if( $mod->mtime ) { + $self->__printf( + $self->dist_format, + $i, + $mod->module, + $mod->mtime, + $self->_format_version( $mod->version ), + $mod->author->cpanid + ); + + } else { + $self->__printf( + $self->format, + $i, + $mod->module, + $self->_format_version( $mod->version ), + $mod->author->cpanid + ); + } + $i++; + } + + $self->_pager_close; + + } else { + $self->__print( loc("No results to display"), "\n" ); + } + + return 1; +} + + +sub _quit { + my $self = shift; + + $self->dispatch_on_input( input => $rc->{'logout'} ) + if defined $rc->{'logout'}; + + $self->__print( loc("Exiting CPANPLUS shell"), "\n" ); + + return 1; +} + +########################### +### actual command subs ### +########################### + + +### print out the help message ### +### perhaps, '?' should be a slightly different version ### +{ my @help; + sub _help { + my $self = shift; + my %hash = @_; + + my $input; + { local $Params::Check::ALLOW_UNKNOWN = 1; + + my $tmpl = { + input => { required => 0, store => \$input } + }; + + my $args = check( $tmpl, \%hash ) or return; + } + + @help = ( +loc('[General]' ), +loc(' h | ? # display help' ), +loc(' q # exit' ), +loc(' v # version information' ), +loc('[Search]' ), +loc(' a AUTHOR ... # search by author(s)' ), +loc(' m MODULE ... # search by module(s)' ), +loc(' f MODULE ... # list all releases of a module' ), +loc(" o [ MODULE ... ] # list installed module(s) that aren't up to date" ), +loc(' w # display the result of your last search again' ), +loc('[Operations]' ), +loc(' i MODULE | NUMBER ... # install module(s), by name or by search number' ), +loc(' i URI | ... # install module(s), by URI (ie http://foo.com/X.tgz)' ), +loc(' i DIR | ... # install module(s), by path (ie ./Module-1.0)' ), +loc(' t MODULE | NUMBER ... # test module(s), by name or by search number' ), +loc(' u MODULE | NUMBER ... # uninstall module(s), by name or by search number' ), +loc(' d MODULE | NUMBER ... # download module(s)' ), +loc(' l MODULE | NUMBER ... # display detailed information about module(s)' ), +loc(' r MODULE | NUMBER ... # display README files of module(s)' ), +loc(' c MODULE | NUMBER ... # check for module report(s) from cpan-testers' ), +loc(' z MODULE | NUMBER ... # extract module(s) and open command prompt in it' ), +loc('[Local Administration]' ), +loc(' b # write a bundle file for your configuration' ), +loc(' s program [OPT VALUE] # set program locations for this session' ), +loc(' s conf [OPT VALUE] # set config options for this session' ), +loc(' s mirrors # show currently selected mirrors' ), +loc(' s reconfigure # reconfigure settings ' ), +loc(' s selfupdate # update your CPANPLUS install '), +loc(' s save [user|system] # save settings for this user or systemwide' ), +loc(' s edit [user|system] # open configuration file in editor and reload' ), +loc(' ! EXPR # evaluate a perl statement' ), +loc(' p [FILE] # print the error stack (optionally to a file)' ), +loc(' x # reload CPAN indices (purges cache)' ), +loc(' x --update_source # reload CPAN indices, get fresh source files' ), +loc('[Common Options]' ), +loc(' i ... --skiptest # skip tests' ), +loc(' i ... --force # force all operations' ), +loc(' i ... --verbose # run in verbose mode' ), +loc('[Plugins]' ), +loc(' /plugins # list available plugins' ), +loc(' /? [PLUGIN NAME] # show usage for (a particular) plugin(s)' ), + + ) unless @help; + + $self->_pager_open if (@help >= $self->_term_rowcount); + ### XXX: functional placeholder for actual 'detailed' help. + $self->__print( "Detailed help for the command '$input' is " . + "not available.\n\n" ) if length $input; + $self->__print( map {"$_\n"} @help ); + $self->__print( $/ ); + $self->_pager_close; + + return 1; + } +} + +### eval some code ### +sub _bang { + my $self = shift; + my $cb = $self->backend; + my %hash = @_; + + + my $input; + { local $Params::Check::ALLOW_UNKNOWN = 1; + + my $tmpl = { + input => { required => 1, store => \$input } + }; + + my $args = check( $tmpl, \%hash ) or return; + } + + local $Data::Dumper::Indent = 1; # for dumpering from ! + eval $input; + error( $@ ) if $@; + $self->__print( "\n" ); + + return if $@; + return 1; +} + +sub _search_module { + my $self = shift; + my $cb = $self->backend; + my %hash = @_; + + my $args; + { local $Params::Check::ALLOW_UNKNOWN = 1; + + my $tmpl = { + input => { required => 1, }, + options => { default => { } }, + }; + + $args = check( $tmpl, \%hash ) or return; + } + + my @regexes = map { qr/$_/i } split /\s+/, $args->{'input'}; + + ### XXX this is rather slow, because (probably) + ### of the many method calls + ### XXX need to profile to speed it up =/ + + ### find the modules ### + my @rv = sort { $a->module cmp $b->module } + $cb->search( + %{$args->{'options'}}, + type => 'module', + allow => \@regexes, + ); + + ### store the result in the cache ### + $self->cache([undef,@rv]); + + $self->__display_results; + + return 1; +} + +sub _search_author { + my $self = shift; + my $cb = $self->backend; + my %hash = @_; + + my $args; + { local $Params::Check::ALLOW_UNKNOWN = 1; + + my $tmpl = { + input => { required => 1, }, + options => { default => { } }, + }; + + $args = check( $tmpl, \%hash ) or return; + } + + my @regexes = map { qr/$_/i } split /\s+/, $args->{'input'}; + + my @rv; + for my $type (qw[author cpanid]) { + push @rv, $cb->search( + %{$args->{'options'}}, + type => $type, + allow => \@regexes, + ); + } + + my %seen; + my @list = sort { $a->module cmp $b->module } + grep { defined } + map { $_->modules } + grep { not $seen{$_}++ } @rv; + + $self->cache([undef,@list]); + + $self->__display_results; + return 1; +} + +sub _readme { + my $self = shift; + my $cb = $self->backend; + my %hash = @_; + + my $args; my $mods; my $opts; + { local $Params::Check::ALLOW_UNKNOWN = 1; + + my $tmpl = { + modules => { required => 1, store => \$mods }, + options => { default => { }, store => \$opts }, + }; + + $args = check( $tmpl, \%hash ) or return; + } + + return unless scalar @$mods; + + $self->_pager_open; + for my $mod ( @$mods ) { + $self->__print( $mod->readme( %$opts ) ); + } + + $self->_pager_close; + + return 1; +} + +sub _fetch { + my $self = shift; + my $cb = $self->backend; + my %hash = @_; + + my $args; my $mods; my $opts; + { local $Params::Check::ALLOW_UNKNOWN = 1; + + my $tmpl = { + modules => { required => 1, store => \$mods }, + options => { default => { }, store => \$opts }, + }; + + $args = check( $tmpl, \%hash ) or return; + } + + $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'", + $mod->module, $where ) + : loc("Failed to fetch '%1'", $mod->module) + ); + $self->__print( "\n" ); + } + $self->_pager_close; + + return 1 if $rv; + return; +} + +sub _shell { + my $self = shift; + my $cb = $self->backend; + my $conf = $cb->configure_object; + my %hash = @_; + + my $shell = $conf->get_program('shell'); + unless( $shell ) { + $self->__print( + loc("Your config does not specify a subshell!"), "\n", + loc("Perhaps you need to re-run your setup?"), "\n" + ); + return; + } + + my $args; my $mods; my $opts; + { local $Params::Check::ALLOW_UNKNOWN = 1; + + my $tmpl = { + modules => { required => 1, store => \$mods }, + options => { default => { }, store => \$opts }, + }; + + $args = check( $tmpl, \%hash ) or return; + } + + my $cwd = Cwd::cwd(); + for my $mod (@$mods) { + $mod->fetch( %$opts ) or next; + $mod->extract( %$opts ) or next; + + $cb->_chdir( dir => $mod->status->extract() ) or next; + + #local $ENV{PERL5OPT} = CPANPLUS::inc->original_perl5opt; + + if( system($shell) and $! ) { + $self->__print( + loc("Error executing your subshell '%1': %2", + $shell, $!),"\n" + ); + next; + } + } + $cb->_chdir( dir => $cwd ); + + return 1; +} + +sub _distributions { + my $self = shift; + my $cb = $self->backend; + my $conf = $cb->configure_object; + my %hash = @_; + + my $args; my $mods; my $opts; + { local $Params::Check::ALLOW_UNKNOWN = 1; + + my $tmpl = { + modules => { required => 1, store => \$mods }, + options => { default => { }, store => \$opts }, + }; + + $args = check( $tmpl, \%hash ) or return; + } + + my @list; + for my $mod (@$mods) { + push @list, sort { $a->version <=> $b->version } + grep { defined } $mod->distributions( %$opts ); + } + + my @rv = sort { $a->module cmp $b->module } @list; + + $self->cache([undef,@rv]); + $self->__display_results; + + return 1; +} + +sub _reload_indices { + my $self = shift; + my $cb = $self->backend; + my %hash = @_; + + my $args; my $opts; + { local $Params::Check::ALLOW_UNKNOWN = 1; + + my $tmpl = { + options => { default => { }, store => \$opts }, + }; + + $args = check( $tmpl, \%hash ) or return; + } + + my $rv = $cb->reload_indices( %$opts ); + + ### so the update failed, but you didnt give it any options either + if( !$rv and !(keys %$opts) ) { + $self->__print( + "\nFailure may be due to corrupt source files\n" . + "Try this:\n\tx --update_source\n\n" ); + } + + return $rv; + +} + +sub _install { + my $self = shift; + my $cb = $self->backend; + my $conf = $cb->configure_object; + my %hash = @_; + + my $args; my $mods; my $opts; my $choice; + { local $Params::Check::ALLOW_UNKNOWN = 1; + + my $tmpl = { + modules => { required => 1, store => \$mods }, + options => { default => { }, store => \$opts }, + choice => { required => 1, store => \$choice, + allow => [qw|i t|] }, + }; + + $args = check( $tmpl, \%hash ) or return; + } + + unless( scalar @$mods ) { + $self->__print( loc("Nothing done\n") ); + return; + } + + my $target = $choice eq 'i' ? TARGET_INSTALL : TARGET_CREATE; + my $prompt = $choice eq 'i' ? loc('Installing ') : loc('Testing '); + my $action = $choice eq 'i' ? 'install' : 'test'; + + my $status = {}; + ### first loop over the mods to install them ### + for my $mod (@$mods) { + $self->__print( $prompt, $mod->module, " (".$mod->version.")", "\n" ); + + my $log_length = length CPANPLUS::Error->stack_as_string; + + ### store the status for look up when we're done with all + ### install calls + $status->{$mod} = $mod->install( %$opts, target => $target ); + + ### would you like a log file of what happened? + if( $conf->get_conf('write_install_logs') ) { + + if ( ON_WIN32 and !check_install( + module => 'IPC::Run', version => 0.55 ) + ) { + error(loc("IPC::Run version '%1' is required on MSWin32" + . " in order to capture buffers." + . " The logfile generated may not contain" + . " any useful data, until it is installed", 0.55)); + } + + my $dir = File::Spec->catdir( + $conf->get_conf('base'), + $conf->_get_build('install_log_dir'), + ); + ### create the dir if it doesn't exit yet + $cb->_mkdir( dir => $dir ) unless -d $dir; + + my $file = File::Spec->catfile( + $dir, + INSTALL_LOG_FILE->( $mod ) + ); + if ( open my $fh, ">$file" ) { + my $stack = CPANPLUS::Error->stack_as_string; + ### remove everything in the log that was there *before* + ### we started this install + substr( $stack, 0, $log_length, '' ); + + print $fh $stack; + close $fh; + + $self->__print( + loc("*** Install log written to:\n %1\n\n", $file) + ); + } else { + warn "Could not open '$file': $!\n"; + next; + } + } + } + + my $flag; + ### then report whether all this went ok or not ### + for my $mod (@$mods) { + # if( $mod->status->installed ) { + if( $status->{$mod} ) { + $self->__print( + loc("Module '%1' %tense(%2,past) successfully\n", + $mod->module, $action) + ); + } else { + $flag++; + $self->__print( + loc("Error %tense(%1,present) '%2'\n", $action, $mod->module) + ); + } + } + + + + if( !$flag ) { + $self->__print( + loc("No errors %tense(%1,present) all modules", $action), "\n" + ); + } else { + $self->__print( + loc("Problem %tense(%1,present) one or more modules", $action) + ); + $self->__print( "\n" ); + + $self->__print( + loc("*** You can view the complete error buffer by pressing ". + "'%1' ***\n", 'p') + ) unless $conf->get_conf('verbose') || $self->noninteractive; + } + $self->__print( "\n" ); + + return !$flag; +} + +sub __ask_about_install { + my $mod = shift or return; + my $prereq = shift or return; + my $term = $Shell->term; + + $Shell->__print( "\n" ); + $Shell->__print( loc("Module '%1' requires '%2' to be installed", + $mod->module, $prereq->module ) ); + $Shell->__print( "\n\n" ); + + ### previously cached answer? + return $Shell->settings->{'install_all_prereqs'} + if defined $Shell->settings->{'install_all_prereqs'}; + + + $Shell->__print( + loc( "If you don't wish to see this question anymore\n". + "you can disable it by entering the following ". + "commands on the prompt:\n '%1'", + 's conf prereqs 1; s save' ) ); + $Shell->__print("\n\n"); + + my $yes = loc("Yes"); + my $no = loc("No"); + my $all = loc("Yes to all (for this module)"); + my $none = loc("No to all (for this module)"); + + my $reply = $term->get_reply( + prompt => loc("Should I install this module?"), + choices => [ $yes, $no, $all, $none ], + default => $yes, + ); + + ### if 'all' or 'none', save this, so we can apply it to + ### other prereqs in this chain. + $Shell->settings->{'install_all_prereqs'} = + $reply eq $all ? 1 : + $reply eq $none ? 0 : + undef; + + ### if 'yes' or 'all', the user wants it installed + return $reply eq $all ? 1 : + $reply eq $yes ? 1 : + 0; +} + +sub __ask_about_send_test_report { + my($mod, $grade) = @_; + return 1 unless $grade eq GRADE_FAIL; + + my $term = $Shell->term; + + $Shell->__print( "\n" ); + $Shell->__print( + loc("Test report prepared for module '%1'.\n Would you like to ". + "send it? (You can edit it if you like)", $mod->module ) ); + $Shell->__print( "\n\n" ); + my $bool = $term->ask_yn( + prompt => loc("Would you like to send the test report?"), + default => 'n' + ); + + return $bool; +} + +sub __ask_about_edit_test_report { + my($mod, $grade) = @_; + return 0 unless $grade eq GRADE_FAIL; + + my $term = $Shell->term; + + $Shell->__print( "\n" ); + $Shell->__print( + loc("Test report prepared for module '%1'. You can edit this ". + "report if you would like", $mod->module ) ); + $Shell->__print("\n\n"); + my $bool = $term->ask_yn( + prompt => loc("Would you like to edit the test report?"), + default => 'y' + ); + + return $bool; +} + +sub __ask_about_test_failure { + my $mod = shift; + my $captured = shift || ''; + my $term = $Shell->term; + + $Shell->__print( "\n" ); + $Shell->__print( + loc( "The tests for '%1' failed. Would you like me to proceed ". + "anyway or should we abort?", $mod->module ) ); + $Shell->__print( "\n\n" ); + + my $bool = $term->ask_yn( + prompt => loc("Proceed anyway?"), + default => 'n', + ); + + return $bool; +} + + +sub _details { + my $self = shift; + my $cb = $self->backend; + my $conf = $cb->configure_object; + my %hash = @_; + + my $args; my $mods; my $opts; + { local $Params::Check::ALLOW_UNKNOWN = 1; + + my $tmpl = { + modules => { required => 1, store => \$mods }, + options => { default => { }, store => \$opts }, + }; + + $args = check( $tmpl, \%hash ) or return; + } + + ### every module has about 10 lines of details + ### maybe more later with Module::CPANTS etc + $self->_pager_open if scalar @$mods * 10 > $self->_term_rowcount; + + + my $format = "%-24s %-45s\n"; + my $cformat = "%-24s %-45s %-10s\n"; + for my $mod (@$mods) { + my $href = $mod->details( %$opts ); + my @list = sort { $a->module cmp $b->module } $mod->contains; + + unless( $href ) { + $self->__print( + loc("No details for %1 - it might be outdated.", + $mod->module), "\n" ); + next; + + } else { + $self->__print( loc( "Details for '%1'\n", $mod->module ) ); + for my $item ( sort keys %$href ) { + $self->__printf( $format, $item, $href->{$item} ); + } + + my $showed; + for my $item ( @list ) { + $self->__printf( + $cformat, ($showed ? '' : 'Contains:'), + $item->module, $item->version + ); + $showed++; + } + $self->__print( "\n" ); + } + } + $self->_pager_close; + $self->__print( "\n" ); + + return 1; +} + +sub _print { + my $self = shift; + my %hash = @_; + + my $args; my $opts; my $file; + { local $Params::Check::ALLOW_UNKNOWN = 1; + + my $tmpl = { + options => { default => { }, store => \$opts }, + input => { default => '', store => \$file }, + }; + + $args = check( $tmpl, \%hash ) or return; + } + + my $old; my $fh; + if( $file ) { + $fh = FileHandle->new( ">$file" ) + or( warn loc("Could not open '%1': '%2'", $file, $!), + return + ); + $old = select $fh; + } + + + $self->_pager_open if !$file; + + $self->__print( CPANPLUS::Error->stack_as_string ); + + $self->_pager_close; + + select $old if $old; + $self->__print( "\n" ); + + return 1; +} + +sub _set_conf { + my $self = shift; + my %hash = @_; + my $cb = $self->backend; + my $conf = $cb->configure_object; + + ### possible options + ### XXX hard coded, not optimal :( + my %types = ( + reconfigure => '', + save => q([user | system | boxed]), + edit => '', + program => q([key => val]), + conf => q([key => val]), + mirrors => '', + selfupdate => '', # XXX add all opts here? + ); + + + my $args; my $opts; my $input; + { local $Params::Check::ALLOW_UNKNOWN = 1; + + my $tmpl = { + options => { default => { }, store => \$opts }, + input => { default => '', store => \$input }, + }; + + $args = check( $tmpl, \%hash ) or return; + } + + my ($type,$key,$value) = $input =~ m/(\w+)\s*(\w*)\s*(.*?)$/; + $value =~ s/\s+$//g if $value; + $type = lc $type; + + if( $type eq 'reconfigure' ) { + my $setup = CPANPLUS::Configure::Setup->new( + configure_object => $conf, + term => $self->term, + backend => $cb, + ); + return $setup->init; + + } elsif ( $type eq 'save' ) { + my $where = { + user => CONFIG_USER, + system => CONFIG_SYSTEM, + boxed => CONFIG_BOXED, + }->{ $key } || CONFIG_USER; + + ### boxed is special, so let's get its value from %INC + ### so we can tell it where to save + ### XXX perhaps this logic should be generic for all + ### types, and put in the ->save() routine + my $dir; + if( $where eq CONFIG_BOXED ) { + my $file = join( '/', split( '::', CONFIG_BOXED ) ) . '.pm'; + my $file_re = quotemeta($file); + + my $path = $INC{$file} || ''; + $path =~ s/$file_re$//; + $dir = $path; + } + + my $rv = $cb->configure_object->save( $where => $dir ); + + $self->__print( + $rv + ? loc("Configuration successfully saved to %1\n (%2)\n", + $where, $rv) + : loc("Failed to save configuration\n" ) + ); + return $rv; + + } elsif ( $type eq 'edit' ) { + + my $editor = $conf->get_program('editor') + or( print(loc("No editor specified")), return ); + + my $where = { + user => CONFIG_USER, + system => CONFIG_SYSTEM, + }->{ $key } || CONFIG_USER; + + my $file = $conf->_config_pm_to_file( $where ); + system($editor,$file); + + ### now reload it + ### disable warnings for this + { require Module::Loaded; + Module::Loaded::mark_as_unloaded( $where ); + + ### reinitialize the config + local $^W; + $conf->init; + } + + return 1; + + } elsif ( $type eq 'mirrors' ) { + + $self->__print( + loc("Readonly list of mirrors (in order of preference):\n\n" ) ); + + my $i; + for my $host ( @{$conf->get_conf('hosts')} ) { + my $uri = $cb->_host_to_uri( %$host ); + + $i++; + $self->__print( "\t[$i] $uri\n" ); + } + + $self->__print( + loc("\nTo edit this list, please type: '%1'\n", 's edit') ); + + } elsif ( $type eq 'selfupdate' ) { + my %valid = map { $_ => $_ } + $cb->selfupdate_object->list_categories; + + unless( $valid{$key} ) { + $self->__print( + loc( "To update your current CPANPLUS installation, ". + "choose one of the these options:\n%1", + ( join $/, map { + sprintf "\ts selfupdate %-17s " . + "[--latest=0] [--dryrun]", $_ + } sort keys %valid ) + ) + ); + } else { + my %update_args = ( + update => $key, + latest => 1, + %$opts + ); + + + my %list = $cb->selfupdate_object + ->list_modules_to_update( %update_args ); + + $self->__print(loc("The following updates will take place:"),$/.$/); + + for my $feature ( sort keys %list ) { + my $aref = $list{$feature}; + + ### is it a 'feature' or a built in? + $self->__print( + $valid{$feature} + ? " " . ucfirst($feature) . ":\n" + : " Modules for '$feature' support:\n" + ); + + ### show what modules would be installed + $self->__print( + scalar @$aref + ? map { sprintf " %-42s %-6s -> %-6s \n", + $_->name, $_->installed_version, $_->version + } @$aref + : " No upgrades required\n" + ); + $self->__print( $/ ); + } + + + unless( $opts->{'dryrun'} ) { + $self->__print( loc("Updating your CPANPLUS installation\n") ); + $cb->selfupdate_object->selfupdate( %update_args ); + } + } + + } else { + + if ( $type eq 'program' or $type eq 'conf' ) { + + my $format = { + conf => '%-25s %s', + program => '%-12s %s', + }->{ $type }; + + unless( $key ) { + my @list = grep { $_ ne 'hosts' } + $conf->options( type => $type ); + + my $method = 'get_' . $type; + + local $Data::Dumper::Indent = 0; + for my $name ( @list ) { + my $val = $conf->$method($name) || ''; + ($val) = ref($val) + ? (Data::Dumper::Dumper($val) =~ /= (.*);$/) + : "'$val'"; + + $self->__printf( " $format\n", $name, $val ); + } + + } elsif ( $key eq 'hosts' or $key eq 'lib' ) { + $self->__print( + loc( "Setting %1 is not trivial.\n" . + "It is suggested you use '%2' and edit the " . + "configuration file manually", $key, 's edit') + ); + } else { + my $method = 'set_' . $type; + $conf->$method( $key => defined $value ? $value : '' ) + and $self->__print( loc("Key '%1' was set to '%2'", $key, + defined $value ? $value : 'EMPTY STRING') ); + } + + } else { + $self->__print( loc("Unknown type '%1'",$type || 'EMPTY' ) ); + $self->__print( $/ ); + $self->__print( loc("Try one of the following:") ); + $self->__print( $/, join $/, + map { sprintf "\t%-11s %s", $_, $types{$_} } + sort keys %types ); + } + } + $self->__print( "\n" ); + return 1; +} + +sub _uptodate { + my $self = shift; + my %hash = @_; + my $cb = $self->backend; + my $conf = $cb->configure_object; + + my $opts; my $mods; + { local $Params::Check::ALLOW_UNKNOWN = 1; + + my $tmpl = { + options => { default => { }, store => \$opts }, + modules => { required => 1, store => \$mods }, + }; + + check( $tmpl, \%hash ) or return; + } + + ### long listing? short is default ### + my $long = $opts->{'long'} ? 1 : 0; + + my @list = scalar @$mods ? @$mods : @{$cb->_all_installed}; + + my @rv; my %seen; + for my $mod (@list) { + ### skip this mod if it's up to date ### + next if $mod->is_uptodate; + ### skip this mod if it's core ### + next if $mod->package_is_perl_core; + + if( $long or !$seen{$mod->package}++ ) { + push @rv, $mod; + } + } + + @rv = sort { $a->module cmp $b->module } @rv; + + $self->cache([undef,@rv]); + + $self->_pager_open if scalar @rv >= $self->_term_rowcount; + + my $format = "%5s %12s %12s %-36s %-10s\n"; + + my $i = 1; + for my $mod ( @rv ) { + $self->__printf( + $format, + $i, + $self->_format_version($mod->installed_version) || 'Unparsable', + $self->_format_version( $mod->version ), + $mod->module, + $mod->author->cpanid + ); + $i++; + } + $self->_pager_close; + + return 1; +} + +sub _autobundle { + my $self = shift; + my %hash = @_; + my $cb = $self->backend; + my $conf = $cb->configure_object; + + my $opts; my $input; + { local $Params::Check::ALLOW_UNKNOWN = 1; + + my $tmpl = { + options => { default => { }, store => \$opts }, + input => { default => '', store => \$input }, + }; + + check( $tmpl, \%hash ) or return; + } + + $opts->{'path'} = $input if $input; + + my $where = $cb->autobundle( %$opts ); + + $self->__print( + $where + ? loc("Wrote autobundle to '%1'", $where) + : loc("Could not create autobundle" ) + ); + $self->__print( "\n" ); + + return $where ? 1 : 0; +} + +sub _uninstall { + my $self = shift; + my %hash = @_; + my $cb = $self->backend; + my $term = $self->term; + my $conf = $cb->configure_object; + + my $opts; my $mods; + { local $Params::Check::ALLOW_UNKNOWN = 1; + + my $tmpl = { + options => { default => { }, store => \$opts }, + modules => { default => [], store => \$mods }, + }; + + check( $tmpl, \%hash ) or return; + } + + my $force = $opts->{'force'} || $conf->get_conf('force'); + + unless( $force ) { + my $list = join "\n", map { ' ' . $_->module } @$mods; + + $self->__print( loc(" +This will uninstall the following modules: +%1 + +Note that if you installed them via a package manager, you probably +should use the same package manager to uninstall them + +", $list) ); + + return unless $term->ask_yn( + prompt => loc("Are you sure you want to continue?"), + default => 'n', + ); + } + + ### first loop over all the modules to uninstall them ### + for my $mod (@$mods) { + $self->__print( loc("Uninstalling '%1'", $mod->module), "\n" ); + + $mod->uninstall( %$opts ); + } + + my $flag; + ### then report whether all this went ok or not ### + for my $mod (@$mods) { + if( $mod->status->uninstall ) { + $self->__print( + loc("Module '%1' %tense(uninstall,past) successfully\n", + $mod->module ) ); + } else { + $flag++; + $self->__print( + loc("Error %tense(uninstall,present) '%1'\n", $mod->module) ); + } + } + + if( !$flag ) { + $self->__print( + loc("All modules %tense(uninstall,past) successfully"), "\n" ); + } else { + $self->__print( + loc("Problem %tense(uninstall,present) one or more modules" ), + "\n" ); + + $self->__print( + loc("*** You can view the complete error buffer by pressing '%1'". + "***\n", 'p') ) unless $conf->get_conf('verbose'); + } + $self->__print( "\n" ); + + return !$flag; +} + +sub _reports { + my $self = shift; + my %hash = @_; + my $cb = $self->backend; + my $term = $self->term; + my $conf = $cb->configure_object; + + my $opts; my $mods; + { local $Params::Check::ALLOW_UNKNOWN = 1; + + my $tmpl = { + options => { default => { }, store => \$opts }, + modules => { default => '', store => \$mods }, + }; + + check( $tmpl, \%hash ) or return; + } + + ### XXX might need to be conditional ### + $self->_pager_open; + + for my $mod (@$mods) { + my @list = $mod->fetch_report( %$opts ) + or( print(loc("No reports available for this distribution.")), + next + ); + + @list = reverse + map { $_->[0] } + sort { $a->[1] cmp $b->[1] } + map { [$_, $_->{'dist'}.':'.$_->{'platform'}] } @list; + + + + ### XXX this may need to be sorted better somehow ### + my $url; + my $format = "%8s %s %s\n"; + + my %seen; + for my $href (@list ) { + $self->__print( + "[" . $mod->author->cpanid .'/'. $href->{'dist'} . "]\n" + ) unless $seen{ $href->{'dist'} }++; + + $self->__printf( + $format, + $href->{'grade'}, + $href->{'platform'}, + ($href->{'details'} ? '(*)' : '') + ); + + $url ||= $href->{'details'}; + } + + $self->__print( "\n==> $url\n" ) if $url; + $self->__print( "\n" ); + } + $self->_pager_close; + + return 1; +} + +### Load plugins +{ my @PluginModules; + my %Dispatch = ( + showtip => [ __PACKAGE__, '_show_random_tip'], + plugins => [ __PACKAGE__, '_list_plugins' ], + '?' => [ __PACKAGE__, '_plugins_usage' ], + ); + + sub plugin_modules { return @PluginModules } + sub plugin_table { return %Dispatch } + + my $init_done; + sub _plugins_init { + + ### only initialize once + return if $init_done++; + + ### find all plugins first + if( check_install( module => 'Module::Pluggable', version => '2.4') ) { + require Module::Pluggable; + + my $only_re = __PACKAGE__ . '::Plugins::\w+$'; + + Module::Pluggable->import( + sub_name => '_plugins', + search_path => __PACKAGE__, + only => qr/$only_re/, + #except => [ INSTALLER_MM, INSTALLER_SAMPLE ] + ); + + push @PluginModules, __PACKAGE__->_plugins; + } + + ### now try to load them + for my $p ( __PACKAGE__->plugin_modules ) { + my %map = eval { load $p; $p->import; $p->plugins }; + error(loc("Could not load plugin '$p': $@")), next if $@; + + ### register each plugin + while( my($name, $func) = each %map ) { + + if( not length $name or not length $func ) { + error(loc("Empty plugin name or dispatch function detected")); + next; + } + + if( exists( $Dispatch{$name} ) ) { + error(loc("'%1' is already registered by '%2'", + $name, $Dispatch{$name}->[0])); + next; + } + + ### register name, package and function + $Dispatch{$name} = [ $p, $func ]; + } + } + } + + ### dispatch a plugin command to its function + sub _meta { + my $self = shift; + my %hash = @_; + my $cb = $self->backend; + my $term = $self->term; + my $conf = $cb->configure_object; + + my $opts; my $input; + { local $Params::Check::ALLOW_UNKNOWN = 1; + + my $tmpl = { + options => { default => { }, store => \$opts }, + input => { default => '', store => \$input }, + }; + + check( $tmpl, \%hash ) or return; + } + + $input =~ s/\s*(\S+)\s*//; + my $cmd = $1; + + ### look up the command, or go to the default + my $aref = $Dispatch{ $cmd } || [ __PACKAGE__, '_plugin_default' ]; + + my($pkg,$func) = @$aref; + + my $rv = eval { $pkg->$func( $self, $cb, $cmd, $input, $opts ) }; + + error( $@ ) if $@; + + ### return $rv instead, so input loop can be terminated? + return 1; + } + + sub _plugin_default { error(loc("No such plugin command")) } +} + +### plugin commands +{ my $help_format = " /%-21s # %s\n"; + + sub _list_plugins { + my $self = shift; + + $self->__print( loc("Available plugins:\n") ); + $self->__print( loc(" List usage by using: /? PLUGIN_NAME\n" ) ); + $self->__print( $/ ); + + my %table = __PACKAGE__->plugin_table; + for my $name( sort keys %table ) { + my $pkg = $table{$name}->[0]; + my $this = __PACKAGE__; + + my $who = $pkg eq $this + ? "Standard Plugin" + : do { my $v = $self->_format_version($pkg->VERSION) || ''; + $pkg =~ s/^$this/../; + sprintf "Provided by: %-30s %-10s", $pkg, $v; + }; + + $self->__printf( $help_format, $name, $who ); + } + + $self->__print( $/.$/ ); + + $self->__print( + " Write your own plugins? Read the documentation of:\n" . + " CPANPLUS::Shell::Default::Plugins::HOWTO\n" ); + + $self->__print( $/ ); + } + + sub _list_plugins_help { + return sprintf $help_format, 'plugins', loc("lists available plugins"); + } + + ### registered as a plugin too + sub _show_random_tip_help { + return sprintf $help_format, 'showtip', loc("show usage tips" ); + } + + sub _plugins_usage { + my $self = shift; + my $shell = shift; + my $cb = shift; + my $cmd = shift; + my $input = shift; + my %table = $self->plugin_table; + + my @list = length $input ? split /\s+/, $input : sort keys %table; + + for my $name( @list ) { + + ### no such plugin? skip + error(loc("No such plugin '$name'")), next unless $table{$name}; + + my $pkg = $table{$name}->[0]; + my $func = $table{$name}->[1] . '_help'; + + if ( my $sub = $pkg->can( $func ) ) { + eval { $self->__print( $sub->() ) }; + error( $@ ) if $@; + + } else { + $self->__print(" No usage for '$name' -- try perldoc $pkg"); + } + + $self->__print( $/ ); + } + + $self->__print( $/.$/ ); + } + + sub _plugins_usage_help { + return sprintf $help_format, '? [NAME ...]', + loc("show usage for plugins"); + } +} + +### send a command to a remote host, retrieve the answer; +sub __send_remote_command { + my $self = shift; + my $cmd = shift; + my $remote = $self->remote or return; + my $user = $remote->{'username'}; + my $pass = $remote->{'password'}; + my $conn = $remote->{'connection'}; + my $end = "\015\012"; + my $answer; + + my $send = join "\0", $user, $pass, $cmd; + + print $conn $send . $end; + + ### XXX why doesn't something like this just work? + #1 while recv($conn, $answer, 1024, 0); + while(1) { + my $buff; + $conn->recv( $buff, 1024, 0 ); + $answer .= $buff; + last if $buff =~ /$end$/; + } + + my($status,$buffer) = split "\0", $answer; + + return ($status, $buffer); +} + + +sub _read_configuration_from_rc { + my $self = shift; + my $rc_file = shift; + + my $href; + if( can_load( modules => { 'Config::Auto' => '0.0' } ) ) { + $Config::Auto::DisablePerl = 1; + + eval { $href = Config::Auto::parse( $rc_file, format => 'space' ) }; + + $self->__print( + loc( "Unable to read in config file '%1': %2", $rc_file, $@ ) + ) if $@; + } + + return $href || {}; +} + +{ my @tips = ( + loc( "You can update CPANPLUS by running: '%1'", 's selfupdate' ), + loc( "You can install modules by URL using '%1'", 'i URL' ), + loc( "You can turn off these tips using '%1'", + 's conf show_startup_tip 0' ), + loc( "You can use wildcards like '%1' and '%2' on search results", + '*', '2..5' ) , + loc( "You can use plugins. Type '%1' to list available plugins", + '/plugins' ), + loc( "You can show all your out of date modules using '%1'", 'o' ), + loc( "Many operations take options, like '%1', '%2' or '%3'", + '--verbose', '--force', '--skiptest' ), + loc( "The documentation in %1 and %2 is very useful", + "CPANPLUS::Module", "CPANPLUS::Backend" ), + loc( "You can type '%1' for help and '%2' to exit", 'h', 'q' ), + loc( "You can run an interactive setup using '%1'", 's reconfigure' ), + loc( "You can add custom sources to your index. See '%1' for details", + '/cs --help' ), + loc( "CPANPLUS now has an experimental SQLite backend. You can enable ". + "it via: '%1'. Update dependencies via '%2'", + 's conf source_engine CPANPLUS::Internals::Source::SQLite; s save', + 's selfupdate enabled_features ' ), + ); + + sub _show_random_tip { + my $self = shift; + $self->__print( $/, "Did you know...\n ", + $tips[ int rand scalar @tips ], $/ ); + return 1; + } +} + +1; + +__END__ + +=pod + +=head1 BUG REPORTS + +Please report bugs or other issues to E<lt>bug-cpanplus@rt.cpan.org<gt>. + +=head1 AUTHOR + +This module by Jos Boumans E<lt>kane@cpan.orgE<gt>. + +=head1 COPYRIGHT + +The CPAN++ interface (of which this module is a part of) is copyright (c) +2001 - 2007, Jos Boumans E<lt>kane@cpan.orgE<gt>. All rights reserved. + +This library is free software; you may redistribute and/or modify it +under the same terms as Perl itself. + +=head1 SEE ALSO + +L<CPANPLUS::Shell::Classic>, L<CPANPLUS::Shell>, L<cpanp> + +=cut + +# Local variables: +# c-indentation-style: bsd +# c-basic-offset: 4 +# indent-tabs-mode: nil +# End: +# vim: expandtab shiftwidth=4: + +__END__ + +TODO: + e => "_expand_inc", # scratch it, imho -- not used enough + +### free letters: g j k n y ### |