File Coverage

blib/lib/POE/Component/Client/opentick/Error.pm

Criterion	Covered	Total	%
statement	61	67	91.0
branch	14	20	70.0
condition	2	3	66.6
subroutine	18	21	85.7
pod	12	12	100.0
total	107	123	86.9

package POE::Component::Client::opentick::Error;
#
#   opentick.com POE client
#
#   Error handling functionality
#
#   infi/2008
#
#   $Id: Error.pm 56 2009-01-08 16:51:14Z infidel $
#
#   Full POD documentation after __END__
#

use strict;
use warnings;
use Carp qw( carp croak confess );
#$Carp::CarpLevel = 10;
use Data::Dumper;

# Ours.
use POE::Component::Client::opentick::Constants;

use overload '""' => \&stringify;

###
### Variables
###

use vars qw( $VERSION $TRUE $FALSE );

BEGIN {
    require Exporter;
    our @ISA    = qw( Exporter );
    our @EXPORT = qw( throw );
    ($VERSION)  = q$Revision: 56 $ =~ /(\d+)/;
}

*TRUE    = \1;
*FALSE   = \0;

my $valid_args = {
    requestid   => $TRUE,
    commandid   => $TRUE,
    dumpstack   => $TRUE,
    message     => $TRUE,
    data        => $TRUE,
};

###
### Public methods
###

sub new
{
    my( $class, @data ) = @_;
    croak( "$class requires an even number of parameters" ) if( @data & 1 );

    my $self = {
            stack   => _process_longmess(),
    };

    bless( $self, $class );

    $self->initialize( @data );

    return( $self );
}

sub initialize
{
    my( $self, %args ) = @_;

    for( keys( %args ) )
    {
        $self->{lc $_} = $args{$_} if( $valid_args->{lc $_} );
    }

    croak( "At least one of Message or Data must be specified!" )
        unless( exists( $self->{message} ) or exists( $self->{data} ) );

    return;
}

# Dump the object contents appropriately
sub stringify
{
    my( $self ) = @_;

    my $message = $self->get_message();
    unless( $message )
    {
        my( $errcode, $errmsg ) = $self->get_data();
        $message = 'Protocol error ' . $errcode . ': ' . $errmsg;
    }

    # Add additional fields
    if( my( $cmd_name, $cmd_id )= $self->get_command() )
    {
        $message .= sprintf( "\nOTCommand: %d (%s)", $cmd_id, $cmd_name );
    }
    $message .= "\nRequest ID: " . $self->get_request_id()
                                          if( $self->get_request_id() );
    $message .= "\n" . $self->get_stack() if( $self->dump_stack() );

    return( $message );
}

# Just give up already, already.
sub throw
{
    my( $item ) = @_;

    my $message = "$item";      # OMG HAX

    confess( $message );
}

###
### Accessors
###

sub set_dump_stack
{
    my( $self ) = @_;

    $self->{dumpstack} = $TRUE;

    return( $self );
}

sub get_command
{
    my( $self ) = @_;

    return unless $self->{commandid};

    return( OTCommand( $self->{commandid} ), $self->{commandid} );
}

sub get_command_id
{
    my( $self ) = @_;

    return( $self->{commandid} );
}

sub dump_stack
{
    return( shift->{dumpstack} ? $TRUE : $FALSE );
}

sub get_stack
{
    return( shift->{stack} );
}

sub get_data
{
    my( $self ) = @_;

    my( $errcode, undef, $errmsg )
                        = unpack( OTTemplate( 'ERROR' ), $self->{data} );

    return( wantarray
            ? ( $errcode, $errmsg )
            : $self->{data} );
}

sub get_message
{
    return( shift->{message} );
}

sub get_request_id
{
    return( shift->{requestid} );
}

###
### Private methods
###

sub _process_longmess
{
    my @good = grep { ! /(?:Kernel|Session)/ } Carp::longmess();

    return( join( "\n", @good ) );
}

1;

__END__