view release on metacpan or  search on metacpan

lib/CPANPLUS/Shell/Default.pm  view on Meta::CPAN

                             # 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> e                 # exit the shell and reload

    cpanp> /plugins          # list available 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;

    if (my $histfile = $cb->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;
}

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