lib/CPANPLUS/Shell.pm

   1 package CPANPLUS::Shell;
   2
   3 use strict;
   4
   5 use CPANPLUS::Error;
   6 use CPANPLUS::Configure;
   7 use CPANPLUS::Internals::Constants;
   8
   9 use Module::Load                qw[load];
  10 use Params::Check               qw[check];
  11 use Locale::Maketext::Simple    Class => 'CPANPLUS', Style => 'gettext';
  12
  13 $Params::Check::VERBOSE = 1;
  14
  15 use vars qw[@ISA $SHELL $DEFAULT];
  16
  17 $DEFAULT    = SHELL_DEFAULT;
  18
  19 =pod
  20
  21 =head1 NAME
  22
  23 CPANPLUS::Shell
  24
  25 =head1 SYNOPSIS
  26
  27     use CPANPLUS::Shell;             # load the shell indicated by your
  28                                      # config -- defaults to
  29                                      # CPANPLUS::Shell::Default
  30
  31     use CPANPLUS::Shell qw[Classic]  # load CPANPLUS::Shell::Classic;
  32
  33     my $ui      = CPANPLUS::Shell->new();
  34     my $name    = $ui->which;        # Find out what shell you loaded
  35
  36     $ui->shell;                      # run the ui shell
  37
  38
  39 =head1 DESCRIPTION
  40
  41 This module is the generic loading (and base class) for all C<CPANPLUS>
  42 shells. Through this module you can load any installed C<CPANPLUS>
  43 shell.
  44
  45 Just about all the functionality is provided by the shell that you have
  46 loaded, and not by this class (which merely functions as a generic
  47 loading class), so please consult the documentation of your shell of
  48 choice.
  49
  50 =cut
  51
  52
  53 sub import {
  54     my $class   = shift;
  55     my $option  = shift;
  56     ### XXX this should offer to reconfigure CPANPLUS, somehow.  --rs
  57     my $conf    = CPANPLUS::Configure->new()
  58                     or die loc("No configuration available -- aborting") . $/;
  59
  60     ### find out what shell we're supposed to load ###
  61     $SHELL      = $option
  62                     ? $class . '::' . $option
  63                     : $conf->get_conf('shell') || $DEFAULT;
  64
  65     ### load the shell, fall back to the default if required
  66     ### and die if even that doesn't work
  67     EVAL: {
  68         eval { load $SHELL };
  69
  70         if( $@ ) {
  71             my $err = $@;
  72
  73             die loc("Your default shell '%1' is not available: %2",
  74                     $DEFAULT, $err) .
  75                 loc("Check your installation!") . "\n"
  76                     if $SHELL eq $DEFAULT;
  77
  78             warn loc("Failed to use '%1': %2", $SHELL, $err),
  79                  loc("Switching back to the default shell '%1'", $DEFAULT),
  80                  "\n";
  81
  82             $SHELL = $DEFAULT;
  83             redo EVAL;
  84         }
  85     }
  86     @ISA = ($SHELL);
  87 }
  88
  89 sub which { return $SHELL }
  90
  91 1;
  92
  93 ###########################################################################
  94 ### abstracted out subroutines available to programmers of other shells ###
  95 ###########################################################################
  96
  97 package CPANPLUS::Shell::_Base::ReadLine;
  98
  99 use strict;
 100 use vars qw($AUTOLOAD $TMPL);
 101
 102 use FileHandle;
 103 use CPANPLUS::Error;
 104 use Params::Check               qw[check];
 105 use Module::Load::Conditional   qw[can_load];
 106 use Locale::Maketext::Simple    Class => 'CPANPLUS', Style => 'gettext';
 107
 108 $Params::Check::VERBOSE = 1;
 109
 110
 111 $TMPL = {
 112     brand           => { default => '', strict_type => 1 },
 113     prompt          => { default => '> ', strict_type => 1 },
 114     pager           => { default => '' },
 115     backend         => { default => '' },
 116     term            => { default => '' },
 117     format          => { default => '' },
 118     dist_format     => { default => '' },
 119     remote          => { default => undef },
 120     noninteractive  => { default => '' },
 121     cache           => { default => [ ] },
 122     _old_sigpipe    => { default => '', no_override => 1 },
 123     _old_outfh      => { default => '', no_override => 1 },
 124     _signals        => { default => { INT => { } }, no_override => 1 },
 125 };
 126
 127 ### autogenerate accessors ###
 128 for my $key ( keys %$TMPL ) {
 129     no strict 'refs';
 130     *{__PACKAGE__."::$key"} = sub {
 131         my $self = shift;
 132         $self->{$key} = $_[0] if @_;
 133         return $self->{$key};
 134     }
 135 }
 136
 137 sub _init {
 138     my $class   = shift;
 139     my %hash    = @_;
 140
 141     my $self    = check( $TMPL, \%hash ) or return;
 142
 143     bless $self, $class;
 144
 145     ### signal handler ###
 146     $SIG{INT} = $self->_signals->{INT}->{handler} =
 147         sub {
 148             unless ( $self->_signals->{INT}->{count}++ ) {
 149                 warn loc("Caught SIGINT"), "\n";
 150             } else {
 151                 warn loc("Got another SIGINT"), "\n"; die;
 152             }
 153         };
 154     ### end sig handler ###
 155
 156     return $self;
 157 }
 158
 159 ### display shell's banner, takes the Backend object as argument
 160 sub _show_banner {
 161     my $self = shift;
 162     my $cpan = $self->backend;
 163     my $term = $self->term;
 164
 165     ### Tries to probe for our ReadLine support status
 166     # a) under an interactive shell?
 167     my $rl_avail = (!$term->isa('CPANPLUS::Shell::_Faked'))
 168         # b) do we have a tty terminal?
 169         ? (-t STDIN)
 170             # c) should we enable the term?
 171             ? (!$self->__is_bad_terminal($term))
 172                 # d) external modules available?
 173                 ? ($term->ReadLine ne "Term::ReadLine::Stub")
 174                     # a+b+c+d => "Smart" terminal
 175                     ? loc("enabled")
 176                     # a+b+c => "Stub" terminal
 177                     : loc("available (try 'i Term::ReadLine::Perl')")
 178                 # a+b => "Bad" terminal
 179                 : loc("disabled")
 180             # a => "Dumb" terminal
 181             : loc("suppressed")
 182         # none    => "Faked" terminal
 183         : loc("suppressed in batch mode");
 184
 185     $rl_avail = loc("ReadLine support %1.", $rl_avail);
 186     $rl_avail = "\n*** $rl_avail" if (length($rl_avail) > 45);
 187
 188     print loc("%1 -- CPAN exploration and module installation (v%2)",
 189                 $self->which, $self->which->VERSION()), "\n",
 190           loc("*** Please report bugs to <bug-cpanplus\@rt.cpan.org>."), "\n",
 191           loc("*** Using CPANPLUS::Backend v%1.  %2",
 192                 $cpan->VERSION, $rl_avail), "\n\n";
 193 }
 194
 195 ### checks whether the Term::ReadLine is broken and needs to fallback to Stub
 196 sub __is_bad_terminal {
 197     my $self = shift;
 198     my $term = $self->term;
 199
 200     return unless $^O eq 'MSWin32';
 201
 202     ### replace the term with the default (stub) one
 203     return $self->term(Term::ReadLine::Stub->new( $self->brand ) );
 204 }
 205
 206 ### open a pager handle
 207 sub _pager_open {
 208     my $self  = shift;
 209     my $cpan  = $self->backend;
 210     my $cmd   = $cpan->configure_object->get_program('pager') or return;
 211
 212     $self->_old_sigpipe( $SIG{PIPE} );
 213     $SIG{PIPE} = 'IGNORE';
 214
 215     my $fh = new FileHandle;
 216     unless ( $fh->open("| $cmd") ) {
 217         error(loc("could not pipe to %1: %2\n", $cmd, $!) );
 218         return;
 219     }
 220
 221     $fh->autoflush(1);
 222
 223     $self->pager( $fh );
 224     $self->_old_outfh( select $fh );
 225
 226     return $fh;
 227 }
 228
 229 ### print to the current pager handle, or STDOUT if it's not opened
 230 sub _pager_close {
 231     my $self  = shift;
 232     my $pager = $self->pager or return;
 233
 234     $pager->close if (ref($pager) and $pager->can('close'));
 235
 236     $self->pager( undef );
 237
 238     select $self->_old_outfh;
 239     $SIG{PIPE} = $self->_old_sigpipe;
 240
 241     return 1;
 242 }
 243
 244
 245
 246 {
 247     my $win32_console;
 248
 249     ### determines row count of current terminal; defaults to 25.
 250     ### used by the pager functions
 251     sub _term_rowcount {
 252         my $self = shift;
 253         my $cpan = $self->backend;
 254         my %hash = @_;
 255
 256         my $default;
 257         my $tmpl = {
 258             default => { default => 25, allow => qr/^\d$/,
 259                          store => \$default }
 260         };
 261
 262         check( $tmpl, \%hash ) or return;
 263
 264         if ( $^O eq 'MSWin32' ) {
 265             if ( can_load( modules => { 'Win32::Console' => '0.0' } ) ) {
 266                 $win32_console ||= Win32::Console->new();
 267                 my $rows = ($win32_console->Info)[-1];
 268                 return $rows;
 269             }
 270
 271         } else {
 272             local $Module::Load::Conditional::VERBOSE = 0;
 273             if ( can_load(modules => {'Term::Size' => '0.0'}) ) {
 274                 my ($cols, $rows) = Term::Size::chars();
 275                 return $rows;
 276             }
 277         }
 278         return $default;
 279     }
 280 }
 281
 282 1;
 283
 284 =pod
 285
 286 =head1 BUG REPORTS
 287
 288 Please report bugs or other issues to E<lt>bug-cpanplus@rt.cpan.org<gt>.
 289
 290 =head1 AUTHOR
 291
 292 This module by Jos Boumans E<lt>kane@cpan.orgE<gt>.
 293
 294 =head1 COPYRIGHT
 295
 296 The CPAN++ interface (of which this module is a part of) is copyright (c)
 297 2001 - 2007, Jos Boumans E<lt>kane@cpan.orgE<gt>. All rights reserved.
 298
 299 This library is free software; you may redistribute and/or modify it
 300 under the same terms as Perl itself.
 301
 302 =head1 SEE ALSO
 303
 304 L<CPANPLUS::Shell::Default>, L<CPANPLUS::Shell::Classic>, L<cpanp>
 305
 306 =cut
 307
 308 # Local variables:
 309 # c-indentation-style: bsd
 310 # c-basic-offset: 4
 311 # indent-tabs-mode: nil
 312 # End:
 313 # vim: expandtab shiftwidth=4:
 314