2 # $Id: cpan,v 1.7 2006/01/11 06:22:32 comdog Exp $
7 cpan - easily interact with CPAN from the command line
11 # with arguments and no switches, installs specified modules
12 cpan module_name [ module_name ... ]
14 # with switches, installs modules with extra behavior
15 cpan [-cfimt] module_name [ module_name ... ]
17 # without arguments, starts CPAN shell
20 # without arguments, but some switches
25 This script provides a command interface (not a shell) to CPAN.pm.
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
38 Creates the CPAN.pm autobundle with CPAN::Shell->autobundle.
40 =item -A module [ module ... ]
42 Shows the primary maintainers for the specified modules
44 =item -C module [ module ... ]
46 Show the C<Changes> files for the specified modules
48 =item -D module [ module ... ]
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
55 =item -L author [ author ... ]
57 List the modules by the specified authors.
61 Prints a help message.
65 Show the out-of-date modules.
69 Recompiles dynamically loaded modules with CPAN::Shell->recompile.
73 Print the script version and CPAN.pm version.
79 These options are mutually exclusive, and the script processes them in
80 alphabetical order. It only processes the first one it finds.
86 Runs a `make clean` in the specified module's directories.
90 Forces the specified action, when it normally would have failed.
94 Installed the specified modules.
98 Makes the specified modules.
102 Runs a `make test` on the specified modules.
108 # print a help message
111 # print the version numbers
114 # create an autobundle
120 # install modules ( sole -i is optional )
121 cpan -i Netscape::Booksmarks Business::ISBN
123 # force install modules ( must use -i )
124 cpan -fi CGI::Minimal URI
135 Most behaviour, including environment variables and configuration,
136 comes directly from CPAN.pm.
138 =head1 SOURCE AVAILABILITY
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.
143 http://sourceforge.net/projects/brian-d-foy/
145 If, for some reason, I disappear from the world, one of the other
146 members of the project can shepherd this module appropriately.
150 Japheth Cleaver added the bits to allow a forced install (-f).
152 Jim Brandt suggest and provided the initial implementation for the
153 up-to-date and Changes features.
157 brian d foy, C<< <bdfoy@cpan.org> >>
161 Copyright (c) 2001-2006, brian d foy, All Rights Reserved.
163 You may redistribute this under the same terms as Perl itself.
171 sprintf "%d.%d", q$Revision: 403 $ =~ m/ (\d+) \. (\d+) /xg;
173 if( 0 == @ARGV ) { CPAN::shell(); exit 0 }
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 );
179 # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
180 # map switches to method names in CPAN::Shell
181 my $Default = 'default';
184 $Default => 'install',
191 my @CPAN_OPTIONS = grep { $_ ne $Default } sort keys %CPAN_METHODS;
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
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' ],
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`' ],
216 my %Method_table_index = (
223 # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
224 # finally, do some argument processing
225 my @option_order = ( @META_OPTIONS, @CPAN_OPTIONS );
228 Getopt::Std::getopts(
229 join( '', @option_order ), \%options );
231 my $option_count = grep { $options{$_} } @option_order;
232 $option_count -= $options{'f'}; # don't count force
234 # if there are no options, set -i (this line fixes RT ticket 16915)
235 $options{i}++ unless $option_count;
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 )
243 next unless $options{$option};
245 ref $Method_table{$option}[ $Method_table_index{code} ] eq ref sub {};
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} ] );
253 $Method_table{$option}[ $Method_table_index{code} ]->( \@ARGV );
258 # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
259 # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
260 # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
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 )
272 next if $option eq 'f';
273 next unless $options{$option};
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"; }
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 );
290 # call the CPAN::Shell method, with force if specified
291 foreach my $arg ( @$args )
293 if( $options{f} ) { CPAN::Shell->force( $method, $arg ) }
294 else { CPAN::Shell->$method( $arg ) }
298 # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
301 print STDERR "Use perldoc to read the documentation\n";
307 print STDERR "$0 script version $VERSION, CPAN.pm version " .
308 CPAN->VERSION . "\n";
311 sub _create_autobundle
313 print "Creating autobundle in ", $CPAN::Config->{cpan_home},
316 CPAN::Shell->autobundle;
321 print "Recompiling dynamically-loaded extensions\n";
323 CPAN::Shell->recompile;
330 foreach my $arg ( @$args )
332 print "Checking $arg\n";
333 my $module = CPAN::Shell->expand( "Module", $arg );
335 next unless $module->inst_file;
336 #next if $module->uptodate;
338 ( my $id = $module->id() ) =~ s/::/\-/;
340 my $url = "http://search.cpan.org/~" . lc( $module->userid ) . "/" .
341 $id . "-" . $module->cpan_version() . "/";
343 #print "URL: $url\n";
344 _get_changes_file($url);
348 sub _get_changes_file
350 die "Reading Changes files requires LWP::Simple and URI\n"
351 unless eval { require LWP::Simple; require URI; };
355 my $content = LWP::Simple::get( $url );
356 print "Got $url ...\n" if defined $content;
359 my( $change_link ) = $content =~ m|<a href="(.*?)">Changes</a>|gi;
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";
372 foreach my $arg ( @$args )
374 my $module = CPAN::Shell->expand( "Module", $arg );
375 my $author = CPAN::Shell->expand( "Author", $module->userid );
377 next unless $module->userid;
379 printf "%-25s %-8s %-25s %s\n",
380 $arg, $module->userid, $author->email, $author->fullname;
388 foreach my $arg ( @$args )
390 my $module = CPAN::Shell->expand( "Module", $arg );
391 my $author = CPAN::Shell->expand( "Author", $module->userid );
393 next unless $module->userid;
395 print "$arg\n", "-" x 73, "\n\t";
397 $module->description ? $module->description : "(no description)",
400 'Installed: ' . $module->inst_version,
401 'CPAN: ' . $module->cpan_version . ' ' .
402 ($module->uptodate ? "" : "Not ") . "up to date",
403 $author->fullname . " (" . $module->userid . ")",
410 sub _show_out_of_date
412 my @modules = CPAN::Shell->expand( "Module", "/./" );
414 printf "%-40s %6s %6s\n", "Module Name", "Local", "CPAN";
415 print "-" x 73, "\n";
417 foreach my $module ( @modules )
419 next unless $module->inst_file;
420 next if $module->uptodate;
421 printf "%-40s %.4f %.4f\n",
423 $module->inst_version ? $module->inst_version : '',
424 $module->cpan_version;
429 sub _show_author_mods
433 my %hash = map { lc $_, 1 } @$args;
435 my @modules = CPAN::Shell->expand( "Module", "/./" );
437 foreach my $module ( @modules )
439 next unless exists $hash{ lc $module->userid };
440 print $module->id, "\n";