comparison lib/IMPL/Exception.pm @ 407:c6e90e02dd17 ref20150831

renamed Lib->lib
author cin
date Fri, 04 Sep 2015 19:40:23 +0300
parents
children
comparison
equal deleted inserted replaced
406:f23fcb19d3c1 407:c6e90e02dd17
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;