X-Git-Url: https://git.dogcows.com/gitweb?a=blobdiff_plain;f=lib%2FFile%2FKDBX%2FError.pm;h=86442f3bdc306a071a2101cb462e6f3b9dbfbd2b;hb=331a54019664704eb4a10186cb4abd7a2a722f30;hp=fbc6bbd35d7b911db42c705a4e1bf1808da059e7;hpb=dbb5bfee033ceb2600d5017d370b9533f6e6d6f7;p=chaz%2Fp5-File-KDBX diff --git a/lib/File/KDBX/Error.pm b/lib/File/KDBX/Error.pm index fbc6bbd..86442f3 100644 --- a/lib/File/KDBX/Error.pm +++ b/lib/File/KDBX/Error.pm @@ -5,7 +5,7 @@ use warnings; use strict; use Exporter qw(import); -use Scalar::Util qw(blessed); +use Scalar::Util qw(blessed looks_like_number); use namespace::clean -except => 'import'; our $VERSION = '999.999'; # VERSION @@ -21,6 +21,13 @@ BEGIN { else { eval qq{package $WARNINGS_CATEGORY; use warnings::register; 1}; ## no critic ProhibitStringyEval } + + my $debug = $ENV{DEBUG}; + $debug = looks_like_number($debug) ? (0 + $debug) : ($debug ? 1 : 0); + *DEBUG = $debug == 1 ? sub() { 1 } : + $debug == 2 ? sub() { 2 } : + $debug == 3 ? sub() { 3 } : + $debug == 4 ? sub() { 4 } : sub() { 0 }; } use overload '""' => 'to_string', cmp => '_cmp'; @@ -39,7 +46,7 @@ sub new { my $error = delete $args{_error}; my $e = $error; - # $e =~ s/ at \H+ line \d+.*//g; + $e =~ s/ at \H+ line \d+.*//g; my $self = bless { details => \%args, @@ -70,7 +77,7 @@ passed will be forwarded to L to create a new error object. This can be convenient for error handling when you're not sure what the exception is but you want to treat it as a B. Example: - eval { .... }; + eval { ... }; if (my $error = error(@_)) { if ($error->type eq 'key.missing') { handle_missing_key($error); @@ -108,13 +115,30 @@ sub details { return $details; } -sub errno { $_[0]->{errno} } +=attr errno -sub previous { $_[0]->{previous} } +Get the value of C when the exception was created. + +=attr previous + +Get the value of C<$@> (i.e. latest exception) at the time the exception was created. + +=attr trace + +Get a stack trace indicating where in the code the exception was created. + +=cut + +=attr type -sub trace { $_[0]->{trace} // [] } +Get the exception type, if any. -sub type { $_[0]->details->{type} // '' } +=cut + +sub errno { $_[0]->{errno} } +sub previous { $_[0]->{previous} } +sub trace { $_[0]->{trace} // [] } +sub type { $_[0]->details->{type} // '' } =method to_string @@ -130,17 +154,11 @@ variable to truthy to stringify the whole error object. sub _cmp { "$_[0]" cmp "$_[1]" } -sub PROPAGATE { - 'wat'; -} - sub to_string { my $self = shift; - # return "uh oh\n"; my $msg = "$self->{trace}[0]"; - $msg .= '.' if $msg !~ /[\.\!\?]$/; # Why does this cause infinite recursion on some perls? - # $msg .= '.' if $msg !~ /(?:\.|!|\?)$/; - if ($ENV{DEBUG}) { + $msg .= '.' if $msg !~ /[\.\!\?]$/; + if (2 <= DEBUG) { require Data::Dumper; local $Data::Dumper::Indent = 1; local $Data::Dumper::Quotekeys = 0;