PVE/APIClient/Exception.pm

   1 package PVE::APIClient::Exception;
   2
   3 # a way to add more information to exceptions (see man perlfunc (die))
   4 # use PVE::APIClient::Exception qw(raise);
   5 # raise ("my error message", code => 400, errors => { param1 => "err1", ...} );
   6
   7 use strict;
   8 use warnings;
   9
  10 use base 'Exporter';
  11
  12 use Storable qw(dclone);
  13 use HTTP::Status qw(:constants);
  14
  15 use overload '""' => sub {local $@; shift->stringify};
  16 use overload 'cmp' => sub {
  17     my ($a, $b) = @_;
  18     local $@;
  19     return "$a" cmp "$b"; # compare as string
  20 };
  21
  22 our @EXPORT_OK = qw(raise);
  23
  24 sub new {
  25     my ($class, $msg, %param) = @_;
  26
  27     $class = ref($class) || $class;
  28
  29     my $self = {
  30         msg => $msg,
  31     };
  32
  33     foreach my $p (keys %param) {
  34         next if defined($self->{$p});
  35         my $v = $param{$p};
  36         $self->{$p} = ref($v) ? dclone($v) : $v;
  37     }
  38
  39     return bless $self;
  40 }
  41
  42 sub raise {
  43
  44     my $exc = PVE::APIClient::Exception->new(@_);
  45
  46     my ($pkg, $filename, $line) = caller;
  47
  48     $exc->{filename} = $filename;
  49     $exc->{line} = $line;
  50
  51     die $exc;
  52 }
  53
  54 sub stringify {
  55     my $self = shift;
  56
  57     my $msg = $self->{code} ? "$self->{code} $self->{msg}" : $self->{msg};
  58
  59     if ($msg !~ m/\n$/) {
  60         if ($self->{filename} && $self->{line}) {
  61             $msg .= " at $self->{filename} line $self->{line}";
  62         }
  63         $msg .= "\n";
  64     }
  65
  66     if ($self->{errors}) {
  67         foreach my $e (keys %{$self->{errors}}) {
  68             $msg .= "$e: $self->{errors}->{$e}\n";
  69         }
  70     }
  71
  72     if ($self->{propagate}) {
  73         foreach my $pi (@{$self->{propagate}}) {
  74             $msg .= "\t...propagated at $pi->[0] line $pi->[1]\n";
  75         }
  76     }
  77
  78     if ($self->{usage}) {
  79         $msg .= $self->{usage};
  80         $msg .= "\n" if $msg !~ m/\n$/;
  81     }
  82
  83     return $msg;
  84 }
  85
  86 sub PROPAGATE {
  87     my ($self, $file, $line) = @_;
  88
  89     push @{$self->{propagate}}, [$file, $line];
  90
  91     return $self;
  92 }
  93
  94 1;