default.pm

source of perl for linux application,

                );

            } 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" );
    }
}


sub _quit {
    my $self = shift;

    $self->dispatch_on_input( input => $rc->{'logout'} )
            if defined $rc->{'logout'};

    $self->__print( loc("Exiting CPANPLUS shell"), "\n" );
}

###########################
### 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('    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;
    }
}

### 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;
}

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;
    for my $mod (@$mods) {
        my $where = $mod->fetch( %$opts );

        $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;

}

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') ) {

            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)
            );
        }
    }