[pve-devel] [RFC apiclient 1/2] add APIClient/Exception.pm class

[Thomas Lamprecht]

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 at proxmox.com>
---
 Makefile                   |  1 +
 PVE/APIClient/Exception.pm | 94 ++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 95 insertions(+)
 create mode 100644 PVE/APIClient/Exception.pm

diff --git a/Makefile b/Makefile
index a53f8cb..5b2a1a6 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;
-- 
2.11.0