File Coverage

blib/lib/Return/Value.pm

Criterion	Covered	Total	%
statement	63	63	100.0
branch	28	28	100.0
condition	3	3	100.0
subroutine	30	30	100.0
pod	6	6	100.0
total	130	130	100.0

use strict;
use warnings;
package Return::Value;
{
  $Return::Value::VERSION = '1.666004';
}
# ABSTRACT: (deprecated) polymorphic return values
# vi:et:sw=4 ts=4

use Exporter 5.57 'import';
use Carp ();

our @EXPORT  = qw[success failure];


# This hack probably impacts performance more than I'd like to know, but it's
# needed to have a hashref object that can deref into a different hash.
# _ah($self,$key, [$value) sets or returns the value for the given key on the
# $self blessed-ref

sub _ah {
    my ($self, $key, $value) = @_;
    my $class = ref $self;
    bless $self => "ain't::overloaded";
    $self->{$key} = $value if @_ > 2;
    my $return = $self->{$key};
    bless $self => $class;
    return $return;
}

sub _builder {
    my %args = (type => shift);
    $args{string} = shift if (@_ % 2);
    %args = (%args, @_);

    $args{string} = $args{type} unless defined $args{string};

    $args{errno}  = ($args{type} eq 'success' ? undef : 1)
        unless defined $args{errno};

    __PACKAGE__->new(%args);
}


sub success { _builder('success', @_) }


sub failure { _builder('failure', @_) }


sub new {
    my $class = shift;
    bless { type => 'failure', string => q{}, prop => {}, @_ } => $class;
}


sub bool { _ah($_[0],'type') eq 'success' ? 1 : 0 }

sub type {
    my ($self, $value) = @_;
    return _ah($self, 'type') unless @_ > 1;
    Carp::croak "invalid result type: $value"
        unless $value eq 'success' or $value eq 'failure';
    return _ah($self, 'type', $value);
};

foreach my $name ( qw[errno string data] ) {
    ## no critic (ProhibitNoStrict)
    no strict 'refs';
    *{$name} = sub {
        my ($self, $value) = @_;
        return _ah($self, $name) unless @_ > 1;
        return _ah($self, $name, $value);
    };
}

sub prop {
    my ($self, $name, $value) = @_;
    return _ah($self, 'prop')          unless $name;
    return _ah($self, 'prop')->{$name} unless @_ > 2;
    return _ah($self, 'prop')->{$name} = $value;
}


use overload
    '""'   => sub { shift->string  },
    'bool' => sub { shift->bool },
    '=='   => sub { shift->bool   == shift },
    '!='   => sub { shift->bool   != shift },
    '>'    => sub { shift->bool   >  shift },
    '<'    => sub { shift->bool   <  shift },
    'eq'   => sub { shift->string eq shift },
    'ne'   => sub { shift->string ne shift },
    'gt'   => sub { shift->string gt shift },
    'lt'   => sub { shift->string lt shift },
    '++'   => sub { _ah(shift,'type','success') },
    '--'   => sub { _ah(shift,'type','failure') },
    '${}'  => sub { my $data = _ah($_[0],'data'); $data ? \$data : \undef },
    '%{}'  => sub { ref _ah($_[0],'data') eq 'HASH'  ? _ah($_[0],'data') : {} },
    '@{}'  => sub { ref _ah($_[0],'data') eq 'ARRAY' ? _ah($_[0],'data') : [] },
    fallback => 1;


"This return value is true.";

__END__