data/PVE/Exception.pm

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