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;