rename data to src
[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;