Current Path : /compat/linux/proc/68247/root/usr/local/bin/ |
FreeBSD hs32.drive.ne.jp 9.1-RELEASE FreeBSD 9.1-RELEASE #1: Wed Jan 14 12:18:08 JST 2015 root@hs32.drive.ne.jp:/sys/amd64/compile/hs32 amd64 |
Current File : //compat/linux/proc/68247/root/usr/local/bin/cpan |
#!/usr/local/bin/perl eval 'exec /usr/local/bin/perl -S $0 ${1+"$@"}' if $running_under_some_shell; #!/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;