[ Index ] |
PHP Cross Reference of Unnamed Project |
[Summary view] [Print] [Text view]
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 sub import { 53 my $class = shift; 54 my $option = shift; 55 56 ### find out what shell we're supposed to load ### 57 $SHELL = $option 58 ? $class . '::' . $option 59 : do { ### XXX this should offer to reconfigure 60 ### CPANPLUS, somehow. --rs 61 ### XXX load Configure only if we really have to 62 ### as that means any $Conf passed later on will 63 ### be ignored in favour of the one that was 64 ### retrieved via ->new --kane 65 my $conf = CPANPLUS::Configure->new() or 66 die loc("No configuration available -- aborting") . $/; 67 $conf->get_conf('shell') || $DEFAULT; 68 }; 69 70 ### load the shell, fall back to the default if required 71 ### and die if even that doesn't work 72 EVAL: { 73 eval { load $SHELL }; 74 75 if( $@ ) { 76 my $err = $@; 77 78 die loc("Your default shell '%1' is not available: %2", 79 $DEFAULT, $err) . 80 loc("Check your installation!") . "\n" 81 if $SHELL eq $DEFAULT; 82 83 warn loc("Failed to use '%1': %2", $SHELL, $err), 84 loc("Switching back to the default shell '%1'", $DEFAULT), 85 "\n"; 86 87 $SHELL = $DEFAULT; 88 redo EVAL; 89 } 90 } 91 @ISA = ($SHELL); 92 } 93 94 sub which { return $SHELL } 95 96 1; 97 98 ########################################################################### 99 ### abstracted out subroutines available to programmers of other shells ### 100 ########################################################################### 101 102 package CPANPLUS::Shell::_Base::ReadLine; 103 104 use strict; 105 use vars qw($AUTOLOAD $TMPL); 106 107 use FileHandle; 108 use CPANPLUS::Error; 109 use Params::Check qw[check]; 110 use Module::Load::Conditional qw[can_load]; 111 use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext'; 112 113 $Params::Check::VERBOSE = 1; 114 115 116 $TMPL = { 117 brand => { default => '', strict_type => 1 }, 118 prompt => { default => '> ', strict_type => 1 }, 119 pager => { default => '' }, 120 backend => { default => '' }, 121 term => { default => '' }, 122 format => { default => '' }, 123 dist_format => { default => '' }, 124 remote => { default => undef }, 125 noninteractive => { default => '' }, 126 cache => { default => [ ] }, 127 _old_sigpipe => { default => '', no_override => 1 }, 128 _old_outfh => { default => '', no_override => 1 }, 129 _signals => { default => { INT => { } }, no_override => 1 }, 130 }; 131 132 ### autogenerate accessors ### 133 for my $key ( keys %$TMPL ) { 134 no strict 'refs'; 135 *{__PACKAGE__."::$key"} = sub { 136 my $self = shift; 137 $self->{$key} = $_[0] if @_; 138 return $self->{$key}; 139 } 140 } 141 142 sub _init { 143 my $class = shift; 144 my %hash = @_; 145 146 my $self = check( $TMPL, \%hash ) or return; 147 148 bless $self, $class; 149 150 ### signal handler ### 151 $SIG{INT} = $self->_signals->{INT}->{handler} = 152 sub { 153 unless ( $self->_signals->{INT}->{count}++ ) { 154 warn loc("Caught SIGINT"), "\n"; 155 } else { 156 warn loc("Got another SIGINT"), "\n"; die; 157 } 158 }; 159 ### end sig handler ### 160 161 return $self; 162 } 163 164 ### display shell's banner, takes the Backend object as argument 165 sub _show_banner { 166 my $self = shift; 167 my $cpan = $self->backend; 168 my $term = $self->term; 169 170 ### Tries to probe for our ReadLine support status 171 # a) under an interactive shell? 172 my $rl_avail = (!$term->isa('CPANPLUS::Shell::_Faked')) 173 # b) do we have a tty terminal? 174 ? (-t STDIN) 175 # c) should we enable the term? 176 ? (!$self->__is_bad_terminal($term)) 177 # d) external modules available? 178 ? ($term->ReadLine ne "Term::ReadLine::Stub") 179 # a+b+c+d => "Smart" terminal 180 ? loc("enabled") 181 # a+b+c => "Stub" terminal 182 : loc("available (try 'i Term::ReadLine::Perl')") 183 # a+b => "Bad" terminal 184 : loc("disabled") 185 # a => "Dumb" terminal 186 : loc("suppressed") 187 # none => "Faked" terminal 188 : loc("suppressed in batch mode"); 189 190 $rl_avail = loc("ReadLine support %1.", $rl_avail); 191 $rl_avail = "\n*** $rl_avail" if (length($rl_avail) > 45); 192 193 $self->__print( 194 loc("%1 -- CPAN exploration and module installation (v%2)", 195 $self->which, $self->which->VERSION()), "\n", 196 loc("*** Please report bugs to <bug-cpanplus\@rt.cpan.org>."), "\n", 197 loc("*** Using CPANPLUS::Backend v%1. %2", 198 $cpan->VERSION, $rl_avail), "\n\n" 199 ); 200 } 201 202 ### checks whether the Term::ReadLine is broken and needs to fallback to Stub 203 sub __is_bad_terminal { 204 my $self = shift; 205 my $term = $self->term; 206 207 return unless $^O eq 'MSWin32'; 208 209 ### replace the term with the default (stub) one 210 return $self->term(Term::ReadLine::Stub->new( $self->brand ) ); 211 } 212 213 ### open a pager handle 214 sub _pager_open { 215 my $self = shift; 216 my $cpan = $self->backend; 217 my $cmd = $cpan->configure_object->get_program('pager') or return; 218 219 $self->_old_sigpipe( $SIG{PIPE} ); 220 $SIG{PIPE} = 'IGNORE'; 221 222 my $fh = new FileHandle; 223 unless ( $fh->open("| $cmd") ) { 224 error(loc("could not pipe to %1: %2\n", $cmd, $!) ); 225 return; 226 } 227 228 $fh->autoflush(1); 229 230 $self->pager( $fh ); 231 $self->_old_outfh( select $fh ); 232 233 return $fh; 234 } 235 236 ### print to the current pager handle, or STDOUT if it's not opened 237 sub _pager_close { 238 my $self = shift; 239 my $pager = $self->pager or return; 240 241 $pager->close if (ref($pager) and $pager->can('close')); 242 243 $self->pager( undef ); 244 245 select $self->_old_outfh; 246 $SIG{PIPE} = $self->_old_sigpipe; 247 248 return 1; 249 } 250 251 252 253 { 254 my $win32_console; 255 256 ### determines row count of current terminal; defaults to 25. 257 ### used by the pager functions 258 sub _term_rowcount { 259 my $self = shift; 260 my $cpan = $self->backend; 261 my %hash = @_; 262 263 my $default; 264 my $tmpl = { 265 default => { default => 25, allow => qr/^\d$/, 266 store => \$default } 267 }; 268 269 check( $tmpl, \%hash ) or return; 270 271 if ( $^O eq 'MSWin32' ) { 272 if ( can_load( modules => { 'Win32::Console' => '0.0' } ) ) { 273 $win32_console ||= Win32::Console->new(); 274 my $rows = ($win32_console->Info)[-1]; 275 return $rows; 276 } 277 278 } else { 279 local $Module::Load::Conditional::VERBOSE = 0; 280 if ( can_load(modules => {'Term::Size' => '0.0'}) ) { 281 my ($cols, $rows) = Term::Size::chars(); 282 return $rows; 283 } 284 } 285 return $default; 286 } 287 } 288 289 ### Custom print routines, mainly to be able to catch output 290 ### in test cases, or redirect it if need be 291 { sub __print { 292 my $self = shift; 293 print @_; 294 } 295 296 sub __printf { 297 my $self = shift; 298 my $fmt = shift; 299 300 ### MUST specify $fmt as a seperate param, and not as part 301 ### of @_, as it will then miss the $fmt and return the 302 ### number of elements in the list... =/ --kane 303 $self->__print( sprintf( $fmt, @_ ) ); 304 } 305 } 306 307 1; 308 309 =pod 310 311 =head1 BUG REPORTS 312 313 Please report bugs or other issues to E<lt>bug-cpanplus@rt.cpan.org<gt>. 314 315 =head1 AUTHOR 316 317 This module by Jos Boumans E<lt>kane@cpan.orgE<gt>. 318 319 =head1 COPYRIGHT 320 321 The CPAN++ interface (of which this module is a part of) is copyright (c) 322 2001 - 2007, Jos Boumans E<lt>kane@cpan.orgE<gt>. All rights reserved. 323 324 This library is free software; you may redistribute and/or modify it 325 under the same terms as Perl itself. 326 327 =head1 SEE ALSO 328 329 L<CPANPLUS::Shell::Default>, L<CPANPLUS::Shell::Classic>, L<cpanp> 330 331 =cut 332 333 # Local variables: 334 # c-indentation-style: bsd 335 # c-basic-offset: 4 336 # indent-tabs-mode: nil 337 # End: 338 # vim: expandtab shiftwidth=4: 339
title
Description
Body
title
Description
Body
title
Description
Body
title
Body
Generated: Tue Mar 17 22:47:18 2015 | Cross-referenced by PHPXref 0.7.1 |