libnet-dri-perl 0.96-1 / usr / share / perl5 / Net / DRI / Exception.pm

This file is indexed.

/usr/share/perl5/Net/DRI/Exception.pm is in libnet-dri-perl 0.96-1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below. 

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
## Domain Registry Interface, Encapsulatng errors (fatal or not) as exceptions in an OO way
##
## Copyright (c) 2005,2007,2008,2009 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.
#
# 
#
####################################################################################################

package Net::DRI::Exception;

use strict;

use Carp;

our $VERSION=do { my @r=(q$Revision: 1.8 $=~/\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 full 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

E<lt>http://www.dotandco.com/services/software/Net-DRI/E<gt>

=head1 AUTHOR

Patrick Mevzek, E<lt>netdri@dotandco.comE<gt>

=head1 COPYRIGHT

Copyright (c) 2005,2007,2008,2009 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::(?:BaseClass|Exception)::/) { push @bt1,$_; } else { push @bt2,$_; } }
 shift(@bt2) if ($bt2[0]=~m!Net/DRI/BaseClass!);
 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,sprintf('EXCEPTION %d@%s from line %d of file %s:',$self->code(),$self->area(),$l,$f);
 push @b,$self->msg();
 return (@b,@bt2);
}

## Do not parse result of this call. If needed, use accessors above (is_error(), area(), code(), msg())
sub as_string
{
 my $self=shift;
 return join("\n",$self->backtrace())."\n";
}

sub print
{
 print shift->as_string();
}

####################################################################################################

sub 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)); }
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;

APT Browse - Built by Thomas Orozco.