—package
Venus::Error;
use
5.018;
use
strict;
use
warnings;
use
Moo;
use
overload (
'.'
=>
sub
{
$_
[0]->message .
"$_[1]"
},
'eq'
=>
sub
{
$_
[0]->message eq
"$_[1]"
},
'ne'
=>
sub
{
$_
[0]->message ne
"$_[1]"
},
'qr'
=>
sub
{qr/@{[
quotemeta
(
$_
[0]->message)]}/},
);
# ATTRIBUTES
has
context
=> (
is
=>
'rw'
,
default
=>
'(None)'
,
);
has
message
=> (
is
=>
'rw'
,
default
=>
'Exception!'
,
);
# BUILDERS
sub
build_arg {
my
(
$self
,
$data
) =
@_
;
return
{
message
=>
$data
,
};
}
sub
build_self {
my
(
$self
,
$data
) =
@_
;
$self
->trace(2)
if
!@{
$self
->frames};
return
$self
;
}
# METHODS
sub
explain {
my
(
$self
) =
@_
;
$self
->trace(1, 1)
if
!@{
$self
->{
'$frames'
}};
my
$frames
=
$self
->{
'$frames'
};
my
$file
=
$frames
->[0][1];
my
$line
=
$frames
->[0][2];
my
$pack
=
$frames
->[0][0];
my
$subr
=
$frames
->[0][3];
my
$message
=
$self
->message;
my
@stacktrace
= (
"$message in $file at line $line"
);
push
@stacktrace
,
'Type:'
,
ref
(
$self
);
push
@stacktrace
,
'Context:'
,
$self
->context ||
'(None)'
;
no
warnings
'once'
;
local
$Data::Dumper::Indent
= 1;
local
$Data::Dumper::Trailingcomma
= 0;
local
$Data::Dumper::Purity
= 0;
local
$Data::Dumper::Pad
=
''
;
local
$Data::Dumper::Varname
=
'VAR'
;
local
$Data::Dumper::Useqq
= 0;
local
$Data::Dumper::Terse
= 1;
local
$Data::Dumper::Freezer
=
''
;
local
$Data::Dumper::Toaster
=
''
;
local
$Data::Dumper::Deepcopy
= 1;
local
$Data::Dumper::Quotekeys
= 0;
local
$Data::Dumper::Bless
=
'bless'
;
local
$Data::Dumper::Pair
=
' => '
;
local
$Data::Dumper::Maxdepth
= 0;
local
$Data::Dumper::Maxrecurse
= 1000;
local
$Data::Dumper::Useperl
= 0;
local
$Data::Dumper::Sortkeys
= 1;
local
$Data::Dumper::Deparse
= 1;
local
$Data::Dumper::Sparseseen
= 0;
my
$stashed
= Data::Dumper->Dump([
$self
->stash]);
$stashed
=~ s/^
'|'
$//g;
chomp
$stashed
;
push
@stacktrace
,
'Stashed:'
,
$stashed
;
push
@stacktrace
,
'Traceback (reverse chronological order):'
if
@$frames
> 1;
@stacktrace
= (
join
(
"\n\n"
,
grep
defined
,
@stacktrace
),
''
);
for
(
my
$i
= 1;
$i
<
@$frames
;
$i
++) {
my
$pack
=
$frames
->[
$i
][0];
my
$file
=
$frames
->[
$i
][1];
my
$line
=
$frames
->[
$i
][2];
my
$subr
=
$frames
->[
$i
][3];
push
@stacktrace
,
"$subr\n in $file at line $line"
;
}
return
join
"\n"
,
@stacktrace
,
""
;
}
sub
frames {
my
(
$self
) =
@_
;
return
$self
->{
'$frames'
} //= [];
}
sub
throw {
my
(
$self
,
@args
) =
@_
;
$self
=
$self
->new(
@args
)
if
!
ref
$self
;
die
$self
;
}
sub
trace {
my
(
$self
,
$offset
,
$limit
) =
@_
;
my
$frames
=
$self
->frames;
@$frames
= ();
for
(
my
$i
=
$offset
// 1;
my
@caller
=
caller
(
$i
);
$i
++) {
push
@$frames
, [
@caller
];
last
if
defined
$limit
&&
$i
+ 1 ==
$offset
+
$limit
;
}
return
$self
;
}
1;
=head1 NAME
Venus::Error - Error Class
=cut
=head1 ABSTRACT
Error Class for Perl 5
=cut
=head1 SYNOPSIS
package main;
use Venus::Error;
my $error = Venus::Error->new;
# $error->throw;
=cut
=head1 DESCRIPTION
This package represents a context-aware error (exception object).
=cut
=head1 ATTRIBUTES
This package has the following attributes:
=cut
=head2 context
context(Str)
This attribute is read-write, accepts C<(Str)> values, is optional, and defaults to C<'(None)'>.
=cut
=head2 message
message(Str)
This attribute is read-write, accepts C<(Str)> values, is optional, and defaults to C<'Exception!'>.
=cut
=head1 INHERITS
This package inherits behaviors from:
L<Venus::Kind::Utility>
=cut
=head1 INTEGRATES
This package integrates behaviors from:
L<Venus::Role::Explainable>
L<Venus::Role::Stashable>
=cut
=head1 METHODS
This package provides the following methods:
=cut
=head2 explain
explain() (Str)
The explain method returns the error message and is used in stringification
operations.
I<Since C<0.01>>
=over 4
=item explain example 1
# given: synopsis;
my $explain = $error->explain;
# "Exception! in ...
=back
=cut
=head2 frames
frames() (ArrayRef)
The frames method returns the compiled and stashed stack trace data.
I<Since C<0.01>>
=over 4
=item frames example 1
# given: synopsis;
my $frames = $error->frames;
# [
# ...
# [
# "main",
# "t/Venus_Error.t",
# ...
# ],
# ]
=back
=cut
=head2 throw
throw(Any @data) (Error)
The throw method throws an error if the invocant is an object, or creates an
error object using the arguments provided and throws the created object.
I<Since C<0.01>>
=over 4
=item throw example 1
# given: synopsis;
my $throw = $error->throw;
# bless({ ... }, 'Venus::Error')
=back
=cut
=head2 trace
trace(Int $offset, Int $limit) (Error)
The trace method compiles a stack trace and returns the object. By default it
skips the first frame.
I<Since C<0.01>>
=over 4
=item trace example 1
# given: synopsis;
my $trace = $error->trace;
# bless({ ... }, 'Venus::Error')
=back
=over 4
=item trace example 2
# given: synopsis;
my $trace = $error->trace(0, 1);
# bless({ ... }, 'Venus::Error')
=back
=over 4
=item trace example 3
# given: synopsis;
my $trace = $error->trace(0, 2);
# bless({ ... }, 'Venus::Error')
=back
=cut
=head1 OPERATORS
This package overloads the following operators:
=cut
=over 4
=item operation: C<(.)>
This package overloads the C<.> operator.
B<example 1>
# given: synopsis;
my $string = $error . ' Unknown';
# "Exception! Unknown"
=back
=over 4
=item operation: C<(eq)>
This package overloads the C<eq> operator.
B<example 1>
# given: synopsis;
my $result = $error eq 'Exception!';
# 1
=back
=over 4
=item operation: C<(ne)>
This package overloads the C<ne> operator.
B<example 1>
# given: synopsis;
my $result = $error ne 'exception!';
# 1
=back
=over 4
=item operation: C<(qr)>
This package overloads the C<qr> operator.
B<example 1>
# given: synopsis;
my $test = 'Exception!' =~ qr/$error/;
# 1
=back
=head1 AUTHORS
Cpanery, C<cpanery@cpan.org>
=cut
=head1 LICENSE
Copyright (C) 2021, Cpanery
Read the L<"license"|https://github.com/cpanery/venus/blob/master/LICENSE> file.
=cut