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);
require IMPL::Class::Property::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);
}

sub _PropertyImplementor {
	'IMPL::Class::Property::Accessor'
}

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;