lib/CPAN/bin/cpan

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