src/PVE/APIClient/Exception.pm

   1 package PVE::APIClient::Exception;
   2
   3 # NOTE: derived from pve-common's PVE::Execption by copying and then:
   4 # sed -i 's/PVE::/PVE::APIClient::/g' Exception.pm
   5
   6 # a way to add more information to exceptions (see man perlfunc (die))
   7 # use PVE::APIClient::Exception qw(raise);
   8 # raise ("my error message", code => 400, errors => { param1 => "err1", ...} );
   9
  10 use strict;
  11 use warnings;
  12 use vars qw(@ISA @EXPORT_OK);
  13 require Exporter;
  14 use Storable qw(dclone);
  15 use HTTP::Status qw(:constants);
  16
  17 @ISA = qw(Exporter);
  18
  19 use overload '""' => sub {local $@; shift->stringify};
  20 use overload 'cmp' => sub {
  21     my ($a, $b) = @_;
  22     local $@;
  23     return "$a" cmp "$b"; # compare as string
  24 };
  25
  26 @EXPORT_OK = qw(raise raise_param_exc raise_perm_exc);
  27
  28 sub new {
  29     my ($class, $msg, %param) = @_;
  30
  31     $class = ref($class) || $class;
  32
  33     my $self = {
  34         msg => $msg,
  35     };
  36
  37     foreach my $p (keys %param) {
  38         next if defined($self->{$p});
  39         my $v = $param{$p};
  40         $self->{$p} = ref($v) ? dclone($v) : $v;
  41     }
  42
  43     return bless $self;
  44 }
  45
  46 sub raise {
  47
  48     my $exc = PVE::APIClient::Exception->new(@_);
  49
  50     my ($pkg, $filename, $line) = caller;
  51
  52     $exc->{filename} = $filename;
  53     $exc->{line} = $line;
  54
  55     die $exc;
  56 }
  57
  58 sub raise_perm_exc {
  59     my ($what) = @_;
  60
  61     my $param = { code => HTTP_FORBIDDEN };
  62
  63     my $msg = "Permission check failed";
  64
  65     $msg .= " ($what)" if $what;
  66
  67     my $exc = PVE::APIClient::Exception->new("$msg\n", %$param);
  68
  69     my ($pkg, $filename, $line) = caller;
  70
  71     $exc->{filename} = $filename;
  72     $exc->{line} = $line;
  73
  74     die $exc;
  75 }
  76
  77 sub is_param_exc {
  78     my ($self) = @_;
  79
  80     return $self->{code} && $self->{code} eq HTTP_BAD_REQUEST;
  81 }
  82
  83 sub raise_param_exc {
  84     my ($errors, $usage) = @_;
  85
  86     my $param = {
  87          code => HTTP_BAD_REQUEST,
  88          errors => $errors,
  89     };
  90
  91     $param->{usage} = $usage if $usage;
  92
  93     my $exc = PVE::APIClient::Exception->new("Parameter verification failed.\n", %$param);
  94
  95     my ($pkg, $filename, $line) = caller;
  96
  97     $exc->{filename} = $filename;
  98     $exc->{line} = $line;
  99
 100     die $exc;
 101 }
 102
 103 sub stringify {
 104     my $self = shift;
 105
 106     my $msg = $self->{msg};
 107     if (my $code = $self->{code}) {
 108         if ($msg !~ /^\s*\Q$code\E[\s:,]/) { # avoid duplicating the error code heuristically
 109             $msg = "$code $msg";
 110         }
 111     }
 112
 113     if ($msg !~ m/\n$/) {
 114
 115         if ($self->{filename} && $self->{line}) {
 116             $msg .= " at $self->{filename} line $self->{line}";
 117         }
 118
 119         $msg .= "\n";
 120     }
 121
 122     if ($self->{errors}) {
 123         foreach my $e (keys %{$self->{errors}}) {
 124             $msg .= "$e: $self->{errors}->{$e}\n";
 125         }
 126     }
 127
 128     if ($self->{propagate}) {
 129         foreach my $pi (@{$self->{propagate}}) {
 130             $msg .= "\t...propagated at $pi->[0] line $pi->[1]\n";
 131         }
 132     }
 133
 134     if ($self->{usage}) {
 135         $msg .= $self->{usage};
 136         $msg .= "\n" if $msg !~ m/\n$/;
 137     }
 138
 139     return $msg;
 140 }
 141
 142 sub PROPAGATE {
 143     my ($self, $file, $line) = @_;
 144
 145     push @{$self->{propagate}}, [$file, $line];
 146
 147     return $self;
 148 }
 149
 150 1;