File Coverage

blib/lib/XAS/Singleton.pm

Criterion	Covered	Total	%
statement	6	18	33.3
branch	0	8	0.0
condition	0	6	0.0
subroutine	2	5	40.0
pod	1	1	100.0
total	9	38	23.6

package XAS::Singleton;

our $VERSION = '0.01';

use XAS::Class
  debug     => 0,
  version   => $VERSION,
  base      => 'XAS::Base',
  constants => 'HASH',
;

# ----------------------------------------------------------------------
# Here be the best of cut-and-paste programming. This combines
# the guts of Class::Singleton with Badger::Base to make singletons!
# ----------------------------------------------------------------------

# ----------------------------------------------------------------------
# Public Methods
# ----------------------------------------------------------------------

sub new {
    my $class = shift;

    # already got an object

    return $class if ref $class;

    # we store the instance in the _instance variable in the $class package.

    no strict 'refs';
    my $instance = \${ "$class\::_instance" };

    defined $$instance
      ? $$instance
      : ($$instance = $class->_new_instance(@_));

}

# ----------------------------------------------------------------------
# Private Methods
# ----------------------------------------------------------------------

sub _new_instance {
    my $class = shift;

    # install warning handling for odd number of parameters when DEBUG enabled

    local $SIG{__WARN__} = sub {
        Badger::Utils::odd_params(@_);
    } if DEBUG;

    my $args = @_ && ref $_[0] eq HASH ? shift : { @_ };
    my $self = bless { }, ref $class || $class;

    $self = $self->init($args);

    # be careful to account for object that overload the boolean comparison
    # operator and may return false to a simple truth test.

    return defined $self
      ? $self
      : $self->error("init() method failed\n");

}

1;

__END__