lib/CPAN/bin/cpan

   1 #!/usr/bin/perl
   2 # $Id: cpan,v 1.7 2006/01/11 06:22:32 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 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.pm.
  26
  27 =head2 Meta Options
  28
  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.
  33
  34 =over 4
  35
  36 =item -a
  37
  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.
  58
  59 =item -h
  60
  61 Prints a help message.
  62
  63 =item -O
  64
  65 Show the out-of-date modules.
  66
  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
  79 These options are mutually exclusive, and the script processes them in
  80 alphabetical order. It only processes the first one it finds.
  81
  82 =over 4
  83
  84 =item c
  85
  86 Runs a `make clean` in the specified module's directories.
  87
  88 =item f
  89
  90 Forces the specified action, when it normally would have failed.
  91
  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
 110
 111         # print the version numbers
 112         cpan -v
 113
 114         # create an autobundle
 115         cpan -a
 116
 117         # recompile modules
 118         cpan -r
 119
 120         # install modules ( sole -i is optional )
 121         cpan -i Netscape::Booksmarks Business::ISBN
 122
 123         # force install modules ( must use -i )
 124         cpan -fi CGI::Minimal URI
 125
 126 =head1 TO DO
 127
 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
 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
 155 =head1 AUTHOR
 156
 157 brian d foy, C<< <bdfoy@cpan.org> >>
 158
 159 =head1 COPYRIGHT
 160
 161 Copyright (c) 2001-2006, brian d foy, All Rights Reserved.
 162
 163 You may redistribute this under the same terms as Perl itself.
 164
 165 =cut
 166
 167 use CPAN ();
 168 use Getopt::Std;
 169
 170 my $VERSION =
 171         sprintf "%d.%d", q$Revision: 403 $ =~ m/ (\d+) \. (\d+) /xg;
 172
 173 if( 0 == @ARGV ) { CPAN::shell(); exit 0 }
 174
 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';
 182
 183 my %CPAN_METHODS = (
 184         $Default => 'install',
 185         'c'      => 'clean',
 186         'f'      => 'force',
 187         'i'      => 'install',
 188         'm'      => 'make',
 189         't'      => 'test',
 190         );
 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`'    ],
 213
 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 );
 226
 227 my %options;
 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
 233
 234 # if there are no options, set -i (this line fixes RT ticket 16915)
 235 $options{i}++ unless $option_count;
 236
 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 {};
 246
 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
 263         {
 264         my $args = shift;
 265
 266         my $switch = '';
 267
 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                 }
 296         }
 297
 298 # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
 299 sub _print_help
 300         {
 301         print STDERR "Use perldoc to read the documentation\n";
 302         exec "perldoc $0";
 303         }
 304
 305 sub _print_version
 306         {
 307         print STDERR "$0 script version $VERSION, CPAN.pm version " .
 308                 CPAN->VERSION . "\n";
 309         }
 310
 311 sub _create_autobundle
 312         {
 313         print "Creating autobundle in ", $CPAN::Config->{cpan_home},
 314                 "/Bundle\n";
 315
 316         CPAN::Shell->autobundle;
 317         }
 318
 319 sub _recompiling
 320         {
 321         print "Recompiling dynamically-loaded extensions\n";
 322
 323         CPAN::Shell->recompile;
 324         }
 325
 326 sub _show_Changes
 327         {
 328         my $args = shift;
 329
 330         foreach my $arg ( @$args )
 331                 {
 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);
 345                 }
 346         }
 347
 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;
 354
 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;
 360
 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 )
 418                 {
 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;
 425                 }
 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
 443         }
 444
 445 1;