remove + from getopt's prefix_pattern
[pve-common.git] / src / PVE / Exception.pm
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;