--- /dev/null
+package PVE::Exception;
+
+# a way to add more information to exceptions (see man perlfunc (die))
+# use PVE::Exception qw(raise);
+# raise ("my error message", code => 400, errors => { param1 => "err1", ...} );
+
+use strict;
+use warnings;
+use vars qw(@ISA @EXPORT_OK);
+require Exporter;
+use Storable qw(dclone);
+use HTTP::Status qw(:constants);
+
+@ISA = qw(Exporter);
+
+use overload '""' => sub {local $@; shift->stringify};
+use overload 'cmp' => sub {
+ my ($a, $b) = @_;
+ local $@;
+ return "$a" cmp "$b"; # compare as string
+};
+
+@EXPORT_OK = qw(raise raise_param_exc raise_perm_exc);
+
+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::Exception->new(@_);
+
+ my ($pkg, $filename, $line) = caller;
+
+ $exc->{filename} = $filename;
+ $exc->{line} = $line;
+
+ die $exc;
+}
+
+sub raise_perm_exc {
+ my ($what) = @_;
+
+ my $param = { code => HTTP_FORBIDDEN };
+
+ my $msg = "Permission check failed";
+
+ $msg .= " ($what)" if $what;
+
+ my $exc = PVE::Exception->new("$msg\n", %$param);
+
+ my ($pkg, $filename, $line) = caller;
+
+ $exc->{filename} = $filename;
+ $exc->{line} = $line;
+
+ die $exc;
+}
+
+sub is_param_exc {
+ my ($self) = @_;
+
+ return $self->{code} && $self->{code} eq HTTP_BAD_REQUEST;
+}
+
+sub raise_param_exc {
+ my ($errors, $usage) = @_;
+
+ my $param = {
+ code => HTTP_BAD_REQUEST,
+ errors => $errors,
+ };
+
+ $param->{usage} = $usage if $usage;
+
+ my $exc = PVE::Exception->new("Parameter verification failed.\n", %$param);
+
+ 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;