Mercurial > pub > Impl
annotate Lib/IMPL/Exception.pm @ 245:7c517134c42f
Added Unsupported media type Web exception
corrected resourceLocation setting in the resource
Implemented localizable resources for text messages
fixed TT view scopings, INIT block in controls now sets globals correctly.
| author | sergey |
|---|---|
| date | Mon, 29 Oct 2012 03:15:22 +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; |