[p5sagit/p5-mst-13.2.git] / lib / CPAN / bin / cpan

#!/usr/bin/perl
# $Id: cpan,v 1.9 2006/11/01 21:49:31 comdog Exp $
use strict;

=head1 NAME

cpan - easily interact with CPAN from the command line

=head1 SYNOPSIS

	# with arguments and no switches, installs specified modules
	cpan module_name [ module_name ... ]

	# with switches, installs modules with extra behavior
	cpan [-cfimt] module_name [ module_name ... ]

	# without arguments, starts CPAN.pm shell
	cpan

	# without arguments, but some switches
	cpan [-ahrvACDLO]

=head1 DESCRIPTION

This script provides a command interface (not a shell) to CPAN. At the
moment it uses CPAN.pm to do the work, but it is not a one-shot command
runner for CPAN.pm.

=head2 Meta 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.

=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.

=item -v

Print the script version and CPAN.pm version.

=back

=head2 Module options

These options are mutually exclusive, and the script processes them in
alphabetical order. It only processes the first one it finds.

=over 4

=item c

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.

=item m

Makes the specified modules.

=item t

Runs a `make test` on the specified modules.

=back

=head2 Examples

	# print a help message
	cpan -h

	# print the version numbers
	cpan -v

	# create an autobundle
	cpan -a

	# recompile 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


=head1 BUGS

* none noted

=head1 SEE ALSO

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.

Adam Kennedy pointed out that exit() causes problems on Windows
where this script ends up with a .bat extension

=head1 AUTHOR

brian d foy, C<< <bdfoy@cpan.org> >>

=head1 COPYRIGHT

Copyright (c) 2001-2006, 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 "%d.%d", q$Revision: 1.9 $ =~ m/ (\d+) \. (\d+) /xg;

if( $ARGV[0] eq 'install' )
	{
	my @args = @ARGV;
	shift @args;
	
	die <<"HERE";
It looks like you specified 'install' as an argument to cpan(1). This
script is not the CPAN.pm prompt and doesn't understand the same commands.
In fact, doesn't require the extra typing. You probably just want to
list the modules you want to install:

	cpan @args
	
See the documentation for more details on using this script.
HERE
	}
	
if( 0 == @ARGV ) { CPAN::shell(); exit 0 }

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 
# 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 %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 %options;
Getopt::Std::getopts(
	join( '', @option_order ), \%options );

my $option_count = grep { $options{$_} } @option_order;
$option_count -= $options{'f'}; # don't count force

# if there are no options, set -i (this line fixes RT ticket 16915)
$options{i}++ unless $option_count;

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 
# 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 {};
	
	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
	{
	my $args = shift;
	
	my $switch = '';

	# 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(); return   }
	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 )        }
		}
	}

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 
sub _print_help
	{
	print STDERR "Use perldoc to read the documentation\n";
	exec "perldoc $0";
	}
	
sub _print_version
	{
	print STDERR "$0 script version $VERSION, CPAN.pm version " . 
		CPAN->VERSION . "\n";
	}
	
sub _create_autobundle
	{
	print "Creating autobundle in ", $CPAN::Config->{cpan_home},
		"/Bundle\n";

	CPAN::Shell->autobundle;
	}

sub _recompiling
	{
	print "Recompiling dynamically-loaded extensions\n";

	CPAN::Shell->recompile;
	}

