--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Exception.pm	Tue Jul 14 12:54:37 2009 +0400
@@ -0,0 +1,113 @@
+package IMPL::Exception;
+use strict;
+use overload
+    '""' => \&ToString,
+    'fallback' => 1;
+use Carp qw(longmess shortmess);
+use Scalar::Util qw(refaddr);
+
+BEGIN {
+	require Error;
+}
+
+use base qw(IMPL::Object::Accessor Error);
+
+BEGIN {
+    __PACKAGE__->mk_accessors( qw(Message Args CallStack Source) );
+}
+
+sub indent {
+    my ($str,$level) = @_;
+    $level ||= 0;
+    $str = '' unless defined $str;
+    join ("\n", map( "\t"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 . 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);
+__PACKAGE__->PassThroughArgs;
+
+package IMPL::DuplicateException;
+our @ISA = qw(IMPL::Exception);
+__PACKAGE__->PassThroughArgs;
+
+package IMPL::NotImplementedException;
+our @ISA = qw(IMPL::Exception);
+__PACKAGE__->PassThroughArgs;
+
+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" }
+);
+
+1;