Commit | Line | Data |
3fea05b9 |
1 | #!/usr/bin/perl |
2 | |
3 | eval 'exec /usr/bin/perl -S $0 ${1+"$@"}' |
4 | if 0; # not running under some shell |
5 | # $Id: cpan,v 1.9 2006/11/01 21:49:31 comdog Exp $ |
6 | use strict; |
7 | |
8 | =head1 NAME |
9 | |
10 | cpan - easily interact with CPAN from the command line |
11 | |
12 | =head1 SYNOPSIS |
13 | |
14 | # with arguments and no switches, installs specified modules |
15 | cpan module_name [ module_name ... ] |
16 | |
17 | # with switches, installs modules with extra behavior |
18 | cpan [-cfimt] module_name [ module_name ... ] |
19 | |
20 | # without arguments, starts CPAN.pm shell |
21 | cpan |
22 | |
23 | # without arguments, but some switches |
24 | cpan [-ahrvACDLO] |
25 | |
26 | =head1 DESCRIPTION |
27 | |
28 | This script provides a command interface (not a shell) to CPAN. At the |
29 | moment it uses CPAN.pm to do the work, but it is not a one-shot command |
30 | runner for CPAN.pm. |
31 | |
32 | =head2 Meta Options |
33 | |
34 | These options are mutually exclusive, and the script processes them in |
35 | this order: [hvCAar]. Once the script finds one, it ignores the others, |
36 | and then exits after it finishes the task. The script ignores any other |
37 | command line options. |
38 | |
39 | =over 4 |
40 | |
41 | =item -a |
42 | |
43 | Creates the CPAN.pm autobundle with CPAN::Shell->autobundle. |
44 | |
45 | =item -A module [ module ... ] |
46 | |
47 | Shows the primary maintainers for the specified modules |
48 | |
49 | =item -C module [ module ... ] |
50 | |
51 | Show the C<Changes> files for the specified modules |
52 | |
53 | =item -D module [ module ... ] |
54 | |
55 | Show the module details. This prints one line for each out-of-date module |
56 | (meaning, modules locally installed but have newer versions on CPAN). |
57 | Each line has three columns: module name, local version, and CPAN |
58 | version. |
59 | |
60 | =item -L author [ author ... ] |
61 | |
62 | List the modules by the specified authors. |
63 | |
64 | =item -h |
65 | |
66 | Prints a help message. |
67 | |
68 | =item -O |
69 | |
70 | Show the out-of-date modules. |
71 | |
72 | =item -r |
73 | |
74 | Recompiles dynamically loaded modules with CPAN::Shell->recompile. |
75 | |
76 | =item -v |
77 | |
78 | Print the script version and CPAN.pm version. |
79 | |
80 | =back |
81 | |
82 | =head2 Module options |
83 | |
84 | These options are mutually exclusive, and the script processes them in |
85 | alphabetical order. It only processes the first one it finds. |
86 | |
87 | =over 4 |
88 | |
89 | =item c |
90 | |
91 | Runs a `make clean` in the specified module's directories. |
92 | |
93 | =item f |
94 | |
95 | Forces the specified action, when it normally would have failed. |
96 | |
97 | =item i |
98 | |
99 | Installed the specified modules. |
100 | |
101 | =item m |
102 | |
103 | Makes the specified modules. |
104 | |
105 | =item t |
106 | |
107 | Runs a `make test` on the specified modules. |
108 | |
109 | =back |
110 | |
111 | =head2 Examples |
112 | |
113 | # print a help message |
114 | cpan -h |
115 | |
116 | # print the version numbers |
117 | cpan -v |
118 | |
119 | # create an autobundle |
120 | cpan -a |
121 | |
122 | # recompile modules |
123 | cpan -r |
124 | |
125 | # install modules ( sole -i is optional ) |
126 | cpan -i Netscape::Booksmarks Business::ISBN |
127 | |
128 | # force install modules ( must use -i ) |
129 | cpan -fi CGI::Minimal URI |
130 | |
131 | =head1 TO DO |
132 | |
133 | |
134 | =head1 BUGS |
135 | |
136 | * none noted |
137 | |
138 | =head1 SEE ALSO |
139 | |
140 | Most behaviour, including environment variables and configuration, |
141 | comes directly from CPAN.pm. |
142 | |
143 | =head1 SOURCE AVAILABILITY |
144 | |
145 | This source is part of a SourceForge project which always has the |
146 | latest sources in CVS, as well as all of the previous releases. |
147 | |
148 | http://sourceforge.net/projects/brian-d-foy/ |
149 | |
150 | If, for some reason, I disappear from the world, one of the other |
151 | members of the project can shepherd this module appropriately. |
152 | |
153 | =head1 CREDITS |
154 | |
155 | Japheth Cleaver added the bits to allow a forced install (-f). |
156 | |
157 | Jim Brandt suggest and provided the initial implementation for the |
158 | up-to-date and Changes features. |
159 | |
160 | Adam Kennedy pointed out that exit() causes problems on Windows |
161 | where this script ends up with a .bat extension |
162 | |
163 | =head1 AUTHOR |
164 | |
165 | brian d foy, C<< <bdfoy@cpan.org> >> |
166 | |
167 | =head1 COPYRIGHT |
168 | |
169 | Copyright (c) 2001-2006, brian d foy, All Rights Reserved. |
170 | |
171 | You may redistribute this under the same terms as Perl itself. |
172 | |
173 | =cut |
174 | |
175 | use CPAN (); |
176 | use Getopt::Std; |
177 | |
178 | my $VERSION = |
179 | sprintf "%d.%d", q$Revision: 1.9 $ =~ m/ (\d+) \. (\d+) /xg; |
180 | |
181 | if( $ARGV[0] eq 'install' ) |
182 | { |
183 | my @args = @ARGV; |
184 | shift @args; |
185 | |
186 | die <<"HERE"; |
187 | It looks like you specified 'install' as an argument to cpan(1). This |
188 | script is not the CPAN.pm prompt and doesn't understand the same commands. |
189 | In fact, doesn't require the extra typing. You probably just want to |
190 | list the modules you want to install: |
191 | |
192 | cpan @args |
193 | |
194 | See the documentation for more details on using this script. |
195 | HERE |
196 | } |
197 | |
198 | if( 0 == @ARGV ) { CPAN::shell(); exit 0 } |
199 | |
200 | # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # |
201 | # set up the order of options that we layer over CPAN::Shell |
202 | my @META_OPTIONS = qw( h v C A D O L a r ); |
203 | |
204 | # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # |
205 | # map switches to method names in CPAN::Shell |
206 | my $Default = 'default'; |
207 | |
208 | my %CPAN_METHODS = ( |
209 | $Default => 'install', |
210 | 'c' => 'clean', |
211 | 'f' => 'force', |
212 | 'i' => 'install', |
213 | 'm' => 'make', |
214 | 't' => 'test', |
215 | ); |
216 | my @CPAN_OPTIONS = grep { $_ ne $Default } sort keys %CPAN_METHODS; |
217 | |
218 | # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # |
219 | # map switches to the subroutines in this script, along with other information. |
220 | # use this stuff instead of hard-coded indices and values |
221 | my %Method_table = ( |
222 | # key => [ sub ref, takes args?, exit value, description ] |
223 | h => [ \&_print_help, 0, 0, 'Printing help' ], |
224 | v => [ \&_print_version, 0, 0, 'Printing version' ], |
225 | C => [ \&_show_Changes, 1, 0, 'Showing Changes file' ], |
226 | A => [ \&_show_Author, 1, 0, 'Showing Author' ], |
227 | D => [ \&_show_Details, 1, 0, 'Showing Details' ], |
228 | O => [ \&_show_out_of_date, 0, 0, 'Showing Out of date' ], |
229 | L => [ \&_show_author_mods, 1, 0, 'Showing author mods' ], |
230 | a => [ \&_create_autobundle, 0, 0, 'Creating autobundle' ], |
231 | r => [ \&_recompile, 0, 0, 'Recompiling' ], |
232 | |
233 | c => [ \&_default, 1, 0, 'Running `make clean`' ], |
234 | f => [ \&_default, 1, 0, 'Installing with force' ], |
235 | i => [ \&_default, 1, 0, 'Running `make install`' ], |
236 | 'm' => [ \&_default, 1, 0, 'Running `make`' ], |
237 | t => [ \&_default, 1, 0, 'Running `make test`' ], |
238 | |
239 | ); |
240 | |
241 | my %Method_table_index = ( |
242 | code => 0, |
243 | takes_args => 1, |
244 | exit_value => 2, |
245 | description => 3, |
246 | ); |
247 | |
248 | # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # |
249 | # finally, do some argument processing |
250 | my @option_order = ( @META_OPTIONS, @CPAN_OPTIONS ); |
251 | |
252 | my %options; |
253 | Getopt::Std::getopts( |
254 | join( '', @option_order ), \%options ); |
255 | |
256 | my $option_count = grep { $options{$_} } @option_order; |
257 | $option_count -= $options{'f'}; # don't count force |
258 | |
259 | # if there are no options, set -i (this line fixes RT ticket 16915) |
260 | $options{i}++ unless $option_count; |
261 | |
262 | # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # |
263 | # try each of the possible switches until we find one to handle |
264 | # print an error message if there are too many switches |
265 | # print an error message if there are arguments when there shouldn't be any |
266 | foreach my $option ( @option_order ) |
267 | { |
268 | next unless $options{$option}; |
269 | die unless |
270 | ref $Method_table{$option}[ $Method_table_index{code} ] eq ref sub {}; |
271 | |
272 | print "$Method_table{$option}[ $Method_table_index{description} ] " . |
273 | "-- ignoring other opitions\n" if $option_count > 1; |
274 | print "$Method_table{$option}[ $Method_table_index{description} ] " . |
275 | "-- ignoring other arguments\n" |
276 | if( @ARGV && ! $Method_table{$option}[ $Method_table_index{takes_args} ] ); |
277 | |
278 | $Method_table{$option}[ $Method_table_index{code} ]->( \@ARGV ); |
279 | |
280 | last; |
281 | } |
282 | |
283 | # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # |
284 | # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # |
285 | # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # |
286 | |
287 | sub _default |
288 | { |
289 | my $args = shift; |
290 | |
291 | my $switch = ''; |
292 | |
293 | # choose the option that we're going to use |
294 | # we'll deal with 'f' (force) later, so skip it |
295 | foreach my $option ( @CPAN_OPTIONS ) |
296 | { |
297 | next if $option eq 'f'; |
298 | next unless $options{$option}; |
299 | $switch = $option; |
300 | last; |
301 | } |
302 | |
303 | # 1. with no switches, but arguments, use the default switch (install) |
304 | # 2. with no switches and no args, start the shell |
305 | # 3. With a switch but no args, die! These switches need arguments. |
306 | if( not $switch and @$args ) { $switch = $Default; } |
307 | elsif( not $switch and not @$args ) { CPAN::shell(); return } |
308 | elsif( $switch and not @$args ) |
309 | { die "Nothing to $CPAN_METHODS{$switch}!\n"; } |
310 | |
311 | # Get and cheeck the method from CPAN::Shell |
312 | my $method = $CPAN_METHODS{$switch}; |
313 | die "CPAN.pm cannot $method!\n" unless CPAN::Shell->can( $method ); |
314 | |
315 | # call the CPAN::Shell method, with force if specified |
316 | foreach my $arg ( @$args ) |
317 | { |
318 | if( $options{f} ) { CPAN::Shell->force( $method, $arg ) } |
319 | else { CPAN::Shell->$method( $arg ) } |
320 | } |
321 | } |
322 | |
323 | # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # |
324 | sub _print_help |
325 | { |
326 | print STDERR "Use perldoc to read the documentation\n"; |
327 | exec "perldoc $0"; |
328 | } |
329 | |
330 | sub _print_version |
331 | { |
332 | print STDERR "$0 script version $VERSION, CPAN.pm version " . |
333 | CPAN->VERSION . "\n"; |
334 | } |
335 | |
336 | sub _create_autobundle |
337 | { |
338 | print "Creating autobundle in ", $CPAN::Config->{cpan_home}, |
339 | "/Bundle\n"; |
340 | |
341 | CPAN::Shell->autobundle; |
342 | } |
343 | |
344 | sub _recompiling |
345 | { |
346 | print "Recompiling dynamically-loaded extensions\n"; |
347 | |
348 | CPAN::Shell->recompile; |
349 | } |
350 | |
351 | sub _show_Changes |
352 | { |
353 | my $args = shift; |
354 | |
355 | foreach my $arg ( @$args ) |
356 | { |
357 | print "Checking $arg\n"; |
358 | my $module = CPAN::Shell->expand( "Module", $arg ); |
359 | |
360 | next unless $module->inst_file; |
361 | #next if $module->uptodate; |
362 | |
363 | ( my $id = $module->id() ) =~ s/::/\-/; |
364 | |
365 | my $url = "http://search.cpan.org/~" . lc( $module->userid ) . "/" . |
366 | $id . "-" . $module->cpan_version() . "/"; |
367 | |
368 | #print "URL: $url\n"; |
369 | _get_changes_file($url); |
370 | } |
371 | } |
372 | |
373 | sub _get_changes_file |
374 | { |
375 | die "Reading Changes files requires LWP::Simple and URI\n" |
376 | unless eval { require LWP::Simple; require URI; }; |
377 | |
378 | my $url = shift; |
379 | |
380 | my $content = LWP::Simple::get( $url ); |
381 | print "Got $url ...\n" if defined $content; |
382 | #print $content; |
383 | |
384 | my( $change_link ) = $content =~ m|<a href="(.*?)">Changes</a>|gi; |
385 | |
386 | my $changes_url = URI->new_abs( $change_link, $url ); |
387 | #print "change link is: $changes_url\n"; |
388 | my $changes = LWP::Simple::get( $changes_url ); |
389 | #print "change text is: " . $change_link->text() . "\n"; |
390 | print $changes; |
391 | } |
392 | |
393 | sub _show_Author |
394 | { |
395 | my $args = shift; |
396 | |
397 | foreach my $arg ( @$args ) |
398 | { |
399 | my $module = CPAN::Shell->expand( "Module", $arg ); |
400 | my $author = CPAN::Shell->expand( "Author", $module->userid ); |
401 | |
402 | next unless $module->userid; |
403 | |
404 | printf "%-25s %-8s %-25s %s\n", |
405 | $arg, $module->userid, $author->email, $author->fullname; |
406 | } |
407 | } |
408 | |
409 | sub _show_Details |
410 | { |
411 | my $args = shift; |
412 | |
413 | foreach my $arg ( @$args ) |
414 | { |
415 | my $module = CPAN::Shell->expand( "Module", $arg ); |
416 | my $author = CPAN::Shell->expand( "Author", $module->userid ); |
417 | |
418 | next unless $module->userid; |
419 | |
420 | print "$arg\n", "-" x 73, "\n\t"; |
421 | print join "\n\t", |
422 | $module->description ? $module->description : "(no description)", |
423 | $module->cpan_file, |
424 | $module->inst_file, |
425 | 'Installed: ' . $module->inst_version, |
426 | 'CPAN: ' . $module->cpan_version . ' ' . |
427 | ($module->uptodate ? "" : "Not ") . "up to date", |
428 | $author->fullname . " (" . $module->userid . ")", |
429 | $author->email; |
430 | print "\n\n"; |
431 | |
432 | } |
433 | } |
434 | |
435 | sub _show_out_of_date |
436 | { |
437 | my @modules = CPAN::Shell->expand( "Module", "/./" ); |
438 | |
439 | printf "%-40s %6s %6s\n", "Module Name", "Local", "CPAN"; |
440 | print "-" x 73, "\n"; |
441 | |
442 | foreach my $module ( @modules ) |
443 | { |
444 | next unless $module->inst_file; |
445 | next if $module->uptodate; |
446 | printf "%-40s %.4f %.4f\n", |
447 | $module->id, |
448 | $module->inst_version ? $module->inst_version : '', |
449 | $module->cpan_version; |
450 | } |
451 | |
452 | } |
453 | |
454 | sub _show_author_mods |
455 | { |
456 | my $args = shift; |
457 | |
458 | my %hash = map { lc $_, 1 } @$args; |
459 | |
460 | my @modules = CPAN::Shell->expand( "Module", "/./" ); |
461 | |
462 | foreach my $module ( @modules ) |
463 | { |
464 | next unless exists $hash{ lc $module->userid }; |
465 | print $module->id, "\n"; |
466 | } |
467 | |
468 | } |
469 | |
470 | 1; |