data/PVE/Exception.pm

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