view release on metacpan or  search on metacpan

lib/App/gh/Git.pm  view on Meta::CPAN

=cut

sub temp_path {
	my ($self, $temp_fd) = _maybe_self(@_);

	if (exists $TEMP_FILEMAP{$temp_fd}) {
		$temp_fd = $TEMP_FILEMAP{$temp_fd};
	}
	$TEMP_FILES{$temp_fd}{fname};
}

sub END {
	unlink values %TEMP_FILEMAP if %TEMP_FILEMAP;
}

} # %TEMP_* Lexical Context

=back

=head1 ERROR HANDLING

All functions are supposed to throw Perl exceptions in case of errors.
See the L<Error> module on how to catch those. Most exceptions are mere
L<Error::Simple> instances.

However, the C<command()>, C<command_oneline()> and C<command_noisy()>
functions suite can throw C<App::gh::Git::Error::Command> exceptions as well: those are
thrown when the external command returns an error code and contain the error
code as well as access to the captured command's output. The exception class
provides the usual C<stringify> and C<value> (command's exit code) methods and
in addition also a C<cmd_output> method that returns either an array or a
string with the captured command output (depending on the original function
call context; C<command_noisy()> returns C<undef>) and $<cmdline> which
returns the command and its arguments (but without proper quoting).

Note that the C<command_*_pipe()> functions cannot throw this exception since
it has no idea whether the command failed or not. You will only find out
at the time you C<close> the pipe; if you want to have that automated,
use C<command_close_pipe()>, which can throw the exception.

=cut

{
	package App::gh::Git::Error::Command;

	@App::gh::Git::Error::Command::ISA = qw(Error);

	sub new {
		my $self = shift;
		my $cmdline = '' . shift;
		my $value = 0 + shift;
		my $outputref = shift;
		my(@args) = ();

		local $Error::Depth = $Error::Depth + 1;

		push(@args, '-cmdline', $cmdline);
		push(@args, '-value', $value);
		push(@args, '-outputref', $outputref);

		$self->SUPER::new(-text => 'command returned error', @args);
	}

	sub stringify {
		my $self = shift;
		my $text = $self->SUPER::stringify;
		$self->cmdline() . ': ' . $text . ': ' . $self->value() . "\n";
	}

	sub cmdline {
		my $self = shift;
		$self->{'-cmdline'};
	}

	sub cmd_output {
		my $self = shift;
		my $ref = $self->{'-outputref'};
		defined $ref or undef;
		if (ref $ref eq 'ARRAY') {
			return @$ref;
		} else { # SCALAR
			return $$ref;
		}
	}
}

=over 4

=item git_cmd_try { CODE } ERRMSG

This magical statement will automatically catch any C<App::gh::Git::Error::Command>
exceptions thrown by C<CODE> and make your program die with C<ERRMSG>
on its lips; the message will have %s substituted for the command line
and %d for the exit status. This statement is useful mostly for producing
more user-friendly error messages.

In case of no exception caught the statement returns C<CODE>'s return value.

Note that this is the only auto-exported function.

=cut

sub git_cmd_try(&$) {
	my ($code, $errmsg) = @_;
	my @result;
	my $err;
	my $array = wantarray;
	try {
		if ($array) {
			@result = &$code;
		} else {
			$result[0] = &$code;
		}
	} catch App::gh::Git::Error::Command with {
		my $E = shift;
		$err = $errmsg;
		$err =~ s/\%s/$E->cmdline()/ge;
		$err =~ s/\%d/$E->value()/ge;
		# We can't croak here since Error.pm would mangle
		# that to Error::Simple.
	};
	$err and croak $err;
	return $array ? @result : $result[0];
}