1## Domain Registry Interface, Encapsulatng errors (fatal or not) as exceptions in an OO way 2## 3## Copyright (c) 2005,2007,2008,2009 Patrick Mevzek <netdri@dotandco.com>. All rights reserved. 4## 5## This file is part of Net::DRI 6## 7## Net::DRI is free software; you can redistribute it and/or modify 8## it under the terms of the GNU General Public License as published by 9## the Free Software Foundation; either version 2 of the License, or 10## (at your option) any later version. 11## 12## See the LICENSE file that comes with this distribution for more details. 13# 14# 15# 16#################################################################################################### 17 18package Net::DRI::Exception; 19 20use strict; 21 22use Carp; 23 24our $VERSION=do { my @r=(q$Revision: 1.8 $=~/\d+/g); sprintf("%d".".%02d" x $#r, @r); }; 25 26=pod 27 28=head1 NAME 29 30Net::DRI::Exception - Class to store all exceptions inside Net::DRI 31 32=head1 SYNOPSIS 33 34 my $s=Net::DRI::Exception->new(0,'area',500,'message'); 35 die($s); 36 ## OR 37 Net::DRI::Exception->die(0,'area',500,'message'); 38 39 $s->is_error(); ## gives 0 or 1, first argument of new/die 40 ## (internal error that should not happen are 1, others are 0) 41 42 $s->area(); ## gives back the area (second argument of new/die) 43 44 $s->code(); ## gives back the code (third argument of new/die) 45 46 $s->msg(); ## gives back the message (fourth argument of new/die) 47 48 $s->as_string(); ## gives back a nicely formatted full backtrace 49 50=head1 SUPPORT 51 52For now, support questions should be sent to: 53 54E<lt>netdri@dotandco.comE<gt> 55 56Please also see the SUPPORT file in the distribution. 57 58=head1 SEE ALSO 59 60E<lt>http://www.dotandco.com/services/software/Net-DRI/E<gt> 61 62=head1 AUTHOR 63 64Patrick Mevzek, E<lt>netdri@dotandco.comE<gt> 65 66=head1 COPYRIGHT 67 68Copyright (c) 2005,2007,2008,2009 Patrick Mevzek <netdri@dotandco.com>. All rights reserved. 69 70This program is free software; you can redistribute it and/or modify 71it under the terms of the GNU General Public License as published by 72the Free Software Foundation; either version 2 of the License, or 73(at your option) any later version. 74 75See the LICENSE file that comes with this distribution for more details. 76 77=cut 78 79#################################################################################################### 80 81sub new 82{ 83 my $proto=shift; 84 my $class=ref($proto) || $proto; 85 my ($error,$area,$code,$msg)=@_; 86 my $self={ is_error => (defined($error)? $error : 1 ), 87 area => $area || '?', 88 code => $code || 0, 89 msg => $msg || '', 90 }; 91 92 $self->{bt}=Carp::longmess(); 93 94 bless($self,$class); 95 return $self; 96} 97 98sub die { die(new(@_)); } 99 100sub is_error { return shift->{is_error}; } 101sub area { return shift->{area}; } 102sub code { return shift->{code}; } 103sub msg { return shift->{msg}; } 104 105sub backtrace 106{ 107 my $self=shift; 108 my $m=$self->{bt}; 109 my (@bt1,@bt2); 110 foreach (split(/\n/,$m)) { if (/^\s*Net::DRI::(?:BaseClass|Exception)::/) { push @bt1,$_; } else { push @bt2,$_; } } 111 shift(@bt2) if ($bt2[0]=~m!Net/DRI/BaseClass!); 112 shift(@bt2) if ($bt2[0]=~m!Net/DRI/Exception!); 113 my ($f,$l); 114 if (@bt1) 115 { 116 ($f,$l)=(pop(@bt1)=~m/ called at (\S+) line (\d+)\s*$/); 117 } else 118 { 119 ($f,$l)=(shift(@bt2)=~m/ at (\S+) line (\d+)\s*$/); 120 } 121 my @b; 122 push @b,sprintf('EXCEPTION %d@%s from line %d of file %s:',$self->code(),$self->area(),$l,$f); 123 push @b,$self->msg(); 124 return (@b,@bt2); 125} 126 127## Do not parse result of this call. If needed, use accessors above (is_error(), area(), code(), msg()) 128sub as_string 129{ 130 my $self=shift; 131 return join("\n",$self->backtrace())."\n"; 132} 133 134sub print 135{ 136 print shift->as_string(); 137} 138 139#################################################################################################### 140 141sub err_failed_load_module { my ($w,$m,$e)=@_; Net::DRI::Exception->die(1,$w,8,'Failed to load Perl module '.$m.' : '.(ref($e)? $e->as_string() : $e)); } 142sub err_method_not_implemented { Net::DRI::Exception->die(1,'internal',1,'Method not implemented'.($_[0]? ': '.$_[0] : '')); } 143sub err_insufficient_parameters { Net::DRI::Exception->die(1,'internal',2,'Insufficient parameters'.($_[0]? ': '.$_[0] : '')); } 144sub err_invalid_parameters { Net::DRI::Exception->die(1,'internal',3,'Invalid parameters'.($_[0]? ': '.$_[0] : '')); } 145 146sub usererr_insufficient_parameters { Net::DRI::Exception->die(0,'internal',2,'Insufficient parameters'.($_[0]? ': '.$_[0] : '')); } 147sub usererr_invalid_parameters { Net::DRI::Exception->die(0,'internal',3,'Invalid parameters'.($_[0]? ': '.$_[0] : '')); } 148 149sub err_assert { Net::DRI::Exception->die(1,'internal',4,'Assert failed'.($_[0]? ': '.$_[0] : '')); } 150 151#################################################################################################### 1521; 153