Current File : //proc/thread-self/root/usr/share/perl5/vendor_perl/CPANPLUS/Shell.pm
package CPANPLUS::Shell;
use strict;
use CPANPLUS::Error;
use CPANPLUS::Configure;
use CPANPLUS::Internals::Constants;
use Module::Load qw[load];
use Params::Check qw[check];
use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';
$Params::Check::VERBOSE = 1;
use vars qw[@ISA $SHELL $DEFAULT $VERSION];
$VERSION = "0.9138";
$DEFAULT = SHELL_DEFAULT;
=pod
=head1 NAME
CPANPLUS::Shell - base class for CPANPLUS shells
=head1 SYNOPSIS
use CPANPLUS::Shell; # load the shell indicated by your
# config -- defaults to
# CPANPLUS::Shell::Default
use CPANPLUS::Shell qw[Classic] # load CPANPLUS::Shell::Classic;
my $ui = CPANPLUS::Shell->new();
my $name = $ui->which; # Find out what shell you loaded
$ui->shell; # run the ui shell
=head1 DESCRIPTION
This module is the generic loading (and base class) for all C<CPANPLUS>
shells. Through this module you can load any installed C<CPANPLUS>
shell.
Just about all the functionality is provided by the shell that you have
loaded, and not by this class (which merely functions as a generic
loading class), so please consult the documentation of your shell of
choice.
=cut
sub import {
my $class = shift;
my $option = shift;
### find out what shell we're supposed to load ###
$SHELL = $option
? $class . '::' . $option
: do { ### XXX this should offer to reconfigure
### CPANPLUS, somehow. --rs
### XXX load Configure only if we really have to
### as that means any $Conf passed later on will
### be ignored in favour of the one that was
### retrieved via ->new --kane
my $conf = CPANPLUS::Configure->new() or
die loc("No configuration available -- aborting") . $/;
$conf->get_conf('shell') || $DEFAULT;
};
### load the shell, fall back to the default if required
### and die if even that doesn't work
EVAL: {
eval { load $SHELL };
if( $@ ) {
my $err = $@;
die loc("Your default shell '%1' is not available: %2",
$DEFAULT, $err) .
loc("Check your installation!") . "\n"
if $SHELL eq $DEFAULT;
warn loc("Failed to use '%1': %2", $SHELL, $err),
loc("Switching back to the default shell '%1'", $DEFAULT),
"\n";
$SHELL = $DEFAULT;
redo EVAL;
}
}
@ISA = ($SHELL);
}
sub which { return $SHELL }
1;
###########################################################################
### abstracted out subroutines available to programmers of other shells ###
###########################################################################
package CPANPLUS::Shell::_Base::ReadLine;
use strict;
use vars qw($AUTOLOAD $TMPL);
use FileHandle;
use CPANPLUS::Error;
use Params::Check qw[check];
use Module::Load::Conditional qw[can_load];
use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';
$Params::Check::VERBOSE = 1;
$TMPL = {
brand => { default => '', strict_type => 1 },
prompt => { default => '> ', strict_type => 1 },
pager => { default => '' },
backend => { default => '' },
term => { default => '' },
format => { default => '' },
dist_format => { default => '' },
remote => { default => undef },
noninteractive => { default => '' },
cache => { default => [ ] },
settings => { default => { install_all_prereqs => undef },
no_override => 1 },
_old_sigpipe => { default => '', no_override => 1 },
_old_outfh => { default => '', no_override => 1 },
_signals => { default => { INT => { } }, no_override => 1 },
};
### autogenerate accessors ###
for my $key ( keys %$TMPL ) {
no strict 'refs';
*{__PACKAGE__."::$key"} = sub {
my $self = shift;
$self->{$key} = $_[0] if @_;
return $self->{$key};
}
}
sub _init {
my $class = shift;
my %hash = @_;
my $self = check( $TMPL, \%hash ) or return;
bless $self, $class;
### signal handler ###
$SIG{INT} = $self->_signals->{INT}->{handler} =
sub {
unless ( $self->_signals->{INT}->{count}++ ) {
warn loc("Caught SIGINT"), "\n";
} else {
warn loc("Got another SIGINT"), "\n"; die;
}
};
### end sig handler ###
return $self;
}
### display shell's banner, takes the Backend object as argument
sub _show_banner {
my $self = shift;
my $cpan = $self->backend;
my $term = $self->term;
### Tries to probe for our ReadLine support status
# a) under an interactive shell?
my $rl_avail = (!$term->isa('CPANPLUS::Shell::_Faked'))
# b) do we have a tty terminal?
? (-t STDIN)
# c) should we enable the term?
? (!$self->__is_bad_terminal($term))
# d) external modules available?
? ($term->ReadLine ne "Term::ReadLine::Stub")
# a+b+c+d => "Smart" terminal
? loc("enabled")
# a+b+c => "Stub" terminal
: loc("available (try 'i Term::ReadLine::Perl')")
# a+b => "Bad" terminal
: loc("disabled")
# a => "Dumb" terminal
: loc("suppressed")
# none => "Faked" terminal
: loc("suppressed in batch mode");
$rl_avail = loc("ReadLine support %1.", $rl_avail);
$rl_avail = "\n*** $rl_avail" if (length($rl_avail) > 45);
$self->__print(
loc("%1 -- CPAN exploration and module installation (v%2)",
$self->which, $self->which->VERSION()), "\n",
loc("*** Please report bugs to <bug-cpanplus\@rt.cpan.org>."), "\n",
loc("*** Using CPANPLUS::Backend v%1. %2",
$cpan->VERSION, $rl_avail), "\n\n"
);
}
### checks whether the Term::ReadLine is broken and needs to fallback to Stub
sub __is_bad_terminal {
my $self = shift;
my $term = $self->term;
return unless $^O eq 'MSWin32';
### replace the term with the default (stub) one
return $self->term(Term::ReadLine::Stub->new( $self->brand ) );
}
### open a pager handle
sub _pager_open {
my $self = shift;
my $cpan = $self->backend;
my $cmd = $cpan->configure_object->get_program('pager') or return;
$self->_old_sigpipe( $SIG{PIPE} );
$SIG{PIPE} = 'IGNORE';
my $fh = new FileHandle;
unless ( $fh->open("| $cmd") ) {
error(loc("could not pipe to %1: %2\n", $cmd, $!) );
return;
}
$fh->autoflush(1);
$self->pager( $fh );
$self->_old_outfh( select $fh );
return $fh;
}
### print to the current pager handle, or STDOUT if it's not opened
sub _pager_close {
my $self = shift;
my $pager = $self->pager or return;
$pager->close if (ref($pager) and $pager->can('close'));
$self->pager( undef );
select $self->_old_outfh;
$SIG{PIPE} = $self->_old_sigpipe;
return 1;
}
{
my $win32_console;
### determines row count of current terminal; defaults to 25.
### used by the pager functions
sub _term_rowcount {
my $self = shift;
my $cpan = $self->backend;
my %hash = @_;
my $default;
my $tmpl = {
default => { default => 25, allow => qr/^\d$/,
store => \$default }
};
check( $tmpl, \%hash ) or return;
if ( $^O eq 'MSWin32' ) {
if ( can_load( modules => { 'Win32::Console' => '0.0' } ) ) {
$win32_console ||= Win32::Console->new();
my $rows = ($win32_console->Info)[-1];
return $rows;
}
} else {
local $Module::Load::Conditional::VERBOSE = 0;
if ( can_load(modules => {'Term::Size' => '0.0'}) ) {
my ($cols, $rows) = Term::Size::chars();
return $rows;
}
}
return $default;
}
}
### Custom print routines, mainly to be able to catch output
### in test cases, or redirect it if need be
{ sub __print {
my $self = shift;
print @_;
}
sub __printf {
my $self = shift;
my $fmt = shift;
### MUST specify $fmt as a separate param, and not as part
### of @_, as it will then miss the $fmt and return the
### number of elements in the list... =/ --kane
$self->__print( sprintf( $fmt, @_ ) );
}
}
1;
=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::Default>, L<CPANPLUS::Shell::Classic>, L<cpanp>
=cut
# Local variables:
# c-indentation-style: bsd
# c-basic-offset: 4
# indent-tabs-mode: nil
# End:
# vim: expandtab shiftwidth=4:
Mini Shell