File Coverage

lib/Badger/Prototype.pm

Criterion	Covered	Total	%
statement	31	31	100.0
branch	6	6	100.0
condition	5	9	55.5
subroutine	7	7	100.0
pod	2	2	100.0
total	51	55	92.7

#========================================================================
#
# Badger::Prototype
#
# DESCRIPTION
#   Base class module for a protoype class that has a default instance
#   that can be created on demand.
#
# AUTHOR
#   Andy Wardley
#
#========================================================================

package Badger::Prototype;

use Badger::Class
    base      => 'Badger::Base',
    version   => 0.01,
    debug     => 0,
    constants => 'PKG REFS ONCE',
    words     => 'PROTOTYPE';

sub prototype {
    my $class = shift;
    return $class if ref $class;
    no strict   REFS;
    no warnings ONCE;

    if (@_ == 1 && ! defined $_[0]) {
        # if only a single undef argument is provided, then clear any
        # prototype from $PROTOTYPE and return a reference to it.
        my $proto = ${$class.PKG.PROTOTYPE};
        undef ${$class.PKG.PROTOTYPE};
        return $proto;
    }
    elsif (@_) {
        # if any other arguments are provided then it forces us to create
        # a new prototype with the fresh configuration options.
        undef ${$class.PKG.PROTOTYPE};
    }

    # return the cached value (assuming we didn't just clear it) or create
    # a new one (if we did, or if there wasn't a previous value)
    return ${$class.PKG.PROTOTYPE} ||= $class->new(@_);
}

sub has_prototype {
    my $self  = shift;
    my $class = ref $self || $self;
    no strict   REFS;
    no warnings ONCE;
    defined ${$class.PKG.PROTOTYPE};
}


1;

__END__