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