|
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) = @_;
|
|
|
84 $this->Message . 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 __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
|
|
|
103 package Exception;
|
|
|
104 our @ISA = qw(IMPL::Exception);
|
|
|
105 __PACKAGE__->PassThroughArgs;
|
|
|
106
|
|
|
107 package IMPL::DeprecatedException;
|
|
|
108 our @ISA = qw(IMPL::Exception);
|
|
|
109 our %CTOR = (
|
|
|
110 'IMPL::Exception' => sub { @_ ? @_ : "The method is deprecated" }
|
|
|
111 );
|
|
|
112
|
|
|
113 1;
|
