summaryrefslogtreecommitdiff
path: root/perl
diff options
context:
space:
mode:
authorPetr Baudis <pasky@suse.cz>2006-06-24 02:34:42 (GMT)
committerJunio C Hamano <junkio@cox.net>2006-07-03 00:14:40 (GMT)
commit97b16c067492506287a6f474e79ef6cbe0a30e49 (patch)
tree4966560d51c8e23cc3c9467c322d273fae945905 /perl
parent5c4082fd687bd0784d3a4d96550e8afab332b63a (diff)
downloadgit-97b16c067492506287a6f474e79ef6cbe0a30e49.zip
git-97b16c067492506287a6f474e79ef6cbe0a30e49.tar.gz
git-97b16c067492506287a6f474e79ef6cbe0a30e49.tar.bz2
Git.pm: Better error handling
So far, errors just killed the whole program and in case of an error inside of libgit it would be totally uncatchable. This patch makes Git.pm throw standard Perl exceptions instead. In the future we might subclass Error to Git::Error or something but for now Error::Simple is more than enough. Signed-off-by: Petr Baudis <pasky@suse.cz> Signed-off-by: Junio C Hamano <junkio@cox.net>
Diffstat (limited to 'perl')
-rw-r--r--perl/Git.pm37
-rw-r--r--perl/Git.xs39
2 files changed, 60 insertions, 16 deletions
diff --git a/perl/Git.pm b/perl/Git.pm
index dcd769b..733fec9 100644
--- a/perl/Git.pm
+++ b/perl/Git.pm
@@ -88,7 +88,8 @@ increate nonwithstanding).
=cut
-use Carp qw(carp croak);
+use Carp qw(carp); # croak is bad - throw instead
+use Error qw(:try);
require XSLoader;
XSLoader::load('Git', $VERSION);
@@ -143,14 +144,14 @@ sub repository {
if (defined $args[0]) {
if ($#args % 2 != 1) {
# Not a hash.
- $#args == 0 or croak "bad usage";
- %opts = (Directory => $args[0]);
+ $#args == 0 or throw Error::Simple("bad usage");
+ %opts = ( Directory => $args[0] );
} else {
%opts = @args;
}
if ($opts{Directory}) {
- -d $opts{Directory} or croak "Directory not found: $!";
+ -d $opts{Directory} or throw Error::Simple("Directory not found: $!");
if (-d $opts{Directory}."/.git") {
# TODO: Might make this more clever
$opts{WorkingCopy} = $opts{Directory};
@@ -242,11 +243,11 @@ read.
sub command_pipe {
my ($self, $cmd, @args) = _maybe_self(@_);
- $cmd =~ /^[a-z0-9A-Z_-]+$/ or croak "bad command: $cmd";
+ $cmd =~ /^[a-z0-9A-Z_-]+$/ or throw Error::Simple("bad command: $cmd");
my $pid = open(my $fh, "-|");
if (not defined $pid) {
- croak "open failed: $!";
+ throw Error::Simple("open failed: $!");
} elsif ($pid == 0) {
_cmd_exec($self, $cmd, @args);
}
@@ -271,16 +272,17 @@ The function returns only after the command has finished running.
sub command_noisy {
my ($self, $cmd, @args) = _maybe_self(@_);
- $cmd =~ /^[a-z0-9A-Z_-]+$/ or croak "bad command: $cmd";
+ $cmd =~ /^[a-z0-9A-Z_-]+$/ or throw Error::Simple("bad command: $cmd");
my $pid = fork;
if (not defined $pid) {
- croak "fork failed: $!";
+ throw Error::Simple("fork failed: $!");
} elsif ($pid == 0) {
_cmd_exec($self, $cmd, @args);
}
if (waitpid($pid, 0) > 0 and $? != 0) {
- croak "exit status: $?";
+ # This is the best candidate for a custom exception class.
+ throw Error::Simple("exit status: $?");
}
}
@@ -340,10 +342,10 @@ are involved.
=back
-=head1 TODO
+=head1 ERROR HANDLING
-This is still fairly crude.
-We need some good way to report errors back except just dying.
+All functions are supposed to throw Perl exceptions in case of errors.
+See L<Error>.
=head1 COPYRIGHT
@@ -372,8 +374,8 @@ sub _cmd_exec {
$self->{opts}->{Repository} and $ENV{'GIT_DIR'} = $self->{opts}->{Repository};
$self->{opts}->{WorkingCopy} and chdir($self->{opts}->{WorkingCopy});
}
- xs__execv_git_cmd(@args);
- croak "exec failed: $!";
+ _execv_git_cmd(@args);
+ die "exec failed: $!";
}
# Execute the given Git command ($_[0]) with arguments ($_[1..])
@@ -388,7 +390,8 @@ sub _cmd_close {
# It's just close, no point in fatalities
carp "error closing pipe: $!";
} elsif ($? >> 8) {
- croak "exit status: ".($? >> 8);
+ # This is the best candidate for a custom exception class.
+ throw Error::Simple("exit status: ".($? >> 8));
}
# else we might e.g. closed a live stream; the command
# dying of SIGPIPE would drive us here.
@@ -415,6 +418,8 @@ sub _call_gate {
#xs_call_gate($self->{opts}->{Repository});
}
+ # Having to call throw from the C code is a sure path to insanity.
+ local $SIG{__DIE__} = sub { throw Error::Simple("@_"); };
&$xsfunc(@args);
}
@@ -422,7 +427,7 @@ sub AUTOLOAD {
my $xsname;
our $AUTOLOAD;
($xsname = $AUTOLOAD) =~ s/.*:://;
- croak "&Git::$xsname not defined" if $xsname =~ /^xs_/;
+ throw Error::Simple("&Git::$xsname not defined") if $xsname =~ /^xs_/;
$xsname = 'xs_'.$xsname;
_call_gate(\&$xsname, @_);
}
diff --git a/perl/Git.xs b/perl/Git.xs
index d4608eb..9d247b7 100644
--- a/perl/Git.xs
+++ b/perl/Git.xs
@@ -8,6 +8,8 @@
#include "../cache.h"
#include "../exec_cmd.h"
+#define die perlyshadow_die__
+
/* XS and Perl interface */
#include "EXTERN.h"
#include "perl.h"
@@ -15,11 +17,48 @@
#include "ppport.h"
+#undef die
+
+
+static char *
+report_xs(const char *prefix, const char *err, va_list params)
+{
+ static char buf[4096];
+ strcpy(buf, prefix);
+ vsnprintf(buf + strlen(prefix), 4096 - strlen(prefix), err, params);
+ return buf;
+}
+
+void
+die_xs(const char *err, va_list params)
+{
+ char *str;
+ str = report_xs("fatal: ", err, params);
+ croak(str);
+}
+
+int
+error_xs(const char *err, va_list params)
+{
+ char *str;
+ str = report_xs("error: ", err, params);
+ warn(str);
+ return -1;
+}
+
MODULE = Git PACKAGE = Git
PROTOTYPES: DISABLE
+
+BOOT:
+{
+ set_error_routine(error_xs);
+ set_die_routine(die_xs);
+}
+
+
# /* TODO: xs_call_gate(). See Git.pm. */