view release on metacpan or  search on metacpan

lib/Module/Release.pm  view on Meta::CPAN

	my $per_user_env_key = uc( "CPAN_PASS_$id" );
	if( exists $ENV{$per_user_env_key} and length $ENV{$per_user_env_key} ) {
		$_[0]->_debug( "Found env $per_user_env_key\n" );
		$_[0]->config->set( 'cpan_pass', $ENV{$per_user_env_key} );
		}
	elsif( my $pass = $_[0]->config->cpan_user && $_[0]->get_env_var( "CPAN_PASS" )  ) {
		$_[0]->_debug( "Used get_env_var to get CPAN_PASS\n" );
		$_[0]->config->set( 'cpan_pass', $pass );
		}

	$_[0]->_debug( "CPAN pass is " . $_[0]->config->cpan_pass . "\n" );
	}

=item get_changes()

Read and parse the F<Changes> file.  This is pretty specific, so
you may well want to overload it.

=cut

sub get_changes {
	open my $fh, '<:encoding(UTF-8)', 'Changes' or return '';

	my $data = <$fh>;  # get first line

	while( <$fh> ) {
		last if /^\S/;
		$data .= $_;
		}

	return $data;
	}

=item show_recent_contributors()

Show recent contributors before creating/extending Changes.

This output relies upon the method C<get_recent_contributors()> having been
implemented in the relevant mixin for your version control system.

=cut

sub show_recent_contributors {
	my $self = shift;
	return unless $self->can( 'get_recent_contributors' );
	my @contributors = $self->get_recent_contributors;
	$self->_print("Contributors since last release:\n") if @contributors;
	$self->_print( "\t", $_, "\n" ) for @contributors;
	}

=item get_release_date()

Return a string representing the current date and time (in UTC) in the
L<CPAN::Changes::Spec> format so that it can be added directly to the
Changes file.

=cut

sub get_release_date {
	state $rc = require Time::Piece;
	return Time::Piece->gmtime->datetime . 'Z';
	}

=item run

Run a command in the shell.

=item run_error

Returns true if the command ran successfully, and false otherwise. Use
this function in any other method that calls run to figure out what to
do when a command doesn't work. You may want to handle that yourself.

=cut

sub _run_error_reset { $_[0]->{_run_error} = 0 }
sub _run_error_set   { $_[0]->{_run_error} = 1 }
sub run_error        { $_[0]->{_run_error}     }

sub run {
	my( $self, @command ) = @_;
	@command = grep { defined } @command;

	$self->_run_error_reset;

	$self->_debug( "@command\n" );
	$self->_die( "Didn't get a command!" ) unless @command;

	my $pid = IPC::Open3::open3(
		my $child_in, my $child_out, my $child_err = gensym,
		@command
		);
	close $child_in;

	$child_out->autoflush;

	#open my($fh), "-|", "$command" or $self->_die( "Could not open command [$command]: $!" );
	#$fh->autoflush;

	my $output = '';
	my $error  = '';
	my $buffer = '';
	local $| = 1;

	my $readlen = $self->debug ? 1 : 256;

	while( read $child_out, $buffer, $readlen ) {
		$self->_debug( $_, $buffer );
		$output .= $buffer;
		}

	while( read $child_err, $buffer, $readlen ) {
		$self->_debug( $_, $buffer );
		$error .= $buffer;
		}

	if( $error =~ m/exec of .*? failed| Windows/x ) {
		$self->_warn( "Could not run <$command[0]>: $error" );
		}
	$self->_debug( $self->_dashes, "\n" );