]>
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 DM |
23 | |
24 | @EXPORT_OK = qw(raise raise_param_exc); | |
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 | ||
56 | sub is_param_exc { | |
57 | my ($self) = @_; | |
58 | ||
59 | return $self->{code} && $self->{code} eq HTTP_BAD_REQUEST; | |
60 | } | |
61 | ||
62 | sub raise_param_exc { | |
63 | my ($errors, $usage) = @_; | |
64 | ||
65 | my $param = { | |
66 | code => HTTP_BAD_REQUEST, | |
67 | errors => $errors, | |
68 | }; | |
69 | ||
70 | $param->{usage} = $usage if $usage; | |
71 | ||
72 | my $exc = PVE::Exception->new("Parameter verification failed.\n", %$param); | |
73 | ||
74 | my ($pkg, $filename, $line) = caller; | |
75 | ||
76 | $exc->{filename} = $filename; | |
77 | $exc->{line} = $line; | |
78 | ||
79 | die $exc; | |
80 | } | |
81 | ||
82 | sub stringify { | |
83 | my $self = shift; | |
84 | ||
85 | my $msg = $self->{code} ? "$self->{code} $self->{msg}" : $self->{msg}; | |
86 | ||
87 | if ($msg !~ m/\n$/) { | |
88 | ||
89 | if ($self->{filename} && $self->{line}) { | |
90 | $msg .= " at $self->{filename} line $self->{line}"; | |
91 | } | |
92 | ||
93 | $msg .= "\n"; | |
94 | } | |
95 | ||
96 | if ($self->{errors}) { | |
97 | foreach my $e (keys %{$self->{errors}}) { | |
98 | $msg .= "$e: $self->{errors}->{$e}\n"; | |
99 | } | |
100 | } | |
101 | ||
102 | if ($self->{propagate}) { | |
103 | foreach my $pi (@{$self->{propagate}}) { | |
104 | $msg .= "\t...propagated at $pi->[0] line $pi->[1]\n"; | |
105 | } | |
106 | } | |
107 | ||
108 | if ($self->{usage}) { | |
109 | $msg .= $self->{usage}; | |
110 | $msg .= "\n" if $msg !~ m/\n$/; | |
111 | } | |
112 | ||
113 | return $msg; | |
114 | } | |
115 | ||
116 | sub PROPAGATE { | |
117 | my ($self, $file, $line) = @_; | |
118 | ||
119 | push @{$self->{propagate}}, [$file, $line]; | |
120 | ||
121 | return $self; | |
122 | } | |
123 | ||
124 | 1; |