|
407
|
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 parent qw(IMPL::Object::Abstract Error Class::Accessor);
|
|
|
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( " "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) = @_;
|
|
|
84 ($this->Message || ref $this) . join("\n",'',map { my $s = $_; local $_; indent("$s",1) } @{$this->Args} ) . ( $notrace ? '' : "\n" . $this->CallStack);
|
|
|
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 our %CTOR = (
|
|
|
94 'IMPL::Exception' => sub { "An invalid argument", @_ }
|
|
|
95 );
|
|
|
96
|
|
|
97 package IMPL::DuplicateException;
|
|
|
98 our @ISA = qw(IMPL::Exception);
|
|
|
99 __PACKAGE__->PassThroughArgs;
|
|
|
100
|
|
|
101 package IMPL::KeyNotFoundException;
|
|
|
102 our @ISA = qw(IMPL::Exception);
|
|
|
103 __PACKAGE__->PassThroughArgs;
|
|
|
104
|
|
|
105 our %CTOR = (
|
|
|
106 'IMPL::Exception' => sub { "A specified element isn't found", $_[0] }
|
|
|
107 );
|
|
|
108
|
|
|
109 package IMPL::NotImplementedException;
|
|
|
110 our @ISA = qw(IMPL::Exception);
|
|
|
111 __PACKAGE__->PassThroughArgs;
|
|
|
112
|
|
|
113 package IMPL::SecurityException;
|
|
|
114 our @ISA = qw(IMPL::Exception);
|
|
|
115 __PACKAGE__->PassThroughArgs;
|
|
|
116
|
|
|
117 package IMPL::AccessDeniedException;
|
|
|
118 our @ISA = qw(IMPL::SecurityException);
|
|
|
119 our %CTOR = ( 'IMPL::SecurityException' => sub { 'Access denied' ,@_ } );
|
|
|
120
|
|
|
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
|
|
|
131 package IMPL::WrongDataException;
|
|
|
132 our @ISA = qw(IMPL::Exception);
|
|
|
133 our %CTOR = (
|
|
|
134 'IMPL::Exception' => sub { "The input data is wrong", @_ }
|
|
|
135 );
|
|
|
136
|
|
|
137 package IMPL::IOException;
|
|
|
138 our @ISA = qw(IMPL::Exception);
|
|
|
139 __PACKAGE__->PassThroughArgs;
|
|
|
140
|
|
|
141 1;
|
