home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl / 5.10.0 / CPANPLUS / Shell.pm < prev   
Encoding:
Perl POD Document  |  2009-06-26  |  9.3 KB  |  340 lines
  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.  
  340.