view release on metacpan or  search on metacpan

lib/App/Cpan.pm  view on Meta::CPAN

		how_many   => 5,
		verbose    => 1,
		);

	foreach my $mirror ( @mirrors ) {
		next unless eval { $mirror->can( 'http' ) };
		_print_ping_report( $mirror->http );
		}

	$CPAN::Config->{urllist} = [
		map { $_->http } @mirrors
		];
	}

sub _print_inc_dir_report
	{
	my( $dir ) = shift;

	my $writeable = -w $dir ? '+' : '!!! (not writeable)';
	$logger->info( "\t$writeable $dir" );
	return -w $dir;
	}

sub _print_ping_report
	{
	my( $mirror ) = @_;

	my $rtt = eval { _get_ping_report( $mirror ) };
	my $result = $rtt ? sprintf "+ (%4d ms)", $rtt * 1000 : '!';

	$logger->info(
		sprintf "\t%s %s", $result, $mirror
		);
	}

sub _get_ping_report
	{
	require URI;
	my( $mirror ) = @_;
	my( $url ) = ref $mirror ? $mirror : URI->new( $mirror ); #XXX
	require Net::Ping;

	my $ping = Net::Ping->new( 'tcp', 1 );

	if( $url->scheme eq 'file' ) {
		return -e $url->file;
		}

	my( $port ) = $url->port;

	return unless $port;

	if ( $ping->can('port_number') ) {
		$ping->port_number($port);
		}
	else {
		$ping->{'port_num'} = $port;
		}

	$ping->hires(1) if $ping->can( 'hires' );
	my( $alive, $rtt ) = eval{ $ping->ping( $url->host ) };
	$alive ? $rtt : undef;
	}

sub _load_local_lib # -I
	{
	$logger->debug( "Loading local::lib" );

	my $rc = _safe_load_module("local::lib");
	unless( $rc ) {
		$logger->logdie( "Could not load local::lib" );
		}

	local::lib->import;

	return HEY_IT_WORKED;
	}

sub _use_these_mirrors # -M
	{
	$logger->debug( "Setting per session mirrors" );
	unless( $_[0] ) {
		$logger->logdie( "The -M switch requires a comma-separated list of mirrors" );
		}

	$CPAN::Config->{urllist} = [ split /,/, $_[0] ];

	$logger->debug( "Mirrors are @{$CPAN::Config->{urllist}}" );

	}

sub _create_autobundle
	{
	$logger->info(
		"Creating autobundle in $CPAN::Config->{cpan_home}/Bundle" );

	CPAN::Shell->autobundle;

	return HEY_IT_WORKED;
	}

sub _recompile
	{
	$logger->info( "Recompiling dynamically-loaded extensions" );

	CPAN::Shell->recompile;

	return HEY_IT_WORKED;
	}

sub _upgrade
	{
	$logger->info( "Upgrading all modules" );

	CPAN::Shell->upgrade();

	return HEY_IT_WORKED;
	}

sub _shell
	{
	$logger->info( "Dropping into shell" );