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

#!/usr/bin/perl
# $Id: cpan,v 1.7 2006/01/11 06:22:32 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 shell
	cpan

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

=head1 DESCRIPTION

This script provides a command interface (not a shell) to 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.

=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: 403 $ =~ m/ (\d+) \. (\d+) /xg;

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

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