]>
Commit | Line | Data |
---|---|---|
e143e9d8 DM |
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}; | |
710d2994 DM |
18 | use overload 'cmp' => sub { |
19 | my ($a, $b) = @_; | |
20 | local $@; | |
21 | return "$a" cmp "$b"; # compare as string | |
22 | }; | |
e143e9d8 | 23 | |
8c77914e | 24 | @EXPORT_OK = qw(raise raise_param_exc raise_perm_exc); |
e143e9d8 DM |
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 | ||
8c77914e DM |
56 | sub raise_perm_exc { |
57 | my ($what) = @_; | |
58 | ||
59 | my $param = { code => HTTP_FORBIDDEN }; | |
60 | ||
61 | my $msg = "Permission check failed"; | |
62 | ||
63 | $msg .= " ($what)" if $what; | |
64 | ||
65 | my $exc = PVE::Exception->new("$msg\n", %$param); | |
66 | ||
67 | my ($pkg, $filename, $line) = caller; | |
68 | ||
69 | $exc->{filename} = $filename; | |
70 | $exc->{line} = $line; | |
71 | ||
72 | die $exc; | |
73 | } | |
74 | ||
e143e9d8 DM |
75 | sub is_param_exc { |
76 | my ($self) = @_; | |
77 | ||
78 | return $self->{code} && $self->{code} eq HTTP_BAD_REQUEST; | |
79 | } | |
80 | ||
81 | sub raise_param_exc { | |
82 | my ($errors, $usage) = @_; | |
83 | ||
84 | my $param = { | |
85 | code => HTTP_BAD_REQUEST, | |
86 | errors => $errors, | |
87 | }; | |
88 | ||
89 | $param->{usage} = $usage if $usage; | |
90 | ||
91 | my $exc = PVE::Exception->new("Parameter verification failed.\n", %$param); | |
92 | ||
93 | my ($pkg, $filename, $line) = caller; | |
94 | ||
95 | $exc->{filename} = $filename; | |
96 | $exc->{line} = $line; | |
97 | ||
98 | die $exc; | |
99 | } | |
100 | ||
101 | sub stringify { | |
102 | my $self = shift; | |
103 | ||
104 | my $msg = $self->{code} ? "$self->{code} $self->{msg}" : $self->{msg}; | |
105 | ||
106 | if ($msg !~ m/\n$/) { | |
107 | ||
108 | if ($self->{filename} && $self->{line}) { | |
109 | $msg .= " at $self->{filename} line $self->{line}"; | |
110 | } | |
111 | ||
112 | $msg .= "\n"; | |
113 | } | |
114 | ||
115 | if ($self->{errors}) { | |
116 | foreach my $e (keys %{$self->{errors}}) { | |
117 | $msg .= "$e: $self->{errors}->{$e}\n"; | |
118 | } | |
119 | } | |
120 | ||
121 | if ($self->{propagate}) { | |
122 | foreach my $pi (@{$self->{propagate}}) { | |
123 | $msg .= "\t...propagated at $pi->[0] line $pi->[1]\n"; | |
124 | } | |
125 | } | |
126 | ||
127 | if ($self->{usage}) { | |
128 | $msg .= $self->{usage}; | |
129 | $msg .= "\n" if $msg !~ m/\n$/; | |
130 | } | |
131 | ||
132 | return $msg; | |
133 | } | |
134 | ||
135 | sub PROPAGATE { | |
136 | my ($self, $file, $line) = @_; | |
137 | ||
138 | push @{$self->{propagate}}, [$file, $line]; | |
139 | ||
140 | return $self; | |
141 | } | |
142 | ||
143 | 1; |