Commit | Line | Data |
6aaee015 |
1 | package CPANPLUS::Shell; |
2 | |
3 | use strict; |
4 | |
5 | use CPANPLUS::Error; |
6 | use CPANPLUS::Configure; |
7 | |
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 = 'CPANPLUS::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 | |