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;