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 <t.lamprecht@proxmox.com>
This commit is contained in:
Thomas Lamprecht 2017-12-14 11:12:04 +01:00 committed by Wolfgang Bumiller
parent 9c6d72b1b7
commit 6700b1517e
2 changed files with 95 additions and 0 deletions

View File

@ -21,6 +21,7 @@ deb ${DEB}:
install: install:
install -D -m 0644 PVE/APIClient/LWP.pm ${PERL5DIR}/PVE/APIClient/LWP.pm 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 -d -m 755 ${DOCDIR}/examples
install -m 0755 examples/example1.pl ${DOCDIR}/examples install -m 0755 examples/example1.pl ${DOCDIR}/examples
install -m 0755 examples/example2.pl ${DOCDIR}/examples install -m 0755 examples/example2.pl ${DOCDIR}/examples

View File

@ -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;