From: Thomas Lamprecht Date: Thu, 14 Dec 2017 10:12:04 +0000 (+0100) Subject: add APIClient/Exception.pm class X-Git-Url: https://git.proxmox.com/?p=pve-apiclient.git;a=commitdiff_plain;h=6700b1517efcf1fecbcb159ed734f000a305edc0 add APIClient/Exception.pm class As we do not want to depend on PVE libraries with this I forked of the PVE::Exception class, removed all raise_* methods so that only raise() itself was left over. Also some minor adaptions to newer style for exporting where used. Signed-off-by: Thomas Lamprecht --- diff --git a/Makefile b/Makefile index 799722a..9dcbdde 100644 --- a/Makefile +++ b/Makefile @@ -21,6 +21,7 @@ deb ${DEB}: install: install -D -m 0644 PVE/APIClient/LWP.pm ${PERL5DIR}/PVE/APIClient/LWP.pm + install -m 0644 PVE/APIClient/Exception.pm ${PERL5DIR}/PVE/APIClient/Exception.pm install -d -m 755 ${DOCDIR}/examples install -m 0755 examples/example1.pl ${DOCDIR}/examples install -m 0755 examples/example2.pl ${DOCDIR}/examples diff --git a/PVE/APIClient/Exception.pm b/PVE/APIClient/Exception.pm new file mode 100644 index 0000000..3f9843c --- /dev/null +++ b/PVE/APIClient/Exception.pm @@ -0,0 +1,94 @@ +package PVE::APIClient::Exception; + +# a way to add more information to exceptions (see man perlfunc (die)) +# use PVE::APIClient::Exception qw(raise); +# raise ("my error message", code => 400, errors => { param1 => "err1", ...} ); + +use strict; +use warnings; + +use base 'Exporter'; + +use Storable qw(dclone); +use HTTP::Status qw(:constants); + +use overload '""' => sub {local $@; shift->stringify}; +use overload 'cmp' => sub { + my ($a, $b) = @_; + local $@; + return "$a" cmp "$b"; # compare as string +}; + +our @EXPORT_OK = qw(raise); + +sub new { + my ($class, $msg, %param) = @_; + + $class = ref($class) || $class; + + my $self = { + msg => $msg, + }; + + foreach my $p (keys %param) { + next if defined($self->{$p}); + my $v = $param{$p}; + $self->{$p} = ref($v) ? dclone($v) : $v; + } + + return bless $self; +} + +sub raise { + + my $exc = PVE::APIClient::Exception->new(@_); + + my ($pkg, $filename, $line) = caller; + + $exc->{filename} = $filename; + $exc->{line} = $line; + + die $exc; +} + +sub stringify { + my $self = shift; + + my $msg = $self->{code} ? "$self->{code} $self->{msg}" : $self->{msg}; + + if ($msg !~ m/\n$/) { + if ($self->{filename} && $self->{line}) { + $msg .= " at $self->{filename} line $self->{line}"; + } + $msg .= "\n"; + } + + if ($self->{errors}) { + foreach my $e (keys %{$self->{errors}}) { + $msg .= "$e: $self->{errors}->{$e}\n"; + } + } + + if ($self->{propagate}) { + foreach my $pi (@{$self->{propagate}}) { + $msg .= "\t...propagated at $pi->[0] line $pi->[1]\n"; + } + } + + if ($self->{usage}) { + $msg .= $self->{usage}; + $msg .= "\n" if $msg !~ m/\n$/; + } + + return $msg; +} + +sub PROPAGATE { + my ($self, $file, $line) = @_; + + push @{$self->{propagate}}, [$file, $line]; + + return $self; +} + +1;