perl-5.16.2/cpan/CPANPLUS/lib/CPANPLUS/Shell.pm - toolchain/perl - Git at Google

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

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

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