view release on metacpan or  search on metacpan

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

	# Get and check 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 or notest if specified
	my $action = do {
		   if( $options->{f} ) { sub { CPAN::Shell->force( $method, @_ )  } }
		elsif( $options->{T} ) { sub { CPAN::Shell->notest( $method, @_ ) } }
		else                   { sub { CPAN::Shell->$method( @_ )         } }
		};

	# How do I handle exit codes for multiple arguments?
	my @errors = ();

	$options->{x} or _disable_guessers();

	foreach my $arg ( @$args )
		{
		# check the argument and perhaps capture typos
		my $module = _expand_module( $arg ) or do {
			$logger->error( "Skipping $arg because I couldn't find a matching namespace." );
			next;
			};

		_clear_cpanpm_output();
		$action->( $arg );

		my $error = _cpanpm_output_indicates_failure();
		push @errors, $error if $error;
		}

	return do {
		if( @errors ) { $errors[0] }
		else { HEY_IT_WORKED }
		};

	}

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #

=for comment

CPAN.pm sends all the good stuff either to STDOUT, or to a temp
file if $CPAN::Be_Silent is set. I have to intercept that output
so I can find out what happened.

=cut

BEGIN {
my $scalar = '';

sub _hook_into_CPANpm_report
	{
	no warnings 'redefine';

	*CPAN::Shell::myprint = sub {
		my($self,$what) = @_;
		$scalar .= $what if defined $what;
		$self->print_ornamented($what,
			$CPAN::Config->{colorize_print}||'bold blue on_white',
			);
		};

	*CPAN::Shell::mywarn = sub {
		my($self,$what) = @_;
		$scalar .= $what if defined $what;
		$self->print_ornamented($what,
			$CPAN::Config->{colorize_warn}||'bold red on_white'
			);
		};

	}

sub _clear_cpanpm_output { $scalar = '' }

sub _get_cpanpm_output   { $scalar }

# These are lines I don't care about in CPAN.pm output. If I can
# filter out the informational noise, I have a better chance to
# catch the error signal
my @skip_lines = (
	qr/^\QWarning \(usually harmless\)/,
	qr/\bwill not store persistent state\b/,
	qr(//hint//),
	qr/^\s+reports\s+/,
	qr/^Try the command/,
	qr/^\s+$/,
	qr/^to find objects/,
	qr/^\s*Database was generated on/,
	qr/^Going to read/,
	qr|^\s+i\s+/|,    # the i /Foo::Whatever/ line when it doesn't know
	);

sub _get_cpanpm_last_line
	{
	my $fh;

	if( $] < 5.008 ) {
		$fh = IO::Scalar->new( \ $scalar );
		}
	else {
		eval q{ open $fh, '<', \\ $scalar; };
		}

	my @lines = <$fh>;

	# This is a bit ugly. Once we examine a line, we have to
	# examine the line before it and go through all of the same
	# regexes. I could do something fancy, but this works.
	REGEXES: {
	foreach my $regex ( @skip_lines )
		{
		if( $lines[-1] =~ m/$regex/ )
			{
			pop @lines;
			redo REGEXES; # we have to go through all of them for every line!
			}
		}
	}

	$logger->debug( "Last interesting line of CPAN.pm output is:\n\t$lines[-1]" );

	$lines[-1];
	}
}

BEGIN {
my $epic_fail_words = join '|',