]>
Commit | Line | Data |
---|---|---|
565bbc73 DM |
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; |