File Coverage

lib/Exception/System.pm

Criterion	Covered	Total	%
statement	21	21	100.0
branch			n/a
condition	2	2	100.0
subroutine	6	6	100.0
pod			n/a
total	29	29	100.0

#!/usr/bin/perl -c

package Exception::System;
use 5.006;
our $VERSION = 0.11;

=head1 NAME

Exception::System - The exception class for system or library calls

=head1 SYNOPSIS

  # The simplest usage
  use Exception::Base 'Exception::System';
  open my $file, "/notfound"
    or Exception::System->throw(message=>"Can not open file");

  # The Exception::System class can be a base class for others
  #
  # Loaded automatically if used as Exception::Base's argument
  use Exception::Base,
    'Exception::System',
    'Exception::File' => {
        isa => 'Exception::System',
        has => 'filename',
        string_attributes => [ 'message', 'errstr', 'filename' ],
    };

  eval {
    my $filename = "/notfound";
    open my $fh, $filename
        or Exception::File->throw(
               message=>"Can not open file",
               filename=>$filename,
           );
  };
  if ($@) {
    my $e = Exception::Base->catch;
    if ($e->isa('Exception::File')) { warn "File error:".$e->errstr; }
    if ($e->matches({errname=>'ENOENT'})) { warn "Caught not found error"; }
  }

=head1 DESCRIPTION

This class extends standard L with handling system or library
errors.  The additional attributes of the exception object are filled on throw
and contain the error message and error codes.

=for readme stop

=cut


use strict;
use warnings;


# Extend Exception::Base class
use Exception::Base 0.20
    'Exception::System' => {
        has       => { ro => [ 'errstr', 'errstros', 'errno', 'errname' ] },
        message   => 'Unknown system exception',
        verbosity => 3,
        string_attributes => [ 'message', 'errstr' ],
        numeric_attribute => 'errno',
    };


# Use ERRNO hash
use Errno ();


# Map for errno -> errname (choose the shortest errname string for the same errno number)
my %Errname = map { Errno->$_ => $_ }
              sort { length $b <=> length $a }
              sort
              keys (%!);


# Collect system data
sub _collect_system_data {
    my $self = shift;

    $self->{errstr}   = "$!";   # string context
    $self->{errstros} = $^E;
    $self->{errno}    = 0+$!;   # numeric context
    $self->{errname}  = $Errname{ $self->{errno} } || '';

    return $self->SUPER::_collect_system_data(@_);
};


1;


__END__