view release on metacpan or  search on metacpan

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

}




######################################################################
# Support Methods

# Is a particular program installed, and where
sub which {
	my $self    = shift;
	my $program = shift;
	my ($location) = (`which $program`);
	chomp $location;
	unless ( $location ) {
		$self->error("Can't find the required program '$program'. Please install it");
	}
	unless ( -r $location and -x $location ) {
		$self->error("The required program '$program' is installed, but I do not have permission to read or execute it");
	}
	return $location;
}

sub copy {
	my $self = shift;
	my $from = shift;
	my $to   = shift;
	File::Flat->copy( $from => $to ) and return 1;
	$self->error("Failed to copy '$from' to '$to'");
}

sub move {
	my $self = shift;
	my $from = shift;
	my $to   = shift;
	File::Flat->copy( $from => $to ) and return 1;
	$self->error("Failed to move '$from' to '$to'");
}

sub remove {
	my $self = shift;
	my $path = shift;
	if ( -e $path ) {
		$self->sudo(
			"rm -rf $path",
			"Failed to remove '$path'"
		);
	}
	return 1;
}

sub sudo {
	my $self    = shift;
	my $message = pop @_;
	my $cmd     = join ' ', @_;
	my $env     = $self->env(
		ADAMK_RELEASE     => 1,
		RELEASE_TESTING   => $ENV{RELEASE_TESTING}   ? 1 : 0,
		AUTOMATED_TESTING => $ENV{AUTOMATED_TESTING} ? 1 : 0,
	);
	print "> (sudo) $cmd\n" if $self->verbose;
	my $sudo = $self->bin_sudo;
	my $rv   = ! system( "$sudo bash -c '$env $cmd'" );
	if ( $rv or ! @_ ) {
		return $rv;
	}
	$self->error($message);
}

sub shell {
	my $self    = shift;
	my $message = pop @_;
	my $cmd     = join ' ', @_;
	my $env     = $self->env(
		ADAMK_RELEASE     => 1,
		RELEASE_TESTING   => $ENV{RELEASE_TESTING}   ? 1 : 0,
		AUTOMATED_TESTING => $ENV{AUTOMATED_TESTING} ? 1 : 0,
	);
	print "> $cmd\n" if $self->verbose;
	my $rv = ! system( "$env $cmd" );
	if ( $rv or ! @_ ) {
		return $rv;
	}
	$self->error($message);
}

sub env {
	my $self = shift;
	my %env  = @_;
	join ' ', map { "$_=$env{$_}" } sort keys %env;
}

sub error {
	my $self    = shift;
	my $message = sprintf(shift, @_);
	Carp::croak($message);
}

sub prompt {
	my $self = shift;
	return IO::Prompt::Tiny::prompt(@_);
}

sub password {
	my $self     = shift;
	my $password = undef;
	if ( defined $_[0] ) {
		print "$_[0] ";
	}
	eval {
		Term::ReadKey::ReadMode('noecho');
		$password = <STDIN>;
	};
	Term::ReadKey::ReadMode(0);
	return undef if not defined $password;
	chomp($password);
	return $password;
}

1;

__END__

=head1 NAME

ADAMK::Release - 

=head1 DESCRIPTION

C<ADAMK::Release> is the backend behind the C<adamk-release> script that
is used to build distribution tarballs for modules with the minimalist
repository style.

=head1 AUTHORS

Adam Kennedy E<lt>adamk@cpan.orgE<gt>

=head1 SEE ALSO

L<http://ali.as/>

=head1 COPYRIGHT

Copyright 2013 Adam Kennedy.

This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.

The full text of the license can be found in the
LICENSE file included with this module.