Commit | Line | Data |
6aaee015 |
1 | package CPANPLUS::Shell; |
2 | |
3 | use strict; |
4 | |
5 | use CPANPLUS::Error; |
6 | use CPANPLUS::Configure; |
494f1016 |
7 | use CPANPLUS::Internals::Constants; |
6aaee015 |
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 | |
494f1016 |
17 | $DEFAULT = SHELL_DEFAULT; |
6aaee015 |
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 | |
6aaee015 |
52 | sub import { |
53 | my $class = shift; |
54 | my $option = shift; |
6aaee015 |
55 | |
56 | ### find out what shell we're supposed to load ### |
57 | $SHELL = $option |
58 | ? $class . '::' . $option |
5bc5f6dc |
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 | |
6aaee015 |
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 | |
5bc5f6dc |
193 | $self->__print( |
194 | loc("%1 -- CPAN exploration and module installation (v%2)", |
6aaee015 |
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", |
5bc5f6dc |
198 | $cpan->VERSION, $rl_avail), "\n\n" |
199 | ); |
6aaee015 |
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 | |
5bc5f6dc |
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 | |
6aaee015 |
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 | |