bump version to 1.0-39
[pve-common.git] / data / PVE / Exception.pm
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 use overload 'cmp' => sub {
19 my ($a, $b) = @_;
20 local $@;
21 return "$a" cmp "$b"; # compare as string
22 };
23
24 @EXPORT_OK = qw(raise raise_param_exc raise_perm_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 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
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;