File Coverage

blib/lib/Net/Duo/Exception.pm

Criterion	Covered	Total	%
statement	60	60	100.0
branch	8	8	100.0
condition	4	4	100.0
subroutine	16	16	100.0
pod	11	11	100.0
total	99	99	100.0

# Rich exception object for Net::Duo actions.
#
# All Net::Duo APIs throw Net::Duo::Exception objects on any failure,
# including internal errors, protocol errors, HTTP errors, and failures
# returned by the Duo API.  This is a rich exception object that carries all
# available details about the failure and can be inspected by the caller to
# recover additional information.  If the caller doesn't care about the
# details, it provides a stringification that is suitable for simple error
# messages.

package Net::Duo::Exception 1.01;

use 5.014;
use strict;
use warnings;

use HTTP::Response;

# Enable this object to be treated like a string scalar.
use overload '""' => \&to_string, 'cmp' => \&spaceship;

##############################################################################
# Constructors
##############################################################################

# Construct an exception from a Duo error reply.  If the provided object
# does not have a stat key with a value of FAIL, this call will be
# converted automatically to a call to protocol().
#
# $class   - Class of the exception to create
# $object  - The decoded JSON object representing the error reply
# $content - The undecoded content of the server reply
#
# Returns: Newly-constructed exception
sub api {
    my ($class, $object, $content) = @_;

    # Ensure that we have a valid stat key.
    if (!defined($object->{stat})) {
        return $class->protocol('missing stat value in JSON reply', $content);
    } elsif ($object->{stat} ne 'FAIL') {
        my $e = $class->protocol('invalid stat value', $content);
        $e->{detail} = $object->{stat};
        return $e;
    }

    # Set the exception information from the JSON object.
    my $self = {
        code    => $object->{code}    // 50000,
        message => $object->{message} // 'missing error message',
        detail  => $object->{message_detail},
        content => $content,
    };

    # Create the object and return it.
    bless($self, $class);
    return $self;
}

# Construct an exception from an HTTP::Response object.
#
# $class    - Class of the exception to create
# $response - An HTTP::Response object representing the failure
#
# Returns: Newly-constructed exception
sub http {
    my ($class, $response) = @_;
    my $self = {
        code    => $response->code() . '00',
        message => $response->message(),
        content => $response->decoded_content(),
    };
    bless($self, $class);
    return $self;
}

# Construct an exception for an internal error from a simple message.
#
# $class   - Class of the exception to create
# $message - The error message
#
# Returns: Newly-constructed exception
sub internal {
    my ($class, $message) = @_;
    my $self = {
        code    => 50000,
        message => $message,
    };
    bless($self, $class);
    return $self;
}

# Construct an exception that propagates another internal exception.
# Convert it to a string when propagating it, and remove the file and line
# information if present.
#
# $class     - Class of the exception to create
# $exception - Exception to propagate
#
# Returns: Newly-constructed exception
sub propagate {
    my ($class, $exception) = @_;
    $exception =~ s{ [ ] at [ ] \S+ [ ] line [ ] \d+[.]? \n+ \z }{}xms;
    return $class->internal($exception);
}

# Construct an exception for a protocol failure, where we got an HTTP
# success code but couldn't parse the result or couldn't find the JSON
# keys that we were expecting.
#
# $class   - Class of the exception to create
# $message - Error message indicating what's wrong
# $reply   - The content of the HTTP reply
#
# Returns: Newly-created exception
sub protocol {
    my ($class, $message, $reply) = @_;
    my $self = {
        code    => 50000,
        message => $message,
        content => $reply,
    };
    bless($self, $class);
    return $self;
}

##############################################################################
# Accessors and overloads
##############################################################################

# Basic accessors.
sub code    { my $self = shift; return $self->{code} }
sub content { my $self = shift; return $self->{content} }
sub detail  { my $self = shift; return $self->{detail} }
sub message { my $self = shift; return $self->{message} }

# The cmp implmenetation converts the exception to a string and then compares
# it to the other argument.
#
# $self  - Net::Duo::Exception object
# $other - The other object (generally a string) to which to compare it
# $swap  - True if the order needs to be swapped for a proper comparison
#
# Returns: -1, 0, or 1 per the cmp interface contract
sub spaceship {
    my ($self, $other, $swap) = @_;
    my $string = $self->to_string;
    if ($swap) {
        return ($other cmp $string);
    } else {
        return ($string cmp $other);
    }
}

# A verbose message with all the information from the exception except for
# the full content of the reply.
#
# $self - Net::Duo::Exception
#
# Returns: A string version of the exception information.
sub to_string {
    my ($self)  = @_;
    my $code    = $self->{code};
    my $detail  = $self->{detail};
    my $message = $self->{message};

    # Our verbose format is the message, followed by the detail in
    # parentheses if available, and then the error code in brackets.
    my $result = $message;
    if (defined($detail)) {
        $result .= " ($detail)";
    }
    $result .= " [$code]";
    return $result;
}

1;
__END__