#!/usr/bin/perl
-# $Id: cpan,v 1.1 2003/02/08 17:06:51 k Exp $
+# $Id: cpan,v 1.5 2005/12/24 00:59:08 comdog Exp $
use strict;
=head1 NAME
=head1 SYNOPSIS
- # with arguments, installs specified modules
+ # with arguments and no switches, installs specified modules
cpan module_name [ module_name ... ]
-
+
# with switches, installs modules with extra behavior
- cpan [-cimt] module_name [ module_name ... ]
-
+ cpan [-cfimt] module_name [ module_name ... ]
+
# without arguments, starts CPAN shell
cpan
-
+
# without arguments, but some switches
- cpan [-ahrv]
+ cpan [-ahrvACDLO]
=head1 DESCRIPTION
=head2 Meta Options
-These options are mutually exclusive, and the script processes
-them in this order: [ahvr]. Once the script finds one, it ignores
-the others, and then exits after it finishes the task. The script
-ignores any other command line options.
+These options are mutually exclusive, and the script processes them in
+this order: [hvCAar]. Once the script finds one, it ignores the others,
+and then exits after it finishes the task. The script ignores any other
+command line options.
=over 4
=item -a
-Creates the CPAN.pm autobundle with CPAN::Shell->autobundle.
+Creates the CPAN.pm autobundle with CPAN::Shell->autobundle.
+
+=item -A module [ module ... ]
+
+Shows the primary maintainers for the specified modules
+
+=item -C module [ module ... ]
+
+Show the C<Changes> files for the specified modules
+
+=item -D module [ module ... ]
+
+Show the module details. This prints one line for each out-of-date module
+(meaning, modules locally installed but have newer versions on CPAN).
+Each line has three columns: module name, local version, and CPAN
+version.
+
+=item -L author [ author ... ]
+
+List the modules by the specified authors.
=item -h
Prints a help message.
+=item -O
+
+Show the out-of-date modules.
+
=item -r
Recompiles dynamically loaded modules with CPAN::Shell->recompile.
=head2 Module options
-These options are mutually exclusive, and the script processes
-them in alphabetical order.
+These options are mutually exclusive, and the script processes them in
+alphabetical order. It only processes the first one it finds.
=over 4
Runs a `make clean` in the specified module's directories.
+=item f
+
+Forces the specified action, when it normally would have failed.
+
=item i
Installed the specified modules.
# print a help message
cpan -h
-
+
# print the version numbers
cpan -v
-
+
# create an autobundle
cpan -a
-
+
# recompile modules
- cpan -r
-
- # install modules
+ cpan -r
+
+ # install modules ( sole -i is optional )
cpan -i Netscape::Booksmarks Business::ISBN
+ # force install modules ( must use -i )
+ cpan -fi CGI::Minimal URI
+
=head1 TO DO
-* add options for other CPAN::Shell functions
-autobundle, clean, make, recompile, test
=head1 BUGS
Most behaviour, including environment variables and configuration,
comes directly from CPAN.pm.
+=head1 SOURCE AVAILABILITY
+
+This source is part of a SourceForge project which always has the
+latest sources in CVS, as well as all of the previous releases.
+
+ http://sourceforge.net/projects/brian-d-foy/
+
+If, for some reason, I disappear from the world, one of the other
+members of the project can shepherd this module appropriately.
+
+=head1 CREDITS
+
+Japheth Cleaver added the bits to allow a forced install (-f).
+
+Jim Brandt suggest and provided the initial implementation for the
+up-to-date and Changes features.
+
=head1 AUTHOR
-brian d foy <bdfoy@cpan.org>
+brian d foy, C<< <bdfoy@cpan.org> >>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2001-2005, brian d foy, All Rights Reserved.
+
+You may redistribute this under the same terms as Perl itself.
=cut
use CPAN ();
use Getopt::Std;
-my $VERSION = sprintf "%.2f", substr(q$Rev: 245 $,4)/100;
+my $VERSION =
+ sprintf "%d.%02d", q$Revision: 296 $ =~ m/ (\d+) \. (\d+) /xg;
-my $Default = 'default';
+if( 0 == @ARGV ) { CPAN::shell(); exit 0 }
-my $META_OPTIONS = 'ahvr';
+# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
+# set up the order of options that we layer over CPAN::Shell
+my @META_OPTIONS = qw( h v C A D O L a r );
+
+# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
+# map switches to method names in CPAN::Shell
+my $Default = 'default';
my %CPAN_METHODS = (
$Default => 'install',
'c' => 'clean',
+ 'f' => 'force',
'i' => 'install',
'm' => 'make',
't' => 'test',
);
+my @CPAN_OPTIONS = grep { $_ ne $Default } sort keys %CPAN_METHODS;
+
+# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
+# map switches to the subroutines in this script, along with other information.
+# use this stuff instead of hard-coded indices and values
+my %Method_table = (
+# key => [ sub ref, takes args?, exit value, description ]
+ h => [ \&_print_help, 0, 0, 'Printing help' ],
+ v => [ \&_print_version, 0, 0, 'Printing version' ],
+ C => [ \&_show_Changes, 1, 0, 'Showing Changes file' ],
+ A => [ \&_show_Author, 1, 0, 'Showing Author' ],
+ D => [ \&_show_Details, 1, 0, 'Showing Details' ],
+ O => [ \&_show_out_of_date, 0, 0, 'Showing Out of date' ],
+ L => [ \&_show_author_mods, 1, 0, 'Showing author mods' ],
+ a => [ \&_create_autobundle, 0, 0, 'Creating autobundle' ],
+ r => [ \&_recompile, 0, 0, 'Recompiling' ],
+
+ c => [ \&_default, 1, 0, 'Running `make clean`' ],
+ f => [ \&_default, 1, 0, 'Installing with force' ],
+ i => [ \&_default, 1, 0, 'Running `make install`' ],
+ 'm' => [ \&_default, 1, 0, 'Running `make`' ],
+ t => [ \&_default, 1, 0, 'Running `make test`' ],
-my @cpan_options = grep { $_ ne $Default } sort keys %CPAN_METHODS;
+ );
+
+my %Method_table_index = (
+ code => 0,
+ takes_args => 1,
+ exit_value => 2,
+ description => 3,
+ );
+
+# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
+# finally, do some argument processing
+my @option_order = ( @META_OPTIONS, @CPAN_OPTIONS );
-my $arg_count = @ARGV;
my %options;
+Getopt::Std::getopts(
+ join( '', @option_order ), \%options );
+
+my $option_count = grep { $options{$_} } @option_order;
+$option_count -= $options{'f'}; # don't count force
-Getopt::Std::getopts(
- join( '', @cpan_options, $META_OPTIONS ), \%options );
+# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
+# try each of the possible switches until we find one to handle
+# print an error message if there are too many switches
+# print an error message if there are arguments when there shouldn't be any
+foreach my $option ( @option_order )
+ {
+ next unless $options{$option};
+ die unless
+ ref $Method_table{$option}[ $Method_table_index{code} ] eq ref sub {};
-if( $options{h} )
+ print "$Method_table{$option}[ $Method_table_index{description} ] " .
+ "-- ignoring other opitions\n" if $option_count > 1;
+ print "$Method_table{$option}[ $Method_table_index{description} ] " .
+ "-- ignoring other arguments\n"
+ if( @ARGV && ! $Method_table{$option}[ $Method_table_index{takes_args} ] );
+
+ $Method_table{$option}[ $Method_table_index{code} ]->( \@ARGV );
+
+ last;
+ }
+
+# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
+ # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
+# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
+
+sub _default
{
- print STDERR "Printing help message -- ignoring other arguments\n"
- if $arg_count > 1;
+ my $args = shift;
+
+ my $switch = '';
- print STDERR "Use perldoc to read the documentation\n";
- exit 0;
+ # choose the option that we're going to use
+ # we'll deal with 'f' (force) later, so skip it
+ foreach my $option ( @CPAN_OPTIONS )
+ {
+ next if $option eq 'f';
+ next unless $options{$option};
+ $switch = $option;
+ last;
+ }
+
+ # 1. with no switches, but arguments, use the default switch (install)
+ # 2. with no switches and no args, start the shell
+ # 3. With a switch but no args, die! These switches need arguments.
+ if( not $switch and @$args ) { $switch = $Default; }
+ elsif( not $switch and not @$args ) { CPAN::shell(); exit 0; }
+ elsif( $switch and not @$args )
+ { die "Nothing to $CPAN_METHODS{$switch}!\n"; }
+
+ # Get and cheeck the method from CPAN::Shell
+ my $method = $CPAN_METHODS{$switch};
+ die "CPAN.pm cannot $method!\n" unless CPAN::Shell->can( $method );
+
+ # call the CPAN::Shell method, with force if specified
+ foreach my $arg ( @$args )
+ {
+ if( $options{f} ) { CPAN::Shell->force( $method, $arg ) }
+ else { CPAN::Shell->$method( $arg ) }
+ }
}
-elsif( $options{v} )
+
+# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
+sub _print_help
{
- print STDERR "Printing version message -- ignoring other arguments\n"
+ print STDERR "Use perldoc to read the documentation\n";
+ exec "perldoc $0";
+ }
- if $arg_count > 1;
-
- my $CPAN_VERSION = CPAN->VERSION;
- print STDERR "cpan script version $VERSION\n" .
- "CPAN.pm version $CPAN_VERSION\n";
- exit 0;
+sub _print_version
+ {
+ print STDERR "$0 script version $VERSION, CPAN.pm version " .
+ CPAN->VERSION . "\n";
}
-elsif( $options{a} )
+
+sub _create_autobundle
{
- print "Creating autobundle in ", $CPAN::Config->{cpan_home},
+ print "Creating autobundle in ", $CPAN::Config->{cpan_home},
"/Bundle\n";
- print STDERR "Creating autobundle -- ignoring other arguments\n"
- if $arg_count > 1;
CPAN::Shell->autobundle;
- exit 0;
}
-elsif( $options{r} )
+
+sub _recompiling
{
- print STDERR "Creating autobundle -- ignoring other arguments\n"
- if $arg_count > 1;
-
+ print "Recompiling dynamically-loaded extensions\n";
+
CPAN::Shell->recompile;
}
-else
+
+sub _show_Changes
{
- my $switch = '';
+ my $args = shift;
- foreach my $option ( @cpan_options )
+ foreach my $arg ( @$args )
{
- next unless $options{$option};
- $switch = $option;
- last;
+ print "Checking $arg\n";
+ my $module = CPAN::Shell->expand( "Module", $arg );
+
+ next unless $module->inst_file;
+ #next if $module->uptodate;
+
+ ( my $id = $module->id() ) =~ s/::/\-/;
+
+ my $url = "http://search.cpan.org/~" . lc( $module->userid ) . "/" .
+ $id . "-" . $module->cpan_version() . "/";
+
+ #print "URL: $url\n";
+ _get_changes_file($url);
}
+ }
- if( not $switch and @ARGV ) { $switch = $Default; }
- elsif( not $switch and not @ARGV ) { CPAN::shell(); exit 0; }
- elsif( $switch and not @ARGV )
- { die "Nothing to $CPAN_METHODS{$switch}!\n"; }
+sub _get_changes_file
+ {
+ die "Reading Changes files requires LWP::Simple and URI\n"
+ unless eval { require LWP::Simple; require URI; };
+
+ my $url = shift;
- my $method = $CPAN_METHODS{$switch};
- die "CPAN.pm cannot $method!\n" unless CPAN::Shell->can( $method );
+ my $content = LWP::Simple::get( $url );
+ print "Got $url ...\n" if defined $content;
+ #print $content;
+
+ my( $change_link ) = $content =~ m|<a href="(.*?)">Changes</a>|gi;
- foreach my $arg ( @ARGV )
+ my $changes_url = URI->new_abs( $change_link, $url );
+ #print "change link is: $changes_url\n";
+ my $changes = LWP::Simple::get( $changes_url );
+ #print "change text is: " . $change_link->text() . "\n";
+ print $changes;
+ }
+
+sub _show_Author
+ {
+ my $args = shift;
+
+ foreach my $arg ( @$args )
+ {
+ my $module = CPAN::Shell->expand( "Module", $arg );
+ my $author = CPAN::Shell->expand( "Author", $module->userid );
+
+ next unless $module->userid;
+
+ printf "%-25s %-8s %-25s %s\n",
+ $arg, $module->userid, $author->email, $author->fullname;
+ }
+ }
+
+sub _show_Details
+ {
+ my $args = shift;
+
+ foreach my $arg ( @$args )
+ {
+ my $module = CPAN::Shell->expand( "Module", $arg );
+ my $author = CPAN::Shell->expand( "Author", $module->userid );
+
+ next unless $module->userid;
+
+ print "$arg\n", "-" x 73, "\n\t";
+ print join "\n\t",
+ $module->description ? $module->description : "(no description)",
+ $module->cpan_file,
+ $module->inst_file,
+ 'Installed: ' . $module->inst_version,
+ 'CPAN: ' . $module->cpan_version . ' ' .
+ ($module->uptodate ? "" : "Not ") . "up to date",
+ $author->fullname . " (" . $module->userid . ")",
+ $author->email;
+ print "\n\n";
+
+ }
+ }
+
+sub _show_out_of_date
+ {
+ my @modules = CPAN::Shell->expand( "Module", "/./" );
+
+ printf "%-40s %6s %6s\n", "Module Name", "Local", "CPAN";
+ print "-" x 73, "\n";
+
+ foreach my $module ( @modules )
{
- CPAN::Shell->$method( $arg );
+ next unless $module->inst_file;
+ next if $module->uptodate;
+ printf "%-40s %.4f %.4f\n",
+ $module->id,
+ $module->inst_version ? $module->inst_version : '',
+ $module->cpan_version;
}
+
+ }
+
+sub _show_author_mods
+ {
+ my $args = shift;
+
+ my %hash = map { lc $_, 1 } @$args;
+
+ my @modules = CPAN::Shell->expand( "Module", "/./" );
+
+ foreach my $module ( @modules )
+ {
+ next unless exists $hash{ lc $module->userid };
+ print $module->id, "\n";
+ }
+
}
1;
projects / p5sagit/p5-mst-13.2.git / blobdiff