Commit | Line | Data |
6aaee015 |
1 | package CPANPLUS::Shell::Default; |
2 | |
3 | use strict; |
4 | |
5 | |
6 | use CPANPLUS::Error; |
7 | use CPANPLUS::Backend; |
8 | use CPANPLUS::Configure::Setup; |
9 | use CPANPLUS::Internals::Constants; |
10 | use CPANPLUS::Internals::Constants::Report qw[GRADE_FAIL]; |
11 | |
12 | use Cwd; |
13 | use IPC::Cmd; |
14 | use Term::UI; |
15 | use Data::Dumper; |
16 | use Term::ReadLine; |
17 | |
18 | use Module::Load qw[load]; |
19 | use Params::Check qw[check]; |
20 | use Module::Load::Conditional qw[can_load check_install]; |
21 | use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext'; |
22 | |
23 | local $Params::Check::VERBOSE = 1; |
24 | local $Data::Dumper::Indent = 1; # for dumpering from ! |
25 | |
26 | BEGIN { |
27 | use vars qw[ $VERSION @ISA ]; |
28 | @ISA = qw[ CPANPLUS::Shell::_Base::ReadLine ]; |
a0995fd4 |
29 | $VERSION = "0.87_01"; |
6aaee015 |
30 | } |
31 | |
32 | load CPANPLUS::Shell; |
33 | |
34 | |
35 | my $map = { |
36 | 'm' => '_search_module', |
37 | 'a' => '_search_author', |
38 | '!' => '_bang', |
39 | '?' => '_help', |
40 | 'h' => '_help', |
41 | 'q' => '_quit', |
42 | 'r' => '_readme', |
43 | 'v' => '_show_banner', |
44 | 'w' => '__display_results', |
45 | 'd' => '_fetch', |
46 | 'z' => '_shell', |
47 | 'f' => '_distributions', |
48 | 'x' => '_reload_indices', |
49 | 'i' => '_install', |
50 | 't' => '_install', |
51 | 'l' => '_details', |
52 | 'p' => '_print', |
53 | 's' => '_set_conf', |
54 | 'o' => '_uptodate', |
55 | 'b' => '_autobundle', |
56 | 'u' => '_uninstall', |
57 | '/' => '_meta', # undocumented for now |
58 | 'c' => '_reports', |
59 | }; |
60 | ### free letters: e g j k n y ### |
61 | |
62 | |
63 | ### will be filled if you have a .default-shell.rc and |
64 | ### Config::Auto installed |
65 | my $rc = {}; |
66 | |
67 | ### the shell object, scoped to the file ### |
68 | my $Shell; |
69 | my $Brand = loc('CPAN Terminal'); |
70 | my $Prompt = $Brand . '> '; |
71 | |
72 | =pod |
73 | |
74 | =head1 NAME |
75 | |
76 | CPANPLUS::Shell::Default |
77 | |
78 | =head1 SYNOPSIS |
79 | |
80 | ### loading the shell: |
81 | $ cpanp # run 'cpanp' from the command line |
82 | $ perl -MCPANPLUS -eshell # load the shell from the command line |
83 | |
84 | |
85 | use CPANPLUS::Shell qw[Default]; # load this shell via the API |
86 | # always done via CPANPLUS::Shell |
87 | |
88 | my $ui = CPANPLUS::Shell->new; |
89 | $ui->shell; # run the shell |
90 | $ui->dispatch_on_input( input => 'x'); # update the source using the |
91 | # dispatch method |
92 | |
93 | ### when in the shell: |
94 | ### Note that all commands can also take options. |
95 | ### Look at their underlying CPANPLUS::Backend methods to see |
96 | ### what options those are. |
97 | cpanp> h # show help messages |
98 | cpanp> ? # show help messages |
99 | |
100 | cpanp> m Acme # find acme modules, allows regexes |
101 | cpanp> a KANE # find modules by kane, allows regexes |
102 | cpanp> f Acme::Foo # get a list of all releases of Acme::Foo |
103 | |
104 | cpanp> i Acme::Foo # install Acme::Foo |
105 | cpanp> i Acme-Foo-1.3 # install version 1.3 of Acme::Foo |
106 | cpanp> i <URI> # install from URI, like ftp://foo.com/X.tgz |
a0995fd4 |
107 | cpanp> i <DIR> # install from an absolute or relative directory |
6aaee015 |
108 | cpanp> i 1 3..5 # install search results 1, 3, 4 and 5 |
109 | cpanp> i * # install all search results |
110 | cpanp> a KANE; i *; # find modules by kane, install all results |
111 | cpanp> t Acme::Foo # test Acme::Foo, without installing it |
112 | cpanp> u Acme::Foo # uninstall Acme::Foo |
113 | cpanp> d Acme::Foo # download Acme::Foo |
114 | cpanp> z Acme::Foo # download & extract Acme::Foo, then open a |
115 | # shell in the extraction directory |
116 | |
117 | cpanp> c Acme::Foo # get a list of test results for Acme::Foo |
118 | cpanp> l Acme::Foo # view details about the Acme::Foo package |
119 | cpanp> r Acme::Foo # view Acme::Foo's README file |
120 | cpanp> o # get a list of all installed modules that |
121 | # are out of date |
122 | cpanp> o 1..3 # list uptodateness from a previous search |
123 | |
124 | cpanp> s conf # show config settings |
125 | cpanp> s conf md5 1 # enable md5 checks |
126 | cpanp> s program # show program settings |
127 | cpanp> s edit # edit config file |
128 | cpanp> s reconfigure # go through initial configuration again |
129 | cpanp> s selfupdate # update your CPANPLUS install |
130 | cpanp> s save # save config to disk |
131 | cpanp> s mirrors # show currently selected mirrors |
132 | |
133 | cpanp> ! [PERL CODE] # execute the following perl code |
134 | |
135 | cpanp> b # create an autobundle for this computers |
136 | # perl installation |
137 | cpanp> x # reload index files (purges cache) |
138 | cpanp> x --update_source # reload index files, get fresh source files |
139 | cpanp> p [FILE] # print error stack (to a file) |
140 | cpanp> v # show the banner |
141 | cpanp> w # show last search results again |
142 | |
143 | cpanp> q # quit the shell |
144 | |
145 | cpanp> /plugins # list avialable plugins |
146 | cpanp> /? PLUGIN # list help test of <PLUGIN> |
147 | |
148 | ### common options: |
149 | cpanp> i ... --skiptest # skip tests |
150 | cpanp> i ... --force # force all operations |
151 | cpanp> i ... --verbose # run in verbose mode |
152 | |
153 | =head1 DESCRIPTION |
154 | |
155 | This module provides the default user interface to C<CPANPLUS>. You |
156 | can start it via the C<cpanp> binary, or as detailed in the L<SYNOPSIS>. |
157 | |
158 | =cut |
159 | |
160 | sub new { |
161 | my $class = shift; |
162 | |
5bc5f6dc |
163 | my $cb = CPANPLUS::Backend->new( @_ ); |
6aaee015 |
164 | my $self = $class->SUPER::_init( |
165 | brand => $Brand, |
166 | term => Term::ReadLine->new( $Brand ), |
167 | prompt => $Prompt, |
168 | backend => $cb, |
169 | format => "%4s %-55s %8s %-10s\n", |
170 | dist_format => "%4s %-42s %-12s %8s %-10s\n", |
171 | ); |
172 | ### make it available package wide ### |
173 | $Shell = $self; |
174 | |
175 | my $rc_file = File::Spec->catfile( |
176 | $cb->configure_object->get_conf('base'), |
177 | DOT_SHELL_DEFAULT_RC, |
178 | ); |
179 | |
180 | |
181 | if( -e $rc_file && -r _ ) { |
5bc5f6dc |
182 | $rc = $self->_read_configuration_from_rc( $rc_file ); |
6aaee015 |
183 | } |
184 | |
185 | ### register install callback ### |
186 | $cb->_register_callback( |
187 | name => 'install_prerequisite', |
188 | code => \&__ask_about_install, |
189 | ); |
190 | |
191 | ### execute any login commands specified ### |
192 | $self->dispatch_on_input( input => $rc->{'login'} ) |
193 | if defined $rc->{'login'}; |
194 | |
195 | ### register test report callbacks ### |
196 | $cb->_register_callback( |
197 | name => 'edit_test_report', |
198 | code => \&__ask_about_edit_test_report, |
199 | ); |
200 | |
201 | $cb->_register_callback( |
202 | name => 'send_test_report', |
203 | code => \&__ask_about_send_test_report, |
204 | ); |
205 | |
622d31ac |
206 | $cb->_register_callback( |
207 | name => 'proceed_on_test_failure', |
208 | code => \&__ask_about_test_failure, |
209 | ); |
210 | |
5bc5f6dc |
211 | ### load all the plugins |
212 | $self->_plugins_init; |
6aaee015 |
213 | |
214 | return $self; |
215 | } |
216 | |
217 | sub shell { |
218 | my $self = shift; |
219 | my $term = $self->term; |
220 | my $conf = $self->backend->configure_object; |
221 | |
222 | $self->_show_banner; |
5bc5f6dc |
223 | $self->__print( "*** Type 'p' now to show start up log\n" ); # XXX add to banner? |
6aaee015 |
224 | $self->_show_random_tip if $conf->get_conf('show_startup_tip'); |
5bc5f6dc |
225 | $self->_input_loop && $self->__print( "\n" ); |
6aaee015 |
226 | $self->_quit; |
227 | } |
228 | |
229 | sub _input_loop { |
230 | my $self = shift; |
231 | my $term = $self->term; |
232 | my $cb = $self->backend; |
233 | |
234 | my $normal_quit = 0; |
235 | while ( |
236 | defined (my $input = eval { $term->readline($self->prompt) } ) |
237 | or $self->_signals->{INT}{count} == 1 |
238 | ) { |
239 | ### re-initiate all signal handlers |
240 | while (my ($sig, $entry) = each %{$self->_signals} ) { |
241 | $SIG{$sig} = $entry->{handler} if exists($entry->{handler}); |
242 | } |
243 | |
5bc5f6dc |
244 | $self->__print( "\n" ); |
6aaee015 |
245 | last if $self->dispatch_on_input( input => $input ); |
246 | |
247 | ### flush the lib cache ### |
248 | $cb->_flush( list => [qw|lib load|] ); |
249 | |
250 | } continue { |
4443dd53 |
251 | ### clear the sigint count |
6aaee015 |
252 | $self->_signals->{INT}{count}-- |
4443dd53 |
253 | if $self->_signals->{INT}{count}; |
254 | |
255 | ### reset the 'install prereq?' cached answer |
256 | $self->settings->{'install_all_prereqs'} = undef; |
257 | |
6aaee015 |
258 | } |
259 | |
260 | return 1; |
261 | } |
262 | |
263 | ### return 1 to quit ### |
264 | sub dispatch_on_input { |
265 | my $self = shift; |
266 | my $conf = $self->backend->configure_object(); |
267 | my $term = $self->term; |
268 | my %hash = @_; |
269 | |
270 | my($string, $noninteractive); |
271 | my $tmpl = { |
272 | input => { required => 1, store => \$string }, |
273 | noninteractive => { required => 0, store => \$noninteractive }, |
274 | }; |
275 | |
276 | check( $tmpl, \%hash ) or return; |
277 | |
278 | ### indicates whether or not the user will receive a shell |
279 | ### prompt after the command has finished. |
280 | $self->noninteractive($noninteractive) if defined $noninteractive; |
281 | |
282 | my @cmds = split ';', $string; |
283 | while( my $input = shift @cmds ) { |
284 | |
285 | ### to send over the socket ### |
286 | my $org_input = $input; |
287 | |
288 | my $key; my $options; |
289 | { ### make whitespace not count when using special chars |
290 | { $input =~ s|^\s*([!?/])|$1 |; } |
291 | |
292 | ### get the first letter of the input |
293 | $input =~ s|^\s*([\w\?\!/])\w*||; |
294 | |
295 | chomp $input; |
296 | $key = lc($1); |
297 | |
298 | ### we figured out what the command was... |
299 | ### if we have more input, that DOES NOT start with a white |
300 | ### space char, we misparsed.. like 'Test::Foo::Bar', which |
301 | ### would turn into 't', '::Foo::Bar'... |
302 | if( $input and $input !~ s/^\s+// ) { |
5bc5f6dc |
303 | $self->__print( loc("Could not understand command: %1\n". |
6aaee015 |
304 | "Possibly missing command before argument(s)?\n", |
5bc5f6dc |
305 | $org_input) ); |
6aaee015 |
306 | return; |
307 | } |
308 | |
309 | ### allow overrides from the config file ### |
310 | if( defined $rc->{$key} ) { |
311 | $input = $rc->{$key} . $input; |
312 | } |
313 | |
314 | ### grab command line options like --no-force and --verbose ### |
315 | ($options,$input) = $term->parse_options($input) |
316 | unless $key eq '!'; |
317 | } |
318 | |
319 | ### emtpy line? ### |
320 | return unless $key; |
321 | |
322 | ### time to quit ### |
323 | return 1 if $key eq 'q'; |
324 | |
325 | my $method = $map->{$key}; |
326 | |
327 | ### dispatch meta locally at all times ### |
328 | $self->$method(input => $input, options => $options), next |
329 | if $key eq '/'; |
330 | |
331 | ### flush unless we're trying to print the stack |
332 | CPANPLUS::Error->flush unless $key eq 'p'; |
333 | |
334 | ### connected over a socket? ### |
335 | if( $self->remote ) { |
336 | |
337 | ### unsupported commands ### |
338 | if( $key eq 'z' or |
339 | ($key eq 's' and $input =~ /^\s*edit/) |
340 | ) { |
5bc5f6dc |
341 | $self->__print( "\n", |
d0baa00e |
342 | loc( "Command '%1' not supported over remote connection", |
343 | join ' ', $key, $input |
5bc5f6dc |
344 | ), "\n\n" ); |
6aaee015 |
345 | |
346 | } else { |
347 | my($status,$buff) = $self->__send_remote_command($org_input); |
348 | |
5bc5f6dc |
349 | $self->__print( "\n", loc("Command failed!"), "\n\n" ) |
350 | unless $status; |
6aaee015 |
351 | |
352 | $self->_pager_open if $buff =~ tr/\n// > $self->_term_rowcount; |
5bc5f6dc |
353 | $self->__print( $buff ); |
6aaee015 |
354 | $self->_pager_close; |
355 | } |
356 | |
357 | ### or just a plain local shell? ### |
358 | } else { |
359 | |
360 | unless( $self->can($method) ) { |
5bc5f6dc |
361 | $self->__print(loc("Unknown command '%1'. Usage:", $key), "\n"); |
6aaee015 |
362 | $self->_help; |
363 | |
364 | } else { |
365 | |
366 | ### some methods don't need modules ### |
367 | my @mods; |
368 | @mods = $self->_select_modules($input) |
369 | unless grep {$key eq $_} qw[! m a v w x p s b / ? h]; |
370 | |
371 | eval { $self->$method( modules => \@mods, |
372 | options => $options, |
373 | input => $input, |
374 | choice => $key ) |
375 | }; |
376 | error( $@ ) if $@; |
377 | } |
378 | } |
379 | } |
380 | |
381 | return; |
382 | } |
383 | |
384 | sub _select_modules { |
385 | my $self = shift; |
386 | my $input = shift or return; |
387 | my $cache = $self->cache; |
388 | my $cb = $self->backend; |
389 | |
390 | ### expand .. in $input |
391 | $input =~ s{\b(\d+)\s*\.\.\s*(\d+)\b} |
392 | {join(' ', ($1 < 1 ? 1 : $1) .. ($2 > $#{$cache} ? $#{$cache} : $2))}eg; |
393 | |
394 | $input = join(' ', 1 .. $#{$cache}) if $input eq '*'; |
395 | $input =~ s/'/::/g; # perl 4 convention |
396 | |
397 | my @rv; |
398 | for my $mod (split /\s+/, $input) { |
399 | |
400 | ### it's a cache look up ### |
401 | if( $mod =~ /^\d+/ and $mod > 0 ) { |
402 | unless( scalar @$cache ) { |
5bc5f6dc |
403 | $self->__print( loc("No search was done yet!"), "\n" ); |
6aaee015 |
404 | |
405 | } elsif ( my $obj = $cache->[$mod] ) { |
406 | push @rv, $obj; |
407 | |
408 | } else { |
5bc5f6dc |
409 | $self->__print( loc("No such module: %1", $mod), "\n" ); |
6aaee015 |
410 | } |
411 | |
412 | } else { |
413 | my $obj = $cb->parse_module( module => $mod ); |
414 | |
415 | unless( $obj ) { |
5bc5f6dc |
416 | $self->__print( loc("No such module: %1", $mod), "\n" ); |
6aaee015 |
417 | |
418 | } else { |
419 | push @rv, $obj; |
420 | } |
421 | } |
422 | } |
423 | |
424 | unless( scalar @rv ) { |
5bc5f6dc |
425 | $self->__print( loc("No modules found to operate on!\n") ); |
6aaee015 |
426 | return; |
427 | } else { |
428 | return @rv; |
429 | } |
430 | } |
431 | |
432 | sub _format_version { |
433 | my $self = shift; |
4443dd53 |
434 | my $version = shift || 0; |
6aaee015 |
435 | |
436 | ### fudge $version into the 'optimal' format |
437 | $version = 0 if $version eq 'undef'; |
438 | $version =~ s/_//g; # everything after gets stripped off otherwise |
439 | |
440 | ### allow 6 digits after the dot, as that's how perl stringifies |
441 | ### x.y.z numbers. |
442 | $version = sprintf('%3.6f', $version); |
443 | $version = '' if $version == '0.00'; |
444 | $version =~ s/(00{0,3})$/' ' x (length $1)/e; |
445 | |
446 | return $version; |
447 | } |
448 | |
449 | sub __display_results { |
450 | my $self = shift; |
451 | my $cache = $self->cache; |
452 | |
453 | my @rv = @$cache; |
454 | |
455 | if( scalar @rv ) { |
456 | |
457 | $self->_pager_open if $#{$cache} >= $self->_term_rowcount; |
458 | |
459 | my $i = 1; |
460 | for my $mod (@rv) { |
461 | next unless $mod; # first one is undef |
462 | # humans start counting at 1 |
463 | |
464 | ### for dists only -- we have checksum info |
465 | if( $mod->mtime ) { |
5bc5f6dc |
466 | $self->__printf( |
467 | $self->dist_format, |
468 | $i, |
469 | $mod->module, |
470 | $mod->mtime, |
471 | $self->_format_version( $mod->version ), |
472 | $mod->author->cpanid |
473 | ); |
6aaee015 |
474 | |
475 | } else { |
5bc5f6dc |
476 | $self->__printf( |
477 | $self->format, |
478 | $i, |
479 | $mod->module, |
480 | $self->_format_version( $mod->version ), |
481 | $mod->author->cpanid |
482 | ); |
6aaee015 |
483 | } |
484 | $i++; |
485 | } |
486 | |
487 | $self->_pager_close; |
488 | |
489 | } else { |
5bc5f6dc |
490 | $self->__print( loc("No results to display"), "\n" ); |
6aaee015 |
491 | } |
492 | } |
493 | |
494 | |
495 | sub _quit { |
496 | my $self = shift; |
497 | |
498 | $self->dispatch_on_input( input => $rc->{'logout'} ) |
499 | if defined $rc->{'logout'}; |
500 | |
5bc5f6dc |
501 | $self->__print( loc("Exiting CPANPLUS shell"), "\n" ); |
6aaee015 |
502 | } |
503 | |
504 | ########################### |
505 | ### actual command subs ### |
506 | ########################### |
507 | |
508 | |
509 | ### print out the help message ### |
510 | ### perhaps, '?' should be a slightly different version ### |
502c7995 |
511 | { my @help; |
512 | sub _help { |
513 | my $self = shift; |
514 | my %hash = @_; |
515 | |
516 | my $input; |
517 | { local $Params::Check::ALLOW_UNKNOWN = 1; |
518 | |
519 | my $tmpl = { |
520 | input => { required => 0, store => \$input } |
521 | }; |
522 | |
523 | my $args = check( $tmpl, \%hash ) or return; |
524 | } |
525 | |
526 | @help = ( |
6aaee015 |
527 | loc('[General]' ), |
528 | loc(' h | ? # display help' ), |
529 | loc(' q # exit' ), |
530 | loc(' v # version information' ), |
531 | loc('[Search]' ), |
532 | loc(' a AUTHOR ... # search by author(s)' ), |
533 | loc(' m MODULE ... # search by module(s)' ), |
534 | loc(' f MODULE ... # list all releases of a module' ), |
535 | loc(" o [ MODULE ... ] # list installed module(s) that aren't up to date" ), |
536 | loc(' w # display the result of your last search again' ), |
537 | loc('[Operations]' ), |
538 | loc(' i MODULE | NUMBER ... # install module(s), by name or by search number' ), |
539 | loc(' i URI | ... # install module(s), by URI (ie http://foo.com/X.tgz)' ), |
a0995fd4 |
540 | loc(' i DIR | ... # install module(s), by path (ie ./Module-1.0)' ), |
541 | \loc(' t MODULE | NUMBER ... # test module(s), by name or by search number' ), |
6aaee015 |
542 | loc(' u MODULE | NUMBER ... # uninstall module(s), by name or by search number' ), |
543 | loc(' d MODULE | NUMBER ... # download module(s)' ), |
544 | loc(' l MODULE | NUMBER ... # display detailed information about module(s)' ), |
545 | loc(' r MODULE | NUMBER ... # display README files of module(s)' ), |
546 | loc(' c MODULE | NUMBER ... # check for module report(s) from cpan-testers' ), |
547 | loc(' z MODULE | NUMBER ... # extract module(s) and open command prompt in it' ), |
548 | loc('[Local Administration]' ), |
549 | loc(' b # write a bundle file for your configuration' ), |
550 | loc(' s program [OPT VALUE] # set program locations for this session' ), |
551 | loc(' s conf [OPT VALUE] # set config options for this session' ), |
552 | loc(' s mirrors # show currently selected mirrors' ), |
553 | loc(' s reconfigure # reconfigure settings ' ), |
554 | loc(' s selfupdate # update your CPANPLUS install '), |
555 | loc(' s save [user|system] # save settings for this user or systemwide' ), |
556 | loc(' s edit [user|system] # open configuration file in editor and reload' ), |
557 | loc(' ! EXPR # evaluate a perl statement' ), |
558 | loc(' p [FILE] # print the error stack (optionally to a file)' ), |
559 | loc(' x # reload CPAN indices (purges cache)' ), |
502c7995 |
560 | loc(' x --update_source # reload CPAN indices, get fresh source files' ), |
561 | loc('[Common Options]' ), |
562 | loc(' i ... --skiptest # skip tests' ), |
563 | loc(' i ... --force # force all operations' ), |
564 | loc(' i ... --verbose # run in verbose mode' ), |
6aaee015 |
565 | loc('[Plugins]' ), |
566 | loc(' /plugins # list available plugins' ), |
567 | loc(' /? [PLUGIN NAME] # show usage for (a particular) plugin(s)' ), |
568 | |
502c7995 |
569 | ) unless @help; |
570 | |
571 | $self->_pager_open if (@help >= $self->_term_rowcount); |
572 | ### XXX: functional placeholder for actual 'detailed' help. |
5bc5f6dc |
573 | $self->__print( "Detailed help for the command '$input' is " . |
574 | "not available.\n\n" ) if length $input; |
575 | $self->__print( map {"$_\n"} @help ); |
576 | $self->__print( $/ ); |
502c7995 |
577 | $self->_pager_close; |
578 | } |
6aaee015 |
579 | } |
580 | |
581 | ### eval some code ### |
582 | sub _bang { |
583 | my $self = shift; |
584 | my $cb = $self->backend; |
585 | my %hash = @_; |
586 | |
587 | |
588 | my $input; |
589 | { local $Params::Check::ALLOW_UNKNOWN = 1; |
590 | |
591 | my $tmpl = { |
592 | input => { required => 1, store => \$input } |
593 | }; |
594 | |
595 | my $args = check( $tmpl, \%hash ) or return; |
596 | } |
597 | |
598 | local $Data::Dumper::Indent = 1; # for dumpering from ! |
599 | eval $input; |
600 | error( $@ ) if $@; |
5bc5f6dc |
601 | $self->__print( "\n" ); |
6aaee015 |
602 | return; |
603 | } |
604 | |
605 | sub _search_module { |
606 | my $self = shift; |
607 | my $cb = $self->backend; |
608 | my %hash = @_; |
609 | |
610 | my $args; |
611 | { local $Params::Check::ALLOW_UNKNOWN = 1; |
612 | |
613 | my $tmpl = { |
614 | input => { required => 1, }, |
615 | options => { default => { } }, |
616 | }; |
617 | |
618 | $args = check( $tmpl, \%hash ) or return; |
619 | } |
620 | |
621 | my @regexes = map { qr/$_/i } split /\s+/, $args->{'input'}; |
622 | |
623 | ### XXX this is rather slow, because (probably) |
624 | ### of the many method calls |
625 | ### XXX need to profile to speed it up =/ |
626 | |
627 | ### find the modules ### |
628 | my @rv = sort { $a->module cmp $b->module } |
629 | $cb->search( |
630 | %{$args->{'options'}}, |
631 | type => 'module', |
632 | allow => \@regexes, |
633 | ); |
634 | |
635 | ### store the result in the cache ### |
636 | $self->cache([undef,@rv]); |
637 | |
638 | $self->__display_results; |
639 | |
640 | return 1; |
641 | } |
642 | |
643 | sub _search_author { |
644 | my $self = shift; |
645 | my $cb = $self->backend; |
646 | my %hash = @_; |
647 | |
648 | my $args; |
649 | { local $Params::Check::ALLOW_UNKNOWN = 1; |
650 | |
651 | my $tmpl = { |
652 | input => { required => 1, }, |
653 | options => { default => { } }, |
654 | }; |
655 | |
656 | $args = check( $tmpl, \%hash ) or return; |
657 | } |
658 | |
659 | my @regexes = map { qr/$_/i } split /\s+/, $args->{'input'}; |
660 | |
661 | my @rv; |
662 | for my $type (qw[author cpanid]) { |
663 | push @rv, $cb->search( |
664 | %{$args->{'options'}}, |
665 | type => $type, |
666 | allow => \@regexes, |
667 | ); |
668 | } |
669 | |
670 | my %seen; |
671 | my @list = sort { $a->module cmp $b->module } |
672 | grep { defined } |
673 | map { $_->modules } |
674 | grep { not $seen{$_}++ } @rv; |
675 | |
676 | $self->cache([undef,@list]); |
677 | |
678 | $self->__display_results; |
679 | return 1; |
680 | } |
681 | |
682 | sub _readme { |
683 | my $self = shift; |
684 | my $cb = $self->backend; |
685 | my %hash = @_; |
686 | |
687 | my $args; my $mods; my $opts; |
688 | { local $Params::Check::ALLOW_UNKNOWN = 1; |
689 | |
690 | my $tmpl = { |
691 | modules => { required => 1, store => \$mods }, |
692 | options => { default => { }, store => \$opts }, |
693 | }; |
694 | |
695 | $args = check( $tmpl, \%hash ) or return; |
696 | } |
697 | |
698 | return unless scalar @$mods; |
699 | |
700 | $self->_pager_open; |
701 | for my $mod ( @$mods ) { |
5bc5f6dc |
702 | $self->__print( $mod->readme( %$opts ) ); |
6aaee015 |
703 | } |
704 | |
705 | $self->_pager_close; |
706 | |
707 | return 1; |
708 | } |
709 | |
710 | sub _fetch { |
711 | my $self = shift; |
712 | my $cb = $self->backend; |
713 | my %hash = @_; |
714 | |
715 | my $args; my $mods; my $opts; |
716 | { local $Params::Check::ALLOW_UNKNOWN = 1; |
717 | |
718 | my $tmpl = { |
719 | modules => { required => 1, store => \$mods }, |
720 | options => { default => { }, store => \$opts }, |
721 | }; |
722 | |
723 | $args = check( $tmpl, \%hash ) or return; |
724 | } |
725 | |
726 | $self->_pager_open if @$mods >= $self->_term_rowcount; |
727 | for my $mod (@$mods) { |
728 | my $where = $mod->fetch( %$opts ); |
729 | |
5bc5f6dc |
730 | $self->__print( |
731 | $where |
6aaee015 |
732 | ? loc("Successfully fetched '%1' to '%2'", |
733 | $mod->module, $where ) |
5bc5f6dc |
734 | : loc("Failed to fetch '%1'", $mod->module) |
735 | ); |
736 | $self->__print( "\n" ); |
6aaee015 |
737 | } |
738 | $self->_pager_close; |
739 | |
740 | } |
741 | |
742 | sub _shell { |
743 | my $self = shift; |
744 | my $cb = $self->backend; |
745 | my $conf = $cb->configure_object; |
746 | my %hash = @_; |
747 | |
748 | my $shell = $conf->get_program('shell'); |
749 | unless( $shell ) { |
5bc5f6dc |
750 | $self->__print( |
751 | loc("Your config does not specify a subshell!"), "\n", |
752 | loc("Perhaps you need to re-run your setup?"), "\n" |
753 | ); |
6aaee015 |
754 | return; |
755 | } |
756 | |
757 | my $args; my $mods; my $opts; |
758 | { local $Params::Check::ALLOW_UNKNOWN = 1; |
759 | |
760 | my $tmpl = { |
761 | modules => { required => 1, store => \$mods }, |
762 | options => { default => { }, store => \$opts }, |
763 | }; |
764 | |
765 | $args = check( $tmpl, \%hash ) or return; |
766 | } |
767 | |
768 | my $cwd = Cwd::cwd(); |
769 | for my $mod (@$mods) { |
770 | $mod->fetch( %$opts ) or next; |
771 | $mod->extract( %$opts ) or next; |
772 | |
773 | $cb->_chdir( dir => $mod->status->extract() ) or next; |
774 | |
775 | #local $ENV{PERL5OPT} = CPANPLUS::inc->original_perl5opt; |
776 | |
777 | if( system($shell) and $! ) { |
5bc5f6dc |
778 | $self->__print( |
779 | loc("Error executing your subshell '%1': %2", |
780 | $shell, $!),"\n" |
781 | ); |
6aaee015 |
782 | next; |
783 | } |
784 | } |
785 | $cb->_chdir( dir => $cwd ); |
786 | |
787 | return 1; |
788 | } |
789 | |
790 | sub _distributions { |
791 | my $self = shift; |
792 | my $cb = $self->backend; |
793 | my $conf = $cb->configure_object; |
794 | my %hash = @_; |
795 | |
796 | my $args; my $mods; my $opts; |
797 | { local $Params::Check::ALLOW_UNKNOWN = 1; |
798 | |
799 | my $tmpl = { |
800 | modules => { required => 1, store => \$mods }, |
801 | options => { default => { }, store => \$opts }, |
802 | }; |
803 | |
804 | $args = check( $tmpl, \%hash ) or return; |
805 | } |
806 | |
807 | my @list; |
808 | for my $mod (@$mods) { |
809 | push @list, sort { $a->version <=> $b->version } |
810 | grep { defined } $mod->distributions( %$opts ); |
811 | } |
812 | |
813 | my @rv = sort { $a->module cmp $b->module } @list; |
814 | |
815 | $self->cache([undef,@rv]); |
816 | $self->__display_results; |
817 | |
818 | return; 1; |
819 | } |
820 | |
821 | sub _reload_indices { |
822 | my $self = shift; |
823 | my $cb = $self->backend; |
824 | my %hash = @_; |
825 | |
826 | my $args; my $opts; |
827 | { local $Params::Check::ALLOW_UNKNOWN = 1; |
828 | |
829 | my $tmpl = { |
830 | options => { default => { }, store => \$opts }, |
831 | }; |
832 | |
833 | $args = check( $tmpl, \%hash ) or return; |
834 | } |
835 | |
836 | my $rv = $cb->reload_indices( %$opts ); |
837 | |
838 | ### so the update failed, but you didnt give it any options either |
839 | if( !$rv and !(keys %$opts) ) { |
5bc5f6dc |
840 | $self->__print( |
841 | "\nFailure may be due to corrupt source files\n" . |
842 | "Try this:\n\tx --update_source\n\n" ); |
6aaee015 |
843 | } |
844 | |
845 | return $rv; |
846 | |
847 | } |
848 | |
849 | sub _install { |
850 | my $self = shift; |
851 | my $cb = $self->backend; |
852 | my $conf = $cb->configure_object; |
853 | my %hash = @_; |
854 | |
855 | my $args; my $mods; my $opts; my $choice; |
856 | { local $Params::Check::ALLOW_UNKNOWN = 1; |
857 | |
858 | my $tmpl = { |
859 | modules => { required => 1, store => \$mods }, |
860 | options => { default => { }, store => \$opts }, |
861 | choice => { required => 1, store => \$choice, |
862 | allow => [qw|i t|] }, |
863 | }; |
864 | |
865 | $args = check( $tmpl, \%hash ) or return; |
866 | } |
867 | |
868 | unless( scalar @$mods ) { |
5bc5f6dc |
869 | $self->__print( loc("Nothing done\n") ); |
6aaee015 |
870 | return; |
871 | } |
872 | |
873 | my $target = $choice eq 'i' ? TARGET_INSTALL : TARGET_CREATE; |
874 | my $prompt = $choice eq 'i' ? loc('Installing ') : loc('Testing '); |
875 | my $action = $choice eq 'i' ? 'install' : 'test'; |
876 | |
877 | my $status = {}; |
878 | ### first loop over the mods to install them ### |
879 | for my $mod (@$mods) { |
5bc5f6dc |
880 | $self->__print( $prompt, $mod->module, " (".$mod->version.")", "\n" ); |
6aaee015 |
881 | |
882 | my $log_length = length CPANPLUS::Error->stack_as_string; |
883 | |
884 | ### store the status for look up when we're done with all |
885 | ### install calls |
886 | $status->{$mod} = $mod->install( %$opts, target => $target ); |
887 | |
888 | ### would you like a log file of what happened? |
889 | if( $conf->get_conf('write_install_logs') ) { |
890 | |
891 | my $dir = File::Spec->catdir( |
892 | $conf->get_conf('base'), |
893 | $conf->_get_build('install_log_dir'), |
894 | ); |
895 | ### create the dir if it doesn't exit yet |
896 | $cb->_mkdir( dir => $dir ) unless -d $dir; |
897 | |
898 | my $file = File::Spec->catfile( |
899 | $dir, |
900 | INSTALL_LOG_FILE->( $mod ) |
901 | ); |
902 | if ( open my $fh, ">$file" ) { |
903 | my $stack = CPANPLUS::Error->stack_as_string; |
904 | ### remove everything in the log that was there *before* |
905 | ### we started this install |
906 | substr( $stack, 0, $log_length, '' ); |
907 | |
908 | print $fh $stack; |
909 | close $fh; |
910 | |
5bc5f6dc |
911 | $self->__print( |
912 | loc("*** Install log written to:\n %1\n\n", $file) |
913 | ); |
6aaee015 |
914 | } else { |
915 | warn "Could not open '$file': $!\n"; |
916 | next; |
917 | } |
918 | } |
919 | } |
920 | |
921 | my $flag; |
922 | ### then report whether all this went ok or not ### |
923 | for my $mod (@$mods) { |
924 | # if( $mod->status->installed ) { |
925 | if( $status->{$mod} ) { |
5bc5f6dc |
926 | $self->__print( |
927 | loc("Module '%1' %tense(%2,past) successfully\n", |
928 | $mod->module, $action) |
929 | ); |
6aaee015 |
930 | } else { |
931 | $flag++; |
5bc5f6dc |
932 | $self->__print( |
933 | loc("Error %tense(%1,present) '%2'\n", $action, $mod->module) |
934 | ); |
6aaee015 |
935 | } |
936 | } |
937 | |
938 | |
939 | |
940 | if( !$flag ) { |
5bc5f6dc |
941 | $self->__print( |
942 | loc("No errors %tense(%1,present) all modules", $action), "\n" |
943 | ); |
6aaee015 |
944 | } else { |
5bc5f6dc |
945 | $self->__print( |
946 | loc("Problem %tense(%1,present) one or more modules", $action) |
947 | ); |
948 | $self->__print( "\n" ); |
949 | |
950 | $self->__print( |
951 | loc("*** You can view the complete error buffer by pressing ". |
952 | "'%1' ***\n", 'p') |
953 | ) unless $conf->get_conf('verbose') || $self->noninteractive; |
6aaee015 |
954 | } |
5bc5f6dc |
955 | $self->__print( "\n" ); |
6aaee015 |
956 | |
957 | return !$flag; |
958 | } |
959 | |
960 | sub __ask_about_install { |
961 | my $mod = shift or return; |
962 | my $prereq = shift or return; |
963 | my $term = $Shell->term; |
964 | |
5bc5f6dc |
965 | $Shell->__print( "\n" ); |
966 | $Shell->__print( loc("Module '%1' requires '%2' to be installed", |
967 | $mod->module, $prereq->module ) ); |
968 | $Shell->__print( "\n\n" ); |
4443dd53 |
969 | |
970 | ### previously cached answer? |
971 | return $Shell->settings->{'install_all_prereqs'} |
972 | if defined $Shell->settings->{'install_all_prereqs'}; |
973 | |
974 | |
5bc5f6dc |
975 | $Shell->__print( |
976 | loc( "If you don't wish to see this question anymore\n". |
6aaee015 |
977 | "you can disable it by entering the following ". |
978 | "commands on the prompt:\n '%1'", |
5bc5f6dc |
979 | 's conf prereqs 1; s save' ) ); |
980 | $Shell->__print("\n\n"); |
6aaee015 |
981 | |
4443dd53 |
982 | my $yes = loc("Yes"); |
983 | my $no = loc("No"); |
984 | my $all = loc("Yes to all (for this module)"); |
985 | my $none = loc("No to all (for this module)"); |
986 | |
987 | my $reply = $term->get_reply( |
6aaee015 |
988 | prompt => loc("Should I install this module?"), |
4443dd53 |
989 | choices => [ $yes, $no, $all, $none ], |
990 | default => $yes, |
6aaee015 |
991 | ); |
992 | |
4443dd53 |
993 | ### if 'all' or 'none', save this, so we can apply it to |
994 | ### other prereqs in this chain. |
995 | $Shell->settings->{'install_all_prereqs'} = |
996 | $reply eq $all ? 1 : |
997 | $reply eq $none ? 0 : |
998 | undef; |
999 | |
1000 | ### if 'yes' or 'all', the user wants it installed |
1001 | return $reply eq $all ? 1 : |
1002 | $reply eq $yes ? 1 : |
1003 | 0; |
6aaee015 |
1004 | } |
1005 | |
1006 | sub __ask_about_send_test_report { |
1007 | my($mod, $grade) = @_; |
1008 | return 1 unless $grade eq GRADE_FAIL; |
1009 | |
1010 | my $term = $Shell->term; |
1011 | |
5bc5f6dc |
1012 | $Shell->__print( "\n" ); |
1013 | $Shell->__print( |
1014 | loc("Test report prepared for module '%1'.\n Would you like to ". |
1015 | "send it? (You can edit it if you like)", $mod->module ) ); |
1016 | $Shell->__print( "\n\n" ); |
6aaee015 |
1017 | my $bool = $term->ask_yn( |
1018 | prompt => loc("Would you like to send the test report?"), |
1019 | default => 'n' |
1020 | ); |
1021 | |
1022 | return $bool; |
1023 | } |
1024 | |
1025 | sub __ask_about_edit_test_report { |
1026 | my($mod, $grade) = @_; |
1027 | return 0 unless $grade eq GRADE_FAIL; |
1028 | |
1029 | my $term = $Shell->term; |
1030 | |
5bc5f6dc |
1031 | $Shell->__print( "\n" ); |
1032 | $Shell->__print( |
1033 | loc("Test report prepared for module '%1'. You can edit this ". |
1034 | "report if you would like", $mod->module ) ); |
1035 | $Shell->__print("\n\n"); |
6aaee015 |
1036 | my $bool = $term->ask_yn( |
1037 | prompt => loc("Would you like to edit the test report?"), |
1038 | default => 'y' |
1039 | ); |
1040 | |
1041 | return $bool; |
1042 | } |
1043 | |
622d31ac |
1044 | sub __ask_about_test_failure { |
1045 | my $mod = shift; |
1046 | my $captured = shift || ''; |
1047 | my $term = $Shell->term; |
1048 | |
5bc5f6dc |
1049 | $Shell->__print( "\n" ); |
1050 | $Shell->__print( |
1051 | loc( "The tests for '%1' failed. Would you like me to proceed ". |
1052 | "anyway or should we abort?", $mod->module ) ); |
1053 | $Shell->__print( "\n\n" ); |
622d31ac |
1054 | |
1055 | my $bool = $term->ask_yn( |
1056 | prompt => loc("Proceed anyway?"), |
1057 | default => 'n', |
1058 | ); |
1059 | |
1060 | return $bool; |
1061 | } |
6aaee015 |
1062 | |
1063 | |
1064 | sub _details { |
1065 | my $self = shift; |
1066 | my $cb = $self->backend; |
1067 | my $conf = $cb->configure_object; |
1068 | my %hash = @_; |
1069 | |
1070 | my $args; my $mods; my $opts; |
1071 | { local $Params::Check::ALLOW_UNKNOWN = 1; |
1072 | |
1073 | my $tmpl = { |
1074 | modules => { required => 1, store => \$mods }, |
1075 | options => { default => { }, store => \$opts }, |
1076 | }; |
1077 | |
1078 | $args = check( $tmpl, \%hash ) or return; |
1079 | } |
1080 | |
1081 | ### every module has about 10 lines of details |
1082 | ### maybe more later with Module::CPANTS etc |
1083 | $self->_pager_open if scalar @$mods * 10 > $self->_term_rowcount; |
1084 | |
1085 | |
4443dd53 |
1086 | my $format = "%-24s %-45s\n"; |
1087 | my $cformat = "%-24s %-45s %-10s\n"; |
6aaee015 |
1088 | for my $mod (@$mods) { |
1089 | my $href = $mod->details( %$opts ); |
1090 | my @list = sort { $a->module cmp $b->module } $mod->contains; |
1091 | |
1092 | unless( $href ) { |
5bc5f6dc |
1093 | $self->__print( |
1094 | loc("No details for %1 - it might be outdated.", |
1095 | $mod->module), "\n" ); |
6aaee015 |
1096 | next; |
1097 | |
1098 | } else { |
5bc5f6dc |
1099 | $self->__print( loc( "Details for '%1'\n", $mod->module ) ); |
6aaee015 |
1100 | for my $item ( sort keys %$href ) { |
5bc5f6dc |
1101 | $self->__printf( $format, $item, $href->{$item} ); |
6aaee015 |
1102 | } |
1103 | |
1104 | my $showed; |
1105 | for my $item ( @list ) { |
5bc5f6dc |
1106 | $self->__printf( |
4443dd53 |
1107 | $cformat, ($showed ? '' : 'Contains:'), |
1108 | $item->module, $item->version |
5bc5f6dc |
1109 | ); |
6aaee015 |
1110 | $showed++; |
1111 | } |
5bc5f6dc |
1112 | $self->__print( "\n" ); |
6aaee015 |
1113 | } |
1114 | } |
1115 | $self->_pager_close; |
5bc5f6dc |
1116 | $self->__print( "\n" ); |
6aaee015 |
1117 | |
1118 | return 1; |
1119 | } |
1120 | |
1121 | sub _print { |
1122 | my $self = shift; |
1123 | my %hash = @_; |
1124 | |
1125 | my $args; my $opts; my $file; |
1126 | { local $Params::Check::ALLOW_UNKNOWN = 1; |
1127 | |
1128 | my $tmpl = { |
1129 | options => { default => { }, store => \$opts }, |
1130 | input => { default => '', store => \$file }, |
1131 | }; |
1132 | |
1133 | $args = check( $tmpl, \%hash ) or return; |
1134 | } |
1135 | |
1136 | my $old; my $fh; |
1137 | if( $file ) { |
1138 | $fh = FileHandle->new( ">$file" ) |
1139 | or( warn loc("Could not open '%1': '%2'", $file, $!), |
1140 | return |
1141 | ); |
1142 | $old = select $fh; |
1143 | } |
1144 | |
1145 | |
1146 | $self->_pager_open if !$file; |
1147 | |
5bc5f6dc |
1148 | $self->__print( CPANPLUS::Error->stack_as_string ); |
6aaee015 |
1149 | |
1150 | $self->_pager_close; |
1151 | |
1152 | select $old if $old; |
5bc5f6dc |
1153 | $self->__print( "\n" ); |
6aaee015 |
1154 | |
1155 | return 1; |
1156 | } |
1157 | |
1158 | sub _set_conf { |
1159 | my $self = shift; |
1160 | my %hash = @_; |
1161 | my $cb = $self->backend; |
1162 | my $conf = $cb->configure_object; |
1163 | |
1164 | ### possible options |
1165 | ### XXX hard coded, not optimal :( |
622d31ac |
1166 | my %types = ( |
1167 | reconfigure => '', |
1168 | save => q([user | system | boxed]), |
1169 | edit => '', |
1170 | program => q([key => val]), |
1171 | conf => q([key => val]), |
1172 | mirrors => '', |
1173 | selfupdate => '', # XXX add all opts here? |
1174 | ); |
6aaee015 |
1175 | |
1176 | |
1177 | my $args; my $opts; my $input; |
1178 | { local $Params::Check::ALLOW_UNKNOWN = 1; |
1179 | |
1180 | my $tmpl = { |
1181 | options => { default => { }, store => \$opts }, |
1182 | input => { default => '', store => \$input }, |
1183 | }; |
1184 | |
1185 | $args = check( $tmpl, \%hash ) or return; |
1186 | } |
1187 | |
1188 | my ($type,$key,$value) = $input =~ m/(\w+)\s*(\w*)\s*(.*?)\s*$/; |
1189 | $type = lc $type; |
1190 | |
1191 | if( $type eq 'reconfigure' ) { |
1192 | my $setup = CPANPLUS::Configure::Setup->new( |
1193 | configure_object => $conf, |
1194 | term => $self->term, |
1195 | backend => $cb, |
1196 | ); |
1197 | return $setup->init; |
1198 | |
1199 | } elsif ( $type eq 'save' ) { |
1200 | my $where = { |
1201 | user => CONFIG_USER, |
1202 | system => CONFIG_SYSTEM, |
622d31ac |
1203 | boxed => CONFIG_BOXED, |
6aaee015 |
1204 | }->{ $key } || CONFIG_USER; |
1205 | |
4443dd53 |
1206 | ### boxed is special, so let's get its value from %INC |
622d31ac |
1207 | ### so we can tell it where to save |
1208 | ### XXX perhaps this logic should be generic for all |
1209 | ### types, and put in the ->save() routine |
1210 | my $dir; |
1211 | if( $where eq CONFIG_BOXED ) { |
1212 | my $file = join( '/', split( '::', CONFIG_BOXED ) ) . '.pm'; |
1213 | my $file_re = quotemeta($file); |
1214 | |
1215 | my $path = $INC{$file} || ''; |
1216 | $path =~ s/$file_re$//; |
1217 | $dir = $path; |
1218 | } |
1219 | |
1220 | my $rv = $cb->configure_object->save( $where => $dir ); |
6aaee015 |
1221 | |
5bc5f6dc |
1222 | $self->__print( |
1223 | $rv |
622d31ac |
1224 | ? loc("Configuration successfully saved to %1\n (%2)\n", |
1225 | $where, $rv) |
5bc5f6dc |
1226 | : loc("Failed to save configuration\n" ) |
1227 | ); |
6aaee015 |
1228 | return $rv; |
1229 | |
1230 | } elsif ( $type eq 'edit' ) { |
1231 | |
1232 | my $editor = $conf->get_program('editor') |
1233 | or( print(loc("No editor specified")), return ); |
1234 | |
1235 | my $where = { |
1236 | user => CONFIG_USER, |
1237 | system => CONFIG_SYSTEM, |
1238 | }->{ $key } || CONFIG_USER; |
4443dd53 |
1239 | |
6aaee015 |
1240 | my $file = $conf->_config_pm_to_file( $where ); |
1241 | system("$editor $file"); |
1242 | |
1243 | ### now reload it |
1244 | ### disable warnings for this |
1245 | { require Module::Loaded; |
4443dd53 |
1246 | Module::Loaded::mark_as_unloaded( $where ); |
6aaee015 |
1247 | |
1248 | ### reinitialize the config |
1249 | local $^W; |
1250 | $conf->init; |
1251 | } |
1252 | |
1253 | return 1; |
1254 | |
1255 | } elsif ( $type eq 'mirrors' ) { |
1256 | |
5bc5f6dc |
1257 | $self->__print( |
1258 | loc("Readonly list of mirrors (in order of preference):\n\n" ) ); |
6aaee015 |
1259 | |
1260 | my $i; |
1261 | for my $host ( @{$conf->get_conf('hosts')} ) { |
1262 | my $uri = $cb->_host_to_uri( %$host ); |
1263 | |
1264 | $i++; |
5bc5f6dc |
1265 | $self->__print( "\t[$i] $uri\n" ); |
6aaee015 |
1266 | } |
4443dd53 |
1267 | |
1268 | $self->__print( |
1269 | loc("\nTo edit this list, please type: '%1'\n", 's edit') ); |
6aaee015 |
1270 | |
1271 | } elsif ( $type eq 'selfupdate' ) { |
1272 | my %valid = map { $_ => $_ } |
622d31ac |
1273 | $cb->selfupdate_object->list_categories; |
6aaee015 |
1274 | |
1275 | unless( $valid{$key} ) { |
5bc5f6dc |
1276 | $self->__print( |
1277 | loc( "To update your current CPANPLUS installation, ". |
6aaee015 |
1278 | "choose one of the these options:\n%1", |
e3b7d412 |
1279 | ( join $/, map { |
622d31ac |
1280 | sprintf "\ts selfupdate %-17s " . |
1281 | "[--latest=0] [--dryrun]", $_ |
e3b7d412 |
1282 | } sort keys %valid ) |
5bc5f6dc |
1283 | ) |
1284 | ); |
6aaee015 |
1285 | } else { |
622d31ac |
1286 | my %update_args = ( |
1287 | update => $key, |
1288 | latest => 1, |
1289 | %$opts |
1290 | ); |
1291 | |
1292 | |
1293 | my %list = $cb->selfupdate_object |
1294 | ->list_modules_to_update( %update_args ); |
1295 | |
5bc5f6dc |
1296 | $self->__print(loc("The following updates will take place:"),$/.$/); |
622d31ac |
1297 | |
1298 | for my $feature ( sort keys %list ) { |
1299 | my $aref = $list{$feature}; |
1300 | |
1301 | ### is it a 'feature' or a built in? |
5bc5f6dc |
1302 | $self->__print( |
1303 | $valid{$feature} |
1304 | ? " " . ucfirst($feature) . ":\n" |
1305 | : " Modules for '$feature' support:\n" |
1306 | ); |
622d31ac |
1307 | |
1308 | ### show what modules would be installed |
5bc5f6dc |
1309 | $self->__print( |
1310 | scalar @$aref |
1311 | ? map { sprintf " %-42s %-6s -> %-6s \n", |
1312 | $_->name, $_->installed_version, $_->version |
1313 | } @$aref |
1314 | : " No upgrades required\n" |
1315 | ); |
1316 | $self->__print( $/ ); |
622d31ac |
1317 | } |
1318 | |
1319 | |
1320 | unless( $opts->{'dryrun'} ) { |
5bc5f6dc |
1321 | $self->__print( loc("Updating your CPANPLUS installation\n") ); |
622d31ac |
1322 | $cb->selfupdate_object->selfupdate( %update_args ); |
1323 | } |
6aaee015 |
1324 | } |
1325 | |
1326 | } else { |
1327 | |
1328 | if ( $type eq 'program' or $type eq 'conf' ) { |
1329 | |
1330 | my $format = { |
1331 | conf => '%-25s %s', |
1332 | program => '%-12s %s', |
1333 | }->{ $type }; |
1334 | |
1335 | unless( $key ) { |
1336 | my @list = grep { $_ ne 'hosts' } |
1337 | $conf->options( type => $type ); |
1338 | |
1339 | my $method = 'get_' . $type; |
1340 | |
1341 | local $Data::Dumper::Indent = 0; |
1342 | for my $name ( @list ) { |
1343 | my $val = $conf->$method($name) || ''; |
1344 | ($val) = ref($val) |
1345 | ? (Data::Dumper::Dumper($val) =~ /= (.*);$/) |
1346 | : "'$val'"; |
5bc5f6dc |
1347 | |
1348 | $self->__printf( " $format\n", $name, $val ); |
6aaee015 |
1349 | } |
1350 | |
4443dd53 |
1351 | } elsif ( $key eq 'hosts' or $key eq 'lib' ) { |
5bc5f6dc |
1352 | $self->__print( |
4443dd53 |
1353 | loc( "Setting %1 is not trivial.\n" . |
1354 | "It is suggested you use '%2' and edit the " . |
1355 | "configuration file manually", $key, 's edit') |
5bc5f6dc |
1356 | ); |
6aaee015 |
1357 | } else { |
1358 | my $method = 'set_' . $type; |
1359 | $conf->$method( $key => defined $value ? $value : '' ) |
5bc5f6dc |
1360 | and $self->__print( loc("Key '%1' was set to '%2'", $key, |
1361 | defined $value ? $value : 'EMPTY STRING') ); |
6aaee015 |
1362 | } |
1363 | |
1364 | } else { |
5bc5f6dc |
1365 | $self->__print( loc("Unknown type '%1'",$type || 'EMPTY' ) ); |
1366 | $self->__print( $/ ); |
1367 | $self->__print( loc("Try one of the following:") ); |
1368 | $self->__print( $/, join $/, |
622d31ac |
1369 | map { sprintf "\t%-11s %s", $_, $types{$_} } |
5bc5f6dc |
1370 | sort keys %types ); |
6aaee015 |
1371 | } |
1372 | } |
5bc5f6dc |
1373 | $self->__print( "\n" ); |
6aaee015 |
1374 | return 1; |
1375 | } |
1376 | |
1377 | sub _uptodate { |
1378 | my $self = shift; |
1379 | my %hash = @_; |
1380 | my $cb = $self->backend; |
1381 | my $conf = $cb->configure_object; |
1382 | |
1383 | my $opts; my $mods; |
1384 | { local $Params::Check::ALLOW_UNKNOWN = 1; |
1385 | |
1386 | my $tmpl = { |
1387 | options => { default => { }, store => \$opts }, |
1388 | modules => { required => 1, store => \$mods }, |
1389 | }; |
1390 | |
1391 | check( $tmpl, \%hash ) or return; |
1392 | } |
1393 | |
1394 | ### long listing? short is default ### |
1395 | my $long = $opts->{'long'} ? 1 : 0; |
1396 | |
1397 | my @list = scalar @$mods ? @$mods : @{$cb->_all_installed}; |
1398 | |
1399 | my @rv; my %seen; |
1400 | for my $mod (@list) { |
1401 | ### skip this mod if it's up to date ### |
1402 | next if $mod->is_uptodate; |
1403 | ### skip this mod if it's core ### |
1404 | next if $mod->package_is_perl_core; |
1405 | |
1406 | if( $long or !$seen{$mod->package}++ ) { |
1407 | push @rv, $mod; |
1408 | } |
1409 | } |
1410 | |
1411 | @rv = sort { $a->module cmp $b->module } @rv; |
1412 | |
1413 | $self->cache([undef,@rv]); |
1414 | |
1415 | $self->_pager_open if scalar @rv >= $self->_term_rowcount; |
1416 | |
1417 | my $format = "%5s %12s %12s %-36s %-10s\n"; |
1418 | |
1419 | my $i = 1; |
1420 | for my $mod ( @rv ) { |
5bc5f6dc |
1421 | $self->__printf( |
1422 | $format, |
1423 | $i, |
1424 | $self->_format_version($mod->installed_version) || 'Unparsable', |
1425 | $self->_format_version( $mod->version ), |
1426 | $mod->module, |
1427 | $mod->author->cpanid |
1428 | ); |
6aaee015 |
1429 | $i++; |
1430 | } |
1431 | $self->_pager_close; |
1432 | |
1433 | return 1; |
1434 | } |
1435 | |
1436 | sub _autobundle { |
1437 | my $self = shift; |
1438 | my %hash = @_; |
1439 | my $cb = $self->backend; |
1440 | my $conf = $cb->configure_object; |
1441 | |
1442 | my $opts; my $input; |
1443 | { local $Params::Check::ALLOW_UNKNOWN = 1; |
1444 | |
1445 | my $tmpl = { |
1446 | options => { default => { }, store => \$opts }, |
1447 | input => { default => '', store => \$input }, |
1448 | }; |
1449 | |
1450 | check( $tmpl, \%hash ) or return; |
1451 | } |
1452 | |
1453 | $opts->{'path'} = $input if $input; |
1454 | |
1455 | my $where = $cb->autobundle( %$opts ); |
1456 | |
5bc5f6dc |
1457 | $self->__print( |
1458 | $where |
6aaee015 |
1459 | ? loc("Wrote autobundle to '%1'", $where) |
5bc5f6dc |
1460 | : loc("Could not create autobundle" ) |
1461 | ); |
1462 | $self->__print( "\n" ); |
6aaee015 |
1463 | |
1464 | return $where ? 1 : 0; |
1465 | } |
1466 | |
1467 | sub _uninstall { |
1468 | my $self = shift; |
1469 | my %hash = @_; |
1470 | my $cb = $self->backend; |
1471 | my $term = $self->term; |
1472 | my $conf = $cb->configure_object; |
1473 | |
1474 | my $opts; my $mods; |
1475 | { local $Params::Check::ALLOW_UNKNOWN = 1; |
1476 | |
1477 | my $tmpl = { |
1478 | options => { default => { }, store => \$opts }, |
1479 | modules => { default => [], store => \$mods }, |
1480 | }; |
1481 | |
1482 | check( $tmpl, \%hash ) or return; |
1483 | } |
1484 | |
1485 | my $force = $opts->{'force'} || $conf->get_conf('force'); |
1486 | |
1487 | unless( $force ) { |
1488 | my $list = join "\n", map { ' ' . $_->module } @$mods; |
1489 | |
5bc5f6dc |
1490 | $self->__print( loc(" |
6aaee015 |
1491 | This will uninstall the following modules: |
1492 | %1 |
1493 | |
1494 | Note that if you installed them via a package manager, you probably |
1495 | should use the same package manager to uninstall them |
1496 | |
5bc5f6dc |
1497 | ", $list) ); |
6aaee015 |
1498 | |
1499 | return unless $term->ask_yn( |
1500 | prompt => loc("Are you sure you want to continue?"), |
1501 | default => 'n', |
1502 | ); |
1503 | } |
1504 | |
1505 | ### first loop over all the modules to uninstall them ### |
1506 | for my $mod (@$mods) { |
5bc5f6dc |
1507 | $self->__print( loc("Uninstalling '%1'", $mod->module), "\n" ); |
6aaee015 |
1508 | |
1509 | $mod->uninstall( %$opts ); |
1510 | } |
1511 | |
1512 | my $flag; |
1513 | ### then report whether all this went ok or not ### |
1514 | for my $mod (@$mods) { |
1515 | if( $mod->status->uninstall ) { |
5bc5f6dc |
1516 | $self->__print( |
1517 | loc("Module '%1' %tense(uninstall,past) successfully\n", |
1518 | $mod->module ) ); |
6aaee015 |
1519 | } else { |
1520 | $flag++; |
5bc5f6dc |
1521 | $self->__print( |
1522 | loc("Error %tense(uninstall,present) '%1'\n", $mod->module) ); |
6aaee015 |
1523 | } |
1524 | } |
1525 | |
1526 | if( !$flag ) { |
5bc5f6dc |
1527 | $self->__print( |
1528 | loc("All modules %tense(uninstall,past) successfully"), "\n" ); |
6aaee015 |
1529 | } else { |
5bc5f6dc |
1530 | $self->__print( |
1531 | loc("Problem %tense(uninstalling,present) one or more modules" ), |
1532 | "\n" ); |
1533 | |
1534 | $self->__print( |
1535 | loc("*** You can view the complete error buffer by pressing '%1'". |
1536 | "***\n", 'p') ) unless $conf->get_conf('verbose'); |
6aaee015 |
1537 | } |
5bc5f6dc |
1538 | $self->__print( "\n" ); |
6aaee015 |
1539 | |
1540 | return !$flag; |
1541 | } |
1542 | |
1543 | sub _reports { |
1544 | my $self = shift; |
1545 | my %hash = @_; |
1546 | my $cb = $self->backend; |
1547 | my $term = $self->term; |
1548 | my $conf = $cb->configure_object; |
1549 | |
1550 | my $opts; my $mods; |
1551 | { local $Params::Check::ALLOW_UNKNOWN = 1; |
1552 | |
1553 | my $tmpl = { |
1554 | options => { default => { }, store => \$opts }, |
1555 | modules => { default => '', store => \$mods }, |
1556 | }; |
1557 | |
1558 | check( $tmpl, \%hash ) or return; |
1559 | } |
1560 | |
1561 | ### XXX might need to be conditional ### |
1562 | $self->_pager_open; |
1563 | |
1564 | for my $mod (@$mods) { |
1565 | my @list = $mod->fetch_report( %$opts ) |
1566 | or( print(loc("No reports available for this distribution.")), |
1567 | next |
1568 | ); |
1569 | |
1570 | @list = reverse |
1571 | map { $_->[0] } |
1572 | sort { $a->[1] cmp $b->[1] } |
1573 | map { [$_, $_->{'dist'}.':'.$_->{'platform'}] } @list; |
1574 | |
1575 | |
1576 | |
1577 | ### XXX this may need to be sorted better somehow ### |
1578 | my $url; |
1579 | my $format = "%8s %s %s\n"; |
1580 | |
1581 | my %seen; |
1582 | for my $href (@list ) { |
5bc5f6dc |
1583 | $self->__print( |
1584 | "[" . $mod->author->cpanid .'/'. $href->{'dist'} . "]\n" |
1585 | ) unless $seen{ $href->{'dist'} }++; |
1586 | |
1587 | $self->__printf( |
1588 | $format, |
1589 | $href->{'grade'}, |
1590 | $href->{'platform'}, |
1591 | ($href->{'details'} ? '(*)' : '') |
1592 | ); |
6aaee015 |
1593 | |
1594 | $url ||= $href->{'details'}; |
1595 | } |
1596 | |
5bc5f6dc |
1597 | $self->__print( "\n==> $url\n" ) if $url; |
1598 | $self->__print( "\n" ); |
6aaee015 |
1599 | } |
1600 | $self->_pager_close; |
1601 | |
1602 | return 1; |
1603 | } |
1604 | |
1605 | |
1606 | ### Load plugins |
1607 | { my @PluginModules; |
1608 | my %Dispatch = ( |
1609 | showtip => [ __PACKAGE__, '_show_random_tip'], |
1610 | plugins => [ __PACKAGE__, '_list_plugins' ], |
1611 | '?' => [ __PACKAGE__, '_plugins_usage' ], |
1612 | ); |
1613 | |
1614 | sub plugin_modules { return @PluginModules } |
1615 | sub plugin_table { return %Dispatch } |
1616 | |
5bc5f6dc |
1617 | my $init_done; |
1618 | sub _plugins_init { |
1619 | ### only initialize once |
1620 | return if $init_done++; |
1621 | |
1622 | ### find all plugins first |
1623 | if( check_install( module => 'Module::Pluggable', version => '2.4') ) { |
1624 | require Module::Pluggable; |
6aaee015 |
1625 | |
5bc5f6dc |
1626 | my $only_re = __PACKAGE__ . '::Plugins::\w+$'; |
6aaee015 |
1627 | |
5bc5f6dc |
1628 | Module::Pluggable->import( |
1629 | sub_name => '_plugins', |
1630 | search_path => __PACKAGE__, |
1631 | only => qr/$only_re/, |
1632 | #except => [ INSTALLER_MM, INSTALLER_SAMPLE ] |
1633 | ); |
1634 | |
1635 | push @PluginModules, __PACKAGE__->_plugins; |
1636 | } |
1637 | |
1638 | ### now try to load them |
1639 | for my $p ( __PACKAGE__->plugin_modules ) { |
1640 | my %map = eval { load $p; $p->import; $p->plugins }; |
1641 | error(loc("Could not load plugin '$p': $@")), next if $@; |
1642 | |
1643 | ### register each plugin |
1644 | while( my($name, $func) = each %map ) { |
1645 | |
1646 | if( not length $name or not length $func ) { |
1647 | error(loc("Empty plugin name or dispatch function detected")); |
1648 | next; |
1649 | } |
1650 | |
1651 | if( exists( $Dispatch{$name} ) ) { |
1652 | error(loc("'%1' is already registered by '%2'", |
1653 | $name, $Dispatch{$name}->[0])); |
1654 | next; |
1655 | } |
1656 | |
1657 | ### register name, package and function |
1658 | $Dispatch{$name} = [ $p, $func ]; |
1659 | } |
6aaee015 |
1660 | } |
1661 | } |
5bc5f6dc |
1662 | |
4443dd53 |
1663 | ### dispatch a plugin command to its function |
6aaee015 |
1664 | sub _meta { |
1665 | my $self = shift; |
1666 | my %hash = @_; |
1667 | my $cb = $self->backend; |
1668 | my $term = $self->term; |
1669 | my $conf = $cb->configure_object; |
1670 | |
1671 | my $opts; my $input; |
1672 | { local $Params::Check::ALLOW_UNKNOWN = 1; |
1673 | |
1674 | my $tmpl = { |
1675 | options => { default => { }, store => \$opts }, |
1676 | input => { default => '', store => \$input }, |
1677 | }; |
1678 | |
1679 | check( $tmpl, \%hash ) or return; |
1680 | } |
1681 | |
1682 | $input =~ s/\s*(\S+)\s*//; |
1683 | my $cmd = $1; |
1684 | |
1685 | ### look up the command, or go to the default |
1686 | my $aref = $Dispatch{ $cmd } || [ __PACKAGE__, '_plugin_default' ]; |
1687 | |
1688 | my($pkg,$func) = @$aref; |
1689 | |
1690 | my $rv = eval { $pkg->$func( $self, $cb, $cmd, $input, $opts ) }; |
1691 | |
1692 | error( $@ ) if $@; |
1693 | |
1694 | ### return $rv instead, so input loop can be terminated? |
1695 | return 1; |
1696 | } |
1697 | |
1698 | sub _plugin_default { error(loc("No such plugin command")) } |
1699 | } |
1700 | |
1701 | ### plugin commands |
5bc5f6dc |
1702 | { my $help_format = " /%-21s # %s\n"; |
6aaee015 |
1703 | |
1704 | sub _list_plugins { |
5bc5f6dc |
1705 | my $self = shift; |
1706 | |
1707 | $self->__print( loc("Available plugins:\n") ); |
1708 | $self->__print( loc(" List usage by using: /? PLUGIN_NAME\n" ) ); |
1709 | $self->__print( $/ ); |
6aaee015 |
1710 | |
1711 | my %table = __PACKAGE__->plugin_table; |
1712 | for my $name( sort keys %table ) { |
1713 | my $pkg = $table{$name}->[0]; |
1714 | my $this = __PACKAGE__; |
1715 | |
1716 | my $who = $pkg eq $this |
1717 | ? "Standard Plugin" |
4443dd53 |
1718 | : do { my $v = $self->_format_version($pkg->VERSION) || ''; |
1719 | $pkg =~ s/^$this/../; |
1720 | sprintf "Provided by: %-30s %-10s", $pkg, $v; |
1721 | }; |
6aaee015 |
1722 | |
5bc5f6dc |
1723 | $self->__printf( $help_format, $name, $who ); |
6aaee015 |
1724 | } |
1725 | |
5bc5f6dc |
1726 | $self->__print( $/.$/ ); |
6aaee015 |
1727 | |
5bc5f6dc |
1728 | $self->__print( |
1729 | " Write your own plugins? Read the documentation of:\n" . |
1730 | " CPANPLUS::Shell::Default::Plugins::HOWTO\n" ); |
6aaee015 |
1731 | |
5bc5f6dc |
1732 | $self->__print( $/ ); |
6aaee015 |
1733 | } |
1734 | |
1735 | sub _list_plugins_help { |
1736 | return sprintf $help_format, 'plugins', loc("lists available plugins"); |
1737 | } |
1738 | |
1739 | ### registered as a plugin too |
1740 | sub _show_random_tip_help { |
1741 | return sprintf $help_format, 'showtip', loc("show usage tips" ); |
1742 | } |
1743 | |
1744 | sub _plugins_usage { |
5bc5f6dc |
1745 | my $self = shift; |
6aaee015 |
1746 | my $shell = shift; |
1747 | my $cb = shift; |
1748 | my $cmd = shift; |
1749 | my $input = shift; |
5bc5f6dc |
1750 | my %table = $self->plugin_table; |
6aaee015 |
1751 | |
1752 | my @list = length $input ? split /\s+/, $input : sort keys %table; |
1753 | |
1754 | for my $name( @list ) { |
1755 | |
1756 | ### no such plugin? skip |
1757 | error(loc("No such plugin '$name'")), next unless $table{$name}; |
1758 | |
1759 | my $pkg = $table{$name}->[0]; |
1760 | my $func = $table{$name}->[1] . '_help'; |
1761 | |
1762 | if ( my $sub = $pkg->can( $func ) ) { |
5bc5f6dc |
1763 | eval { $self->__print( $sub->() ) }; |
6aaee015 |
1764 | error( $@ ) if $@; |
1765 | |
1766 | } else { |
5bc5f6dc |
1767 | $self->__print(" No usage for '$name' -- try perldoc $pkg"); |
6aaee015 |
1768 | } |
1769 | |
5bc5f6dc |
1770 | $self->__print( $/ ); |
6aaee015 |
1771 | } |
1772 | |
5bc5f6dc |
1773 | $self->__print( $/.$/ ); |
6aaee015 |
1774 | } |
1775 | |
1776 | sub _plugins_usage_help { |
1777 | return sprintf $help_format, '? [NAME ...]', |
1778 | loc("show usage for plugins"); |
1779 | } |
1780 | } |
1781 | |
1782 | ### send a command to a remote host, retrieve the answer; |
1783 | sub __send_remote_command { |
1784 | my $self = shift; |
1785 | my $cmd = shift; |
1786 | my $remote = $self->remote or return; |
1787 | my $user = $remote->{'username'}; |
1788 | my $pass = $remote->{'password'}; |
1789 | my $conn = $remote->{'connection'}; |
1790 | my $end = "\015\012"; |
1791 | my $answer; |
1792 | |
1793 | my $send = join "\0", $user, $pass, $cmd; |
1794 | |
1795 | print $conn $send . $end; |
1796 | |
1797 | ### XXX why doesn't something like this just work? |
1798 | #1 while recv($conn, $answer, 1024, 0); |
1799 | while(1) { |
1800 | my $buff; |
1801 | $conn->recv( $buff, 1024, 0 ); |
1802 | $answer .= $buff; |
1803 | last if $buff =~ /$end$/; |
1804 | } |
1805 | |
1806 | my($status,$buffer) = split "\0", $answer; |
1807 | |
1808 | return ($status, $buffer); |
1809 | } |
1810 | |
1811 | |
1812 | sub _read_configuration_from_rc { |
5bc5f6dc |
1813 | my $self = shift; |
6aaee015 |
1814 | my $rc_file = shift; |
1815 | |
1816 | my $href; |
1817 | if( can_load( modules => { 'Config::Auto' => '0.0' } ) ) { |
1818 | $Config::Auto::DisablePerl = 1; |
1819 | |
1820 | eval { $href = Config::Auto::parse( $rc_file, format => 'space' ) }; |
1821 | |
5bc5f6dc |
1822 | $self->__print( |
1823 | loc( "Unable to read in config file '%1': %2", $rc_file, $@ ) |
1824 | ) if $@; |
6aaee015 |
1825 | } |
1826 | |
1827 | return $href || {}; |
1828 | } |
1829 | |
1830 | { my @tips = ( |
1831 | loc( "You can update CPANPLUS by running: '%1'", 's selfupdate' ), |
1832 | loc( "You can install modules by URL using '%1'", 'i URL' ), |
1833 | loc( "You can turn off these tips using '%1'", |
1834 | 's conf show_startup_tip 0' ), |
1835 | loc( "You can use wildcards like '%1' and '%2' on search results", |
622d31ac |
1836 | '*', '2..5' ) , |
6aaee015 |
1837 | loc( "You can use plugins. Type '%1' to list available plugins", |
1838 | '/plugins' ), |
1839 | loc( "You can show all your out of date modules using '%1'", 'o' ), |
502c7995 |
1840 | loc( "Many operations take options, like '%1', '%2' or '%3'", |
1841 | '--verbose', '--force', '--skiptest' ), |
6aaee015 |
1842 | loc( "The documentation in %1 and %2 is very useful", |
1843 | "CPANPLUS::Module", "CPANPLUS::Backend" ), |
1844 | loc( "You can type '%1' for help and '%2' to exit", 'h', 'q' ), |
5bc5f6dc |
1845 | loc( "You can run an interactive setup using '%1'", 's reconfigure' ), |
1846 | loc( "You can add custom sources to your index. See '%1' for details", |
1847 | '/cs --help' ), |
4443dd53 |
1848 | loc( "CPANPLUS now has an experimental SQLite backend. You can enable ". |
1849 | "it via: '%1'. Update dependencies via '%2'", |
1850 | 's conf source_engine CPANPLUS::Internals::Source::SQLite; s save', |
1851 | 's selfupdate enabled_features ' ), |
6aaee015 |
1852 | ); |
1853 | |
1854 | sub _show_random_tip { |
1855 | my $self = shift; |
5bc5f6dc |
1856 | $self->__print( $/, "Did you know...\n ", |
1857 | $tips[ int rand scalar @tips ], $/ ); |
6aaee015 |
1858 | return 1; |
1859 | } |
1860 | } |
1861 | |
1862 | 1; |
1863 | |
1864 | __END__ |
1865 | |
1866 | =pod |
1867 | |
1868 | =head1 BUG REPORTS |
1869 | |
1870 | Please report bugs or other issues to E<lt>bug-cpanplus@rt.cpan.org<gt>. |
1871 | |
1872 | =head1 AUTHOR |
1873 | |
1874 | This module by Jos Boumans E<lt>kane@cpan.orgE<gt>. |
1875 | |
1876 | =head1 COPYRIGHT |
1877 | |
1878 | The CPAN++ interface (of which this module is a part of) is copyright (c) |
1879 | 2001 - 2007, Jos Boumans E<lt>kane@cpan.orgE<gt>. All rights reserved. |
1880 | |
1881 | This library is free software; you may redistribute and/or modify it |
1882 | under the same terms as Perl itself. |
1883 | |
1884 | =head1 SEE ALSO |
1885 | |
1886 | L<CPANPLUS::Shell::Classic>, L<CPANPLUS::Shell>, L<cpanp> |
1887 | |
1888 | =cut |
1889 | |
1890 | # Local variables: |
1891 | # c-indentation-style: bsd |
1892 | # c-basic-offset: 4 |
1893 | # indent-tabs-mode: nil |
1894 | # End: |
1895 | # vim: expandtab shiftwidth=4: |
1896 | |
1897 | __END__ |
1898 | |
1899 | TODO: |
1900 | e => "_expand_inc", # scratch it, imho -- not used enough |
1901 | |
1902 | ### free letters: g j k n y ### |