Mercurial > pub > Impl
annotate Lib/IMPL/Exception.pm @ 130:06a34c197b05
Added support for utf-8 and old versions of CGI module
| author | wizard |
|---|---|
| date | Wed, 16 Jun 2010 01:50:56 +0400 |
| parents | 0dce0470a3d8 |
| children | 3df87ee58bee |
| 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 { | |
| 10 require Error; | |
| 11 } | |
| 12 | |
| 13 use base qw(IMPL::Object::Accessor Error); | |
| 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; | |
| 23 join ("\n", map( "\t"x$level.$_ , split(/\n/,$str) ) ); | |
| 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); | |
| 93 __PACKAGE__->PassThroughArgs; | |
| 94 | |
| 95 package IMPL::DuplicateException; | |
| 96 our @ISA = qw(IMPL::Exception); | |
| 97 __PACKAGE__->PassThroughArgs; | |
| 98 | |
| 99 package IMPL::NotImplementedException; | |
| 100 our @ISA = qw(IMPL::Exception); | |
| 101 __PACKAGE__->PassThroughArgs; | |
| 102 | |
| 94 | 103 package IMPL::SecurityException; |
| 104 our @ISA = qw(IMPL::Exception); | |
| 105 __PACKAGE__->PassThroughArgs; | |
| 106 | |
| 97 | 107 package IMPL::AccessDeniedException; |
| 108 our @ISA = qw(IMPL::SecurityException); | |
| 109 our %CTOR = ( 'IMPL::SecurityException' => sub { 'Access denied' ,@_ } ); | |
| 110 | |
| 49 | 111 package Exception; |
| 112 our @ISA = qw(IMPL::Exception); | |
| 113 __PACKAGE__->PassThroughArgs; | |
| 114 | |
| 115 package IMPL::DeprecatedException; | |
| 116 our @ISA = qw(IMPL::Exception); | |
| 117 our %CTOR = ( | |
| 118 'IMPL::Exception' => sub { @_ ? @_ : "The method is deprecated" } | |
| 119 ); | |
| 120 | |
|
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
|
121 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
|
122 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
|
123 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
|
124 '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
|
125 ); |
|
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
|
126 |
| 49 | 127 1; |