## Domain Registry Interface, Encapsulatng errors (fatal or not) as exceptions in an OO way
##
## Copyright (c) 2005 Patrick Mevzek <netdri@dotandco.com>. All rights reserved.
##
## This file is part of Net::DRI
##
## Net::DRI is free software; you can redistribute it and/or modify
## it under the terms of the GNU General Public License as published by
## the Free Software Foundation; either version 2 of the License, or
## (at your option) any later version.
##
## See the LICENSE file that comes with this distribution for more details.
#
#
#
#########################################################################################
use strict;
use Carp;
our $VERSION=do { my @r=(q$Revision: 1.5 $=~/\d+/g); sprintf("%d".".%02d" x $#r, @r); };
=pod
=head1 NAME
Net::DRI::Exception - Class to store all exceptions inside Net::DRI
=head1 SYNOPSIS
my $s=Net::DRI::Exception->new(0,'area',500,'message');
die($s);
## OR
Net::DRI::Exception->die(0,'area',500,'message');
$s->is_error(); ## gives 0 or 1, first argument of new/die
## (internal error that should not happen are 1, others are 0)
$s->area(); ## gives back the area (second argument of new/die)
$s->code(); ## gives back the code (third argument of new/die)
$s->msg(); ## gives back the message (fourth argument of new/die)
$s->as_string(); ## gives back a nicely formatted complete backtrace
=head1 SUPPORT
For now, support questions should be sent to:
E<lt>netdri@dotandco.comE<gt>
Please also see the SUPPORT file in the distribution.
=head1 SEE ALSO
=head1 AUTHOR
Patrick Mevzek, E<lt>netdri@dotandco.comE<gt>
=head1 COPYRIGHT
Copyright (c) 2005 Patrick Mevzek <netdri@dotandco.com>.
All rights reserved.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
See the LICENSE file that comes with this distribution for more details.
=cut
####################################################################
sub new
{
my $proto=shift;
my $class=ref($proto) || $proto;
my ($error,$area,$code,$msg)=@_;
my $self={ is_error => (defined($error)? $error : 1 ),
area => $area || '?',
code => $code || 0,
msg => $msg || '',
};
$self->{bt}=Carp::longmess();
bless($self,$class);
return $self;
}
sub die { die(new(@_)); }
sub is_error { return shift->{is_error}; }
sub area { return shift->{area}; }
sub code { return shift->{code}; }
sub msg { return shift->{msg}; }
sub backtrace
{
my $self=shift;
my $m=$self->{bt};
my (@bt1,@bt2);
foreach (split(/\n/,$m)) { if (/^\s*Net::DRI::Exception::/) { push @bt1,$_; } else { push @bt2,$_; } }
shift(@bt2) if ($bt2[0]=~m!Net/DRI/Exception!);
my ($f,$l);
if (@bt1)
{
($f,$l)=(pop(@bt1)=~m/ called at (\S+) line (\d+)\s*$/);
} else
{
($f,$l)=(shift(@bt2)=~m/ at (\S+) line (\d+)\s*$/);
}
my @b;
push @b,"EXCEPTION ".$self->code().'@'.$self->area()." from line $l of file $f:";
push @b,$self->msg();
return (@b,@bt2);
}
sub as_string
{
my $self=shift;
return join("\n",$self->backtrace())."\n";
}
sub print
{
print shift->as_string();
}
########################################################################
sub err_method_not_implemented { Net::DRI::Exception->die(1,'internal',1,"Method not implemented".($_[0]? ': '.$_[0] : '')); }
sub err_insufficient_parameters { Net::DRI::Exception->die(1,'internal',2,"Insufficient parameters".($_[0]? ': '.$_[0] : '')); }
sub err_invalid_parameters { Net::DRI::Exception->die(1,'internal',3,"Invalid parameters".($_[0]? ': '.$_[0] : '')); }
sub usererr_insufficient_parameters { Net::DRI::Exception->die(0,'internal',2,"Insufficient parameters".($_[0]? ': '.$_[0] : '')); }
sub usererr_invalid_parameters { Net::DRI::Exception->die(0,'internal',3,"Invalid parameters".($_[0]? ': '.$_[0] : '')); }
sub err_assert { Net::DRI::Exception->die(1,'internal',4,'Assert failed'.($_[0]? ': '.$_[0] : '')); }
####################################################################
1;