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