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

renamed Lib->lib
author cin
date Fri, 04 Sep 2015 19:40:23 +0300
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/IMPL/Exception.pm	Fri Sep 04 19:40:23 2015 +0300
@@ -0,0 +1,141 @@
+package IMPL::Exception;
+use strict;
+use overload
+    '""' => \&ToString,
+    'fallback' => 1;
+use Carp qw(longmess shortmess);
+use Scalar::Util qw(refaddr);
+
+BEGIN {
+    require Error;
+}
+
+use parent qw(IMPL::Object::Abstract Error Class::Accessor);
+
+BEGIN {
+    __PACKAGE__->mk_accessors( qw(Message Args CallStack Source) );
+}
+
+sub indent {
+    my ($str,$level) = @_;
+    $level ||= 0;
+    $str = '' unless defined $str;
+    join ("\n", map( "    "x$level.$_ , split(/\n/,$str) ) );
+}
+
+sub new {
+    my $class = shift;
+    $class = ref $class || $class;
+    
+    my $this = $class->Error::new() or die "Failed to create an exception";
+    
+    $this->callCTOR(@_);
+    $this->{-text} = $this->Message;
+    
+    local $Carp::CarpLevel = 0;
+    
+    $this->CallStack(longmess);
+    $this->Source(shortmess);
+    
+    return $this;
+}
+
+sub CTOR {
+    my ($this,$message,@args) = @_;
+    $this->Message($message || '');
+    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;
+    $this->Args([map defined $_ ? $_ : 'undef', @args]);
+}
+
+sub save {
+    my ($this,$ctx) = @_;
+    
+    $ctx->AddVar(Message => $this->Message) if $this->Message;
+    $ctx->AddVar(Args => $this->Args) if @{$this->Args};
+    $ctx->AddVar(Source => $this->Source);
+    $ctx->AddVar(CallStack => $this->CallStack);
+}
+
+sub restore {
+    my ($class,$data,$instance) = @_;
+    
+    my %args = @$data;
+    
+    if ($instance) {
+        $instance->callCTOR($args{Message},@{$args{Args}});
+    } else {
+        $instance = $class->new($args{Message},@{$args{Args}});
+    }
+    
+    $instance->Source($args{Source});
+    $instance->CallStack($args{CallStack});
+    
+    return $instance;
+}
+
+sub ToString {
+    my $this = shift;
+    
+    $this->toString();
+}
+
+sub toString {
+    my ($this,$notrace) = @_;
+    ($this->Message || ref $this) . join("\n",'',map { my $s = $_; local $_; indent("$s",1) } @{$this->Args} ) . ( $notrace ? '' : "\n" . $this->CallStack);
+}
+
+package IMPL::InvalidOperationException;
+our @ISA = qw(IMPL::Exception);
+__PACKAGE__->PassThroughArgs;
+
+package IMPL::InvalidArgumentException;
+our @ISA = qw(IMPL::Exception);
+our %CTOR = (
+    'IMPL::Exception' => sub { "An invalid argument", @_ }
+);
+
+package IMPL::DuplicateException;
+our @ISA = qw(IMPL::Exception);
+__PACKAGE__->PassThroughArgs;
+
+package IMPL::KeyNotFoundException;
+our @ISA = qw(IMPL::Exception);
+__PACKAGE__->PassThroughArgs;
+
+our %CTOR = (
+    'IMPL::Exception' => sub { "A specified element isn't found", $_[0] } 
+);
+
+package IMPL::NotImplementedException;
+our @ISA = qw(IMPL::Exception);
+__PACKAGE__->PassThroughArgs;
+
+package IMPL::SecurityException;
+our @ISA = qw(IMPL::Exception);
+__PACKAGE__->PassThroughArgs;
+
+package IMPL::AccessDeniedException;
+our @ISA = qw(IMPL::SecurityException);
+our %CTOR = ( 'IMPL::SecurityException' => sub { 'Access denied' ,@_ } );
+
+package Exception;
+our @ISA = qw(IMPL::Exception);
+__PACKAGE__->PassThroughArgs;
+
+package IMPL::DeprecatedException;
+our @ISA = qw(IMPL::Exception);
+our %CTOR = (
+    'IMPL::Exception' => sub { @_ ? @_ : "The method is deprecated" }
+);
+
+package IMPL::WrongDataException;
+our @ISA = qw(IMPL::Exception);
+our %CTOR = (
+    'IMPL::Exception' => sub { "The input data is wrong", @_ }
+);
+
+package IMPL::IOException;
+our @ISA = qw(IMPL::Exception);
+__PACKAGE__->PassThroughArgs;
+
+1;