package Exception::FFI::ErrorCode 0.03 {
use warnings;
use 5.020;
use constant 1.32 ();
use experimental qw( signatures postderef );
use Ref::Util qw( is_plain_arrayref );
# ABSTRACT: Exception class based on integer error codes common in C code
my %human_codes;
sub import ($, %args)
{
my $class = delete $args{class} || caller;
my $const_class = delete $args{const_class} || $class;
my $codes = delete $args{codes} || {};
if(%args) {
require Carp;
Carp::croak("Unknown options: @{[ sort keys %args ]}");
}
{
no strict 'refs';
push @{ "$class\::ISA" }, 'Exception::FFI::ErrorCode::Base';
}
foreach my $name (keys $codes->%*)
{
my($code, $human) = do {
my $v = $codes->{$name};
is_plain_arrayref $v ? @$v : ($v,$name);
};
constant->import("$const_class\::$name", $code);
$human_codes{$class}->{$code} = $human;
}
}
sub detect ($class)
{
my $sub;
if(Carp::Always->can('import'))
{
require Sub::Identify;
$Carp::CarpInternal{"Exception::FFI::ErrorCode::Base"}++;
$sub = sub {
[Sub::Identify::get_code_info($SIG{__WARN__})]->[0] eq 'Carp::Always'
};
}
else
{
$sub = sub { 0 };
}
no warnings 'redefine';
*Exception::FFI::ErrorCode::Base::_carp_always = $sub;
}
__PACKAGE__->detect;
package Exception::FFI::ErrorCode::Base 0.03 {
sub _carp_always;
use Class::Tiny qw( package filename line code trace _longmess );
use Ref::Util qw( is_blessed_ref );
use overload
'""' => sub ($self,@) {
if(_carp_always)
{
return $self->_longmess;
}
else
{
return $self->as_string . "\n";
}
},
bool => sub { 1 }, fallback => 1;
sub throw ($proto, %rest)
{
my($package, $filename, $line) = caller( delete $rest{frame} // 0 );
my $self;
if(is_blessed_ref $proto)
{
$self = $proto;
$self->package($package);
$self->filename($filename);
$self->line($line);
}
else
{
$self = $proto->new(
%rest,
package => $package,
filename => $filename,
line => $line,
);
}
my $trace = $self->get_stack_trace;
$self->trace($trace) if $trace;
$self->_longmess(Carp::longmess($self->strerror)) if _carp_always;
die $self;
}
sub get_stack_trace ($)
{
if($ENV{EXCEPTION_FFI_ERROR_CODE_STACK_TRACE})
{
require Devel::StackTrace;
return Devel::StackTrace->new(
ignore_package => 'Exception::FFI::ErrorCode::Base',
);
}
else
{
return undef;
}
}
sub strerror ($self)
{
my $code = $self->code;
$code = 0 unless defined $code;
my $str = $human_codes{ref $self}->{$code};
$str = sprintf "%s error code %s", ref $self, $self->code unless defined $str;
return $str;
}
sub as_string ($self)
{
sprintf "%s at %s line %s.", $self->strerror, $self->filename, $self->line;
}
}
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Exception::FFI::ErrorCode - Exception class based on integer error codes common in C code
=head1 VERSION
version 0.03
=head1 SYNOPSIS
Throwing:
# realish world example for use with libcurl
package Curl::Error {
use Exception::FFI::ErrorCode
code => {
CURLE_OK => 0,
CURLE_UNKNOWN_OPTION => 48
...
};
$ffi->attach( [ curl_easy_strerror => strerror ] => ['enum'] => 'string' => sub {
my($xsub, $self) = @_;
$xsub->($self->code);
});
}
# foo is an unknown option, so this will return 48
my $code = $curl->setopt( "foo" => "bar" );
# throw as an exception
Curl::Error->throw( code => $code ) if $code != Curl::Error::CURLE_OK;
Defining error class without a strerror
package Curl::Error {
use Exception::FFI::ErrorCode
code => {
CURLE_OK => [ 0, 'no error' ],
CURLE_UNKNOWN_OPTION => [ 48, 'unknown option passed to setopt' ],
...
};
}
...
Catching:
try {
might_die;
}
catch ($ex) {
if($ex isa Curl::Error) {
my $package = $ex->package; # the package where thrown
my $filename = $ex->filename; # the filename where thrown
my $line = $ex->line; # the linenumber where thrown
my $code = $ex->code; # the error code
my $human = $ex->strerror; # human readable error
my $diag = $ex->as_string; # human readable error at filename.pl line xxx
my $diag = "$ex"; # same as $ex->as_string
if($ex->code == Curl::Error::UNKNOWN_OPTION) {
# handle the unknown option variant of this error
}
}
}
=head1 DESCRIPTION
A common pattern in C libraries is to return an integer error code to classify an error.
When translating those APIs to Perl you often want to instead throw an exception. This
class provides an interface for building exception classes that help with that pattern.
For APIs that provide a C<strerror> or similar function that converts the error code into
a human readable diagnostic, you can simply attach it. If not you can provide human
readable diagnostics for each error code using an array reference, as shown above.
The base class for your exception class will be set to
L<Exception::FFI::ErrorCode::Base|/Exception::FFI::ErrorCode::Base>. The base class
handles determining the location of where the exception was thrown and will stringify
in a way to look like a regular Perl string exception with the filename and line number
you would expect.
A stack trace can be generated, either on a per-subclass basis, or globally via an
environment variable. This is not done by default due to the overhead involved.
See the L<trace method|/trace> for details.
This class will attempt to detect if L<Carp::Always> is running and produce a long message
when stringified, as it already does for regular string exceptions. By default it will
B<only> do this if L<Carp::Always> is running when this module is loaded. Since
typically L<Carp::Always> is loaded via the command line C<-MCarp::Always> or via
C<PERL5OPT> environment variable this should cover all of the typical use cases, but if
for some reason L<Carp::Always> does get loaded after this module, you can force
redetection by calling the L<detect method|/detect>.
=head1 METHODS
=head2 detect
Exception::FFI::ErrorCode->detect;
This will redetect if L<Carp::Always> has been loaded yet. You do not need to call this
method if L<Carp::Always> has been enabled or disabled (we check for that when the
exception is thrown and stringified), just if the module has been loaded.
=head2 import
use Exception::FFI::ErrorCode
%options;
The C<import> method will set the base class, and set up any specific error codes.
Options include:
=over 4
=item class
The exception class. If not provided this will be determined using C<caller>.
=item codes
The error codes. This is a hash reference. The keys are the constant names, in C and
Perl these are usually all upper case like C<FOO_BAD_FILENAME>. The values can be either
an integer constant, or an array reference with the integer constant and human readable
diagnostic. The former is intended for when there is a C<strerror> type function that
will convert the error code into a diagnostic for you.
=item const_class
Where to put the constants. If not provided, these will be be the same as C<class>.
=back
=head1 Exception::FFI::ErrorCode::Base
The base class uses L<Class::Tiny>, so feel free to add additional attributes.
The base class provides these attributes and methods:
=head2 throw
Exception::FFI::ErrorCode::Base->throw( code => $code, %attr );
Exception::FFI::ErrorCode::Base->throw( code => $code, frame => $frame, %attr );
Throws the exception with the given code. Obviously you would throw the subclass, not the
base class.
If you have added additional attributes via L<Class::Tiny> you can provide them as
C<%attr>.
If you want the exception to appear to happen from a different frame then you can
specify it with C<$frame>.
=head2 strerror
my $string = $ex->strerror;
Returns a human readable message for the exception. If available this should be overridden
by attaching the appropriate C function.
=head2 as_string
my $string = $ex->as_string;
my $string = "$ex";
Returns a human readable diagnostic. This is in the form of a familiar Perl warning or
string exception, including the filename and line number where the exception was thrown.
If you stringify the exception it will use this method, adding a new line.
=head2 package
my $package = $ex->package;
The package where the exception happened.
=head2 filename
my $filename = $ex->filename;
The filename where the exception happened.
=head2 line
my $line = $ex->line;
The line number where the exception happened.
=head2 code
my $code = $ex->code;
The integer error code.
=head2 trace
my $trace = $ex->trace;
This will return a L<Devel::StackTrace> trace, if it was recorded when the exception was
thrown. Generally the trace will only be generated if C<EXCEPTION_FFI_ERROR_CODE_STACK_TRACE>
set to a true value. Individual subclasses may also choose to always generate a stack
trace.
=head2 get_stack_trace
my $trace = $ex->get_stack_trace;
This is the method that is called internally to generate a stack trace. By default this
is only done if C<EXCEPTION_FFI_ERROR_CODE_STACK_TRACE> is set to true. If you want
a stack trace to B<always> be generated, you can override this method in your subclass.
=head1 CAVEATS
The L<Carp::Always> detection is pretty solid, but if L<Carp::Always> is off when the
exception is thrown but on when it is stringified then strange things might happen.
=head1 ENVIRONMENT
=over 4
=item C<EXCEPTION_FFI_ERROR_CODE_STACK_TRACE>
If this environment variable is set to a true value, then a stack trace will be generated
and attached to all exceptions managed by L<Exception::FFI::ErrorCode>.
=back
=head1 SEE ALSO
=over 4
=item L<FFI::Platypus>
=item L<Exception::Class>
=item L<Class:Tiny>
=back
=head1 AUTHOR
Graham Ollis <[email protected]>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut