view release on metacpan or  search on metacpan

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

			);
		}

	$class->_turn_off_testing if $options->{T};

	foreach my $o ( qw(F I w P M) )
		{
		next unless exists $options->{$o};
		$Method_table{$o}[ $Method_table_index{code} ]->( $options->{$o} );
		delete $options->{$o};
		}

	if( $options->{o} )
		{
		my @pairs = map { [ split /=/, $_, 2 ] } split /,/, $options->{o};
		foreach my $pair ( @pairs )
			{
			my( $setting, $value ) = @$pair;
			$CPAN::Config->{$setting} = $value;
		#	$logger->debug( "Setting [$setting] to [$value]" );
			}
		delete $options->{o};
		}

	my $option_count = grep { $options->{$_} } @option_order;
	no warnings 'uninitialized';

	# don't count options that imply installation
	foreach my $opt ( qw(f T) ) { # don't count force or notest
		$option_count -= $options->{$opt};
		}

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

sub _setup_environment {
# should we override or set defaults? If this were a true interactive
# session, we'd be in the CPAN shell.

# https://github.com/Perl-Toolchain-Gang/toolchain-site/blob/master/lancaster-consensus.md
	$ENV{NONINTERACTIVE_TESTING} = 1 unless defined $ENV{NONINTERACTIVE_TESTING};
	$ENV{PERL_MM_USE_DEFAULT}    = 1 unless defined $ENV{PERL_MM_USE_DEFAULT};
	}

=item run( ARGS )

Just do it.

The C<run> method returns 0 on success and a positive number on
failure. See the section on EXIT CODES for details on the values.

=cut

my $logger;

sub run
	{
	my( $class, @args ) = @_;
	local @ARGV = @args;
	my $return_value = HEY_IT_WORKED; # assume that things will work

	$logger = $class->_init_logger;
	$logger->debug( "Using logger from @{[ref $logger]}" );

	$class->_hook_into_CPANpm_report;
	$logger->debug( "Hooked into output" );

	$class->_stupid_interface_hack_for_non_rtfmers;
	$logger->debug( "Patched cargo culting" );

	my $options = $class->_process_options;
	$logger->debug( "Options are @{[Dumper($options)]}" );

	$class->_process_setup_options( $options );

	$class->_setup_environment( $options );

	OPTION: foreach my $option ( @option_order )
		{
		next unless $options->{$option};

		my( $sub, $takes_args, $description ) =
			map { $Method_table{$option}[ $Method_table_index{$_} ] }
			qw( code takes_args description );

		unless( ref $sub eq ref sub {} )
			{
			$return_value = THE_PROGRAMMERS_AN_IDIOT;
			last OPTION;
			}

		$logger->info( "[$option] $description -- ignoring other arguments" )
			if( @ARGV && ! $takes_args );

		$return_value = $sub->( \ @ARGV, $options );

		last;
		}

	return $return_value;
	}

my $LEVEL;
{
package
  Local::Null::Logger; # hide from PAUSE

my @LOGLEVELS = qw(TRACE DEBUG INFO WARN ERROR FATAL);
$LEVEL        = uc($ENV{CPANSCRIPT_LOGLEVEL} || 'INFO');
my %LL        = map { $LOGLEVELS[$_] => $_ } 0..$#LOGLEVELS;
unless (defined $LL{$LEVEL}){
	warn "Unsupported loglevel '$LEVEL', setting to INFO";
	$LEVEL = 'INFO';
}
sub new { bless \ my $x, $_[0] }
sub AUTOLOAD {
	my $autoload = our $AUTOLOAD;
	$autoload =~ s/.*://;
	return if $LL{uc $autoload} < $LL{$LEVEL};