Mercurial > pub > Impl
annotate Lib/IMPL/Exception.pm @ 379:a471e8b77544
sync
| author | cin |
|---|---|
| date | Thu, 16 Jan 2014 18:10:50 +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; |