Mercurial > pub > Impl
annotate Lib/IMPL/Exception.pm @ 239:23daf2fae33a
*security subsytem bugfixes
*HttpResponse: cookies which values are set to undefined will be deleted from browser
| author | sergey |
|---|---|
| date | Tue, 16 Oct 2012 20:14:11 +0400 |
| parents | 5c82eec23bb6 |
| children | 4ddb27ff4a0b |
| 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); |
| 232 | 14 require IMPL::Class::Property::Accessor; |
| 49 | 15 |
| 16 BEGIN { | |
| 17 __PACKAGE__->mk_accessors( qw(Message Args CallStack Source) ); | |
| 18 } | |
| 19 | |
| 20 sub indent { | |
| 21 my ($str,$level) = @_; | |
| 22 $level ||= 0; | |
| 23 $str = '' unless defined $str; | |
| 206 | 24 join ("\n", map( " "x$level.$_ , split(/\n/,$str) ) ); |
| 49 | 25 } |
| 26 | |
| 27 sub new { | |
| 28 my $class = shift; | |
| 29 $class = ref $class || $class; | |
| 30 | |
| 31 my $this = $class->Error::new() or die "Failed to create an exception"; | |
| 32 | |
| 33 $this->callCTOR(@_); | |
| 34 $this->{-text} = $this->Message; | |
| 35 | |
| 36 local $Carp::CarpLevel = 0; | |
| 37 | |
| 38 $this->CallStack(longmess); | |
| 39 $this->Source(shortmess); | |
| 40 | |
| 41 return $this; | |
| 42 } | |
| 43 | |
| 44 sub CTOR { | |
| 45 my ($this,$message,@args) = @_; | |
| 46 $this->Message($message || ''); | |
| 47 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; | |
| 48 $this->Args([map defined $_ ? $_ : 'undef', @args]); | |
| 49 } | |
| 50 | |
| 51 sub save { | |
| 52 my ($this,$ctx) = @_; | |
| 53 | |
| 54 $ctx->AddVar(Message => $this->Message) if $this->Message; | |
| 55 $ctx->AddVar(Args => $this->Args) if @{$this->Args}; | |
| 56 $ctx->AddVar(Source => $this->Source); | |
| 57 $ctx->AddVar(CallStack => $this->CallStack); | |
| 58 } | |
| 59 | |
| 60 sub restore { | |
| 61 my ($class,$data,$instance) = @_; | |
| 62 | |
| 63 my %args = @$data; | |
| 64 | |
| 65 if ($instance) { | |
| 66 $instance->callCTOR($args{Message},@{$args{Args}}); | |
| 67 } else { | |
| 68 $instance = $class->new($args{Message},@{$args{Args}}); | |
| 69 } | |
| 70 | |
| 71 $instance->Source($args{Source}); | |
| 72 $instance->CallStack($args{CallStack}); | |
| 73 | |
| 74 return $instance; | |
| 75 } | |
| 76 | |
| 77 sub ToString { | |
| 78 my $this = shift; | |
| 79 | |
| 80 $this->toString(); | |
| 81 } | |
| 82 | |
| 83 sub toString { | |
| 84 my ($this,$notrace) = @_; | |
|
63
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
49
diff
changeset
|
85 ($this->Message || ref $this) . join("\n",'',map { my $s = $_; local $_; indent("$s",1) } @{$this->Args} ) . ( $notrace ? '' : "\n" . $this->CallStack); |
| 49 | 86 } |
| 87 | |
| 232 | 88 sub _PropertyImplementor { |
| 89 'IMPL::Class::Property::Accessor' | |
| 90 } | |
| 91 | |
| 49 | 92 package IMPL::InvalidOperationException; |
| 93 our @ISA = qw(IMPL::Exception); | |
| 94 __PACKAGE__->PassThroughArgs; | |
| 95 | |
| 96 package IMPL::InvalidArgumentException; | |
| 97 our @ISA = qw(IMPL::Exception); | |
|
197
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
194
diff
changeset
|
98 our %CTOR = ( |
|
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
194
diff
changeset
|
99 'IMPL::Exception' => sub { "An invalid argument", @_ } |
|
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
194
diff
changeset
|
100 ); |
| 49 | 101 |
| 102 package IMPL::DuplicateException; | |
| 103 our @ISA = qw(IMPL::Exception); | |
| 104 __PACKAGE__->PassThroughArgs; | |
| 105 | |
| 181 | 106 package IMPL::KeyNotFoundException; |
| 107 our @ISA = qw(IMPL::Exception); | |
| 108 __PACKAGE__->PassThroughArgs; | |
| 109 | |
| 110 our %CTOR = ( | |
| 194 | 111 'IMPL::Exception' => sub { "A specified element isn't found", $_[0] } |
| 181 | 112 ); |
| 113 | |
| 49 | 114 package IMPL::NotImplementedException; |
| 115 our @ISA = qw(IMPL::Exception); | |
| 116 __PACKAGE__->PassThroughArgs; | |
| 117 | |
| 94 | 118 package IMPL::SecurityException; |
| 119 our @ISA = qw(IMPL::Exception); | |
| 120 __PACKAGE__->PassThroughArgs; | |
| 121 | |
| 97 | 122 package IMPL::AccessDeniedException; |
| 123 our @ISA = qw(IMPL::SecurityException); | |
| 124 our %CTOR = ( 'IMPL::SecurityException' => sub { 'Access denied' ,@_ } ); | |
| 125 | |
| 49 | 126 package Exception; |
| 127 our @ISA = qw(IMPL::Exception); | |
| 128 __PACKAGE__->PassThroughArgs; | |
| 129 | |
| 130 package IMPL::DeprecatedException; | |
| 131 our @ISA = qw(IMPL::Exception); | |
| 132 our %CTOR = ( | |
| 133 'IMPL::Exception' => sub { @_ ? @_ : "The method is deprecated" } | |
| 134 ); | |
| 135 | |
|
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
|
136 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
|
137 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
|
138 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
|
139 '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
|
140 ); |
|
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
|
141 |
| 131 | 142 package IMPL::IOException; |
| 143 our @ISA = qw(IMPL::Exception); | |
| 144 __PACKAGE__->PassThroughArgs; | |
| 145 | |
| 49 | 146 1; |