File Coverage

lib/CPANPLUS/Shell.pm
Criterion Covered Total %
statement 56 129 43.4
branch 2 44 4.5
condition 0 6 0.0
subroutine 17 28 60.7
pod 0 1 0.0
total 75 208 36.0


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