Mercurial > pub > Impl
annotate Lib/IMPL/Exception.pm @ 393:69a1f1508696
minor security refactoring
author | cin |
---|---|
date | Fri, 14 Feb 2014 16:41:12 +0400 |
parents | 4ddb27ff4a0b |
children |
rev | line source |
---|---|
49 | 1 package IMPL::Exception; |
2 use strict; | |
3 use overload | |
4 '""' => \&ToString, | |
5 'fallback' => 1; | |
6 use Carp qw(longmess shortmess); | |
7 use Scalar::Util qw(refaddr); | |
8 | |
9 BEGIN { | |
194 | 10 require Error; |
49 | 11 } |
12 | |
230 | 13 use parent qw(IMPL::Object::Abstract Error Class::Accessor); |
49 | 14 |
15 BEGIN { | |
16 __PACKAGE__->mk_accessors( qw(Message Args CallStack Source) ); | |
17 } | |
18 | |
19 sub indent { | |
20 my ($str,$level) = @_; | |
21 $level ||= 0; | |
22 $str = '' unless defined $str; | |
206 | 23 join ("\n", map( " "x$level.$_ , split(/\n/,$str) ) ); |
49 | 24 } |
25 | |
26 sub new { | |
27 my $class = shift; | |
28 $class = ref $class || $class; | |
29 | |
30 my $this = $class->Error::new() or die "Failed to create an exception"; | |
31 | |
32 $this->callCTOR(@_); | |
33 $this->{-text} = $this->Message; | |
34 | |
35 local $Carp::CarpLevel = 0; | |
36 | |
37 $this->CallStack(longmess); | |
38 $this->Source(shortmess); | |
39 | |
40 return $this; | |
41 } | |
42 | |
43 sub CTOR { | |
44 my ($this,$message,@args) = @_; | |
45 $this->Message($message || ''); | |
46 die new IMPL::Exception("Fatal erorr: cyclic structure in the exceptions were detected, do not use \$\@ while throwing the exception!") if grep ref $_ ? refaddr($this) == refaddr($_) : 0 , @args; | |
47 $this->Args([map defined $_ ? $_ : 'undef', @args]); | |
48 } | |
49 | |
50 sub save { | |
51 my ($this,$ctx) = @_; | |
52 | |
53 $ctx->AddVar(Message => $this->Message) if $this->Message; | |
54 $ctx->AddVar(Args => $this->Args) if @{$this->Args}; | |
55 $ctx->AddVar(Source => $this->Source); | |
56 $ctx->AddVar(CallStack => $this->CallStack); | |
57 } | |
58 | |
59 sub restore { | |
60 my ($class,$data,$instance) = @_; | |
61 | |
62 my %args = @$data; | |
63 | |
64 if ($instance) { | |
65 $instance->callCTOR($args{Message},@{$args{Args}}); | |
66 } else { | |
67 $instance = $class->new($args{Message},@{$args{Args}}); | |
68 } | |
69 | |
70 $instance->Source($args{Source}); | |
71 $instance->CallStack($args{CallStack}); | |
72 | |
73 return $instance; | |
74 } | |
75 | |
76 sub ToString { | |
77 my $this = shift; | |
78 | |
79 $this->toString(); | |
80 } | |
81 | |
82 sub toString { | |
83 my ($this,$notrace) = @_; | |
63
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
49
diff
changeset
|
84 ($this->Message || ref $this) . join("\n",'',map { my $s = $_; local $_; indent("$s",1) } @{$this->Args} ) . ( $notrace ? '' : "\n" . $this->CallStack); |
49 | 85 } |
86 | |
87 package IMPL::InvalidOperationException; | |
88 our @ISA = qw(IMPL::Exception); | |
89 __PACKAGE__->PassThroughArgs; | |
90 | |
91 package IMPL::InvalidArgumentException; | |
92 our @ISA = qw(IMPL::Exception); | |
197
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
194
diff
changeset
|
93 our %CTOR = ( |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
194
diff
changeset
|
94 'IMPL::Exception' => sub { "An invalid argument", @_ } |
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
194
diff
changeset
|
95 ); |
49 | 96 |
97 package IMPL::DuplicateException; | |
98 our @ISA = qw(IMPL::Exception); | |
99 __PACKAGE__->PassThroughArgs; | |
100 | |
181 | 101 package IMPL::KeyNotFoundException; |
102 our @ISA = qw(IMPL::Exception); | |
103 __PACKAGE__->PassThroughArgs; | |
104 | |
105 our %CTOR = ( | |
194 | 106 'IMPL::Exception' => sub { "A specified element isn't found", $_[0] } |
181 | 107 ); |
108 | |
49 | 109 package IMPL::NotImplementedException; |
110 our @ISA = qw(IMPL::Exception); | |
111 __PACKAGE__->PassThroughArgs; | |
112 | |
94 | 113 package IMPL::SecurityException; |
114 our @ISA = qw(IMPL::Exception); | |
115 __PACKAGE__->PassThroughArgs; | |
116 | |
97 | 117 package IMPL::AccessDeniedException; |
118 our @ISA = qw(IMPL::SecurityException); | |
119 our %CTOR = ( 'IMPL::SecurityException' => sub { 'Access denied' ,@_ } ); | |
120 | |
49 | 121 package Exception; |
122 our @ISA = qw(IMPL::Exception); | |
123 __PACKAGE__->PassThroughArgs; | |
124 | |
125 package IMPL::DeprecatedException; | |
126 our @ISA = qw(IMPL::Exception); | |
127 our %CTOR = ( | |
128 'IMPL::Exception' => sub { @_ ? @_ : "The method is deprecated" } | |
129 ); | |
130 | |
127
0dce0470a3d8
In the IMPL::Web::ControllerUnit added the ability to notify a form about a wrong data from a transaction
wizard
parents:
97
diff
changeset
|
131 package IMPL::WrongDataException; |
0dce0470a3d8
In the IMPL::Web::ControllerUnit added the ability to notify a form about a wrong data from a transaction
wizard
parents:
97
diff
changeset
|
132 our @ISA = qw(IMPL::Exception); |
0dce0470a3d8
In the IMPL::Web::ControllerUnit added the ability to notify a form about a wrong data from a transaction
wizard
parents:
97
diff
changeset
|
133 our %CTOR = ( |
0dce0470a3d8
In the IMPL::Web::ControllerUnit added the ability to notify a form about a wrong data from a transaction
wizard
parents:
97
diff
changeset
|
134 'IMPL::Exception' => sub { "The input data is wrong", @_ } |
0dce0470a3d8
In the IMPL::Web::ControllerUnit added the ability to notify a form about a wrong data from a transaction
wizard
parents:
97
diff
changeset
|
135 ); |
0dce0470a3d8
In the IMPL::Web::ControllerUnit added the ability to notify a form about a wrong data from a transaction
wizard
parents:
97
diff
changeset
|
136 |
131 | 137 package IMPL::IOException; |
138 our @ISA = qw(IMPL::Exception); | |
139 __PACKAGE__->PassThroughArgs; | |
140 | |
49 | 141 1; |