sub _show_Changes
	{
	my $args = shift;
	
	foreach my $arg ( @$args )
		{
		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);
		}
	}	
	
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 $content = LWP::Simple::get( $url );
    print "Got $url ...\n" if defined $content;
	#print $content;
	
	my( $change_link ) = $content =~ m|<a href="(.*?)">Changes</a>|gi;
	
	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 )
		{
		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;
Commit	Line	Data
5fc0f0f6	1	#!/usr/bin/perl
2b3bde2a	2	# $Id: cpan,v 1.9 2006/11/01 21:49:31 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 ... ]
e82b9348	16
2b3bde2a	17	# without arguments, starts CPAN.pm shell
5fc0f0f6	18	cpan
e82b9348	19
5fc0f0f6	20	# without arguments, but some switches
e82b9348	21	cpan [-ahrvACDLO]
5fc0f0f6	22
	23	=head1 DESCRIPTION
	24
2b3bde2a	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.
5fc0f0f6	28
	29	=head2 Meta Options
	30
e82b9348	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.
5fc0f0f6	35
	36	=over 4
	37
	38	=item -a
	39
e82b9348	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.
5fc0f0f6	60
	61	=item -h
	62
	63	Prints a help message.
	64
e82b9348	65	=item -O
	66
	67	Show the out-of-date modules.
	68
5fc0f0f6	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
e82b9348	81	These options are mutually exclusive, and the script processes them in
e82b9348	82	alphabetical order. It only processes the first one it finds.
5fc0f0f6	83
	84	=over 4
	85
	86	=item c
	87
	88	Runs a `make clean` in the specified module's directories.
	89
e82b9348	90	=item f
	91
	92	Forces the specified action, when it normally would have failed.
	93
5fc0f0f6	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
e82b9348	112
5fc0f0f6	113	# print the version numbers
5fc0f0f6	114	cpan -v
e82b9348	115
5fc0f0f6	116	# create an autobundle
5fc0f0f6	117	cpan -a
e82b9348	118
5fc0f0f6	119	# recompile modules
e82b9348	120	cpan -r
	121
	122	# install modules ( sole -i is optional )
5fc0f0f6	123	cpan -i Netscape::Booksmarks Business::ISBN
5fc0f0f6	124
e82b9348	125	# force install modules ( must use -i )
	126	cpan -fi CGI::Minimal URI
	127
5fc0f0f6	128	=head1 TO DO
5fc0f0f6	129
5fc0f0f6	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
e82b9348	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
2b3bde2a	157	Adam Kennedy pointed out that exit() causes problems on Windows
	158	where this script ends up with a .bat extension
	159
5fc0f0f6	160	=head1 AUTHOR
5fc0f0f6	161
e82b9348	162	brian d foy, C<< <bdfoy@cpan.org> >>
	163
	164	=head1 COPYRIGHT
	165
9ddc4ed0	166	Copyright (c) 2001-2006, brian d foy, All Rights Reserved.
e82b9348	167
e82b9348	168	You may redistribute this under the same terms as Perl itself.
5fc0f0f6	169
	170	=cut
	171
	172	use CPAN ();
	173	use Getopt::Std;
	174
e82b9348	175	my $VERSION =
2b3bde2a	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:
5fc0f0f6	188
2b3bde2a	189	cpan @args
	190
	191	See the documentation for more details on using this script.
	192	HERE
	193	}
	194
e82b9348	195	if( 0 == @ARGV ) { CPAN::shell(); exit 0 }
5fc0f0f6	196
e82b9348	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';
5fc0f0f6	204
	205	my %CPAN_METHODS = (
	206	$Default => 'install',
	207	'c' => 'clean',
e82b9348	208	'f' => 'force',
5fc0f0f6	209	'i' => 'install',
	210	'm' => 'make',
	211	't' => 'test',
	212	);
e82b9348	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`' ],
5fc0f0f6	235
e82b9348	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 );
5fc0f0f6	248
5fc0f0f6	249	my %options;
e82b9348	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
5fc0f0f6	255
9ddc4ed0	256	# if there are no options, set -i (this line fixes RT ticket 16915)
	257	$options{i}++ unless $option_count;
	258
e82b9348	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 {};
5fc0f0f6	268
e82b9348	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
5fc0f0f6	285	{
e82b9348	286	my $args = shift;
	287
	288	my $switch = '';
5fc0f0f6	289
e82b9348	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; }
2b3bde2a	304	elsif( not $switch and not @$args ) { CPAN::shell(); return }
e82b9348	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	}
5fc0f0f6	318	}
e82b9348	319
	320	# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
	321	sub _print_help
5fc0f0f6	322	{
e82b9348	323	print STDERR "Use perldoc to read the documentation\n";
	324	exec "perldoc $0";
	325	}
5fc0f0f6	326
e82b9348	327	sub _print_version
	328	{
	329	print STDERR "$0 script version $VERSION, CPAN.pm version " .
	330	CPAN->VERSION . "\n";
5fc0f0f6	331	}
e82b9348	332
e82b9348	333	sub _create_autobundle
5fc0f0f6	334	{
e82b9348	335	print "Creating autobundle in ", $CPAN::Config->{cpan_home},
5fc0f0f6	336	"/Bundle\n";
5fc0f0f6	337
5fc0f0f6	338	CPAN::Shell->autobundle;
5fc0f0f6	339	}
e82b9348	340
5254b38e	341	sub _recompiling
5fc0f0f6	342	{
e82b9348	343	print "Recompiling dynamically-loaded extensions\n";
e82b9348	344
5fc0f0f6	345	CPAN::Shell->recompile;
5fc0f0f6	346	}
e82b9348	347
e82b9348	348	sub _show_Changes
5fc0f0f6	349	{
e82b9348	350	my $args = shift;
5fc0f0f6	351
e82b9348	352	foreach my $arg ( @$args )
5fc0f0f6	353	{
e82b9348	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);
5fc0f0f6	367	}
e82b9348	368	}
5fc0f0f6	369
e82b9348	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;
5fc0f0f6	376
e82b9348	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;
5fc0f0f6	382
e82b9348	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 )
5fc0f0f6	440	{
e82b9348	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;
5fc0f0f6	447	}
e82b9348	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
5fc0f0f6	465	}
	466
	467	1;