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