File Coverage

lib/Class/Singleton.pm

Criterion	Covered	Total	%
statement	19	20	95.0
branch	4	6	66.6
condition	3	6	50.0
subroutine	6	6	100.0
pod	2	2	100.0
total	34	40	85.0

#============================================================================
#
# Class::Singleton.pm
#
# Implementation of a "singleton" module which ensures that a class has
# only one instance and provides global access to it.  For a description
# of the Singleton class, see "Design Patterns", Gamma et al, Addison-
# Wesley, 1995, ISBN 0-201-63361-2
#
# Written by Andy Wardley
#
# Copyright (C) 1998-2008 Andy Wardley.  All Rights Reserved.
# Copyright (C) 1998 Canon Research Centre Europe Ltd.
#
#============================================================================

package Class::Singleton;
require 5.004;
use strict;
use warnings;

our $VERSION = 1.5;
my %_INSTANCES = ();


#========================================================================
#
# instance()
#
# Module constructor.  Creates an Class::Singleton (or derived) instance
# if one doesn't already exist.  The instance reference is stored in the
# %_INSTANCES hash of the Class::Singleton package.  The impact of this is
# that you can create any number of classes derived from Class::Singleton
# and create a single instance of each one.  If the instance reference
# was stored in a scalar $_INSTANCE variable, you could only instantiate
# *ONE* object of *ANY* class derived from Class::Singleton.  The first
# time the instance is created, the _new_instance() constructor is called
# which simply returns a reference to a blessed hash.  This can be
# overloaded for custom constructors.  Any addtional parameters passed to
# instance() are forwarded to _new_instance().
#
# Returns a reference to the existing, or a newly created Class::Singleton
# object.  If the _new_instance() method returns an undefined value
# then the constructer is deemed to have failed.
#
#========================================================================

sub instance {
    my $class = shift;

    # already got an object
    return $class if ref $class;

    # we store the instance against the $class key of %_INSTANCES
    my $instance = $_INSTANCES{$class};
    unless(defined $instance) {
        $_INSTANCES{$class} = $instance = $class->_new_instance(@_);
    }
    return $instance;
}


#=======================================================================
# has_instance()
#
# Public method to return the current instance if it exists.
#=======================================================================

sub has_instance {
    my $class = shift;
    $class = ref $class || $class;
    return $_INSTANCES{$class};
}


#========================================================================
# _new_instance(...)
#
# Simple constructor which returns a hash reference blessed into the
# current class.  May be overloaded to create non-hash objects or
# handle any specific initialisation required.
#========================================================================

sub _new_instance {
    my $class = shift;
    my %args  = @_ && ref $_[0] eq 'HASH' ? %{ $_[0] } : @_;
    bless { %args }, $class;
}


#========================================================================
# END()
#
# END block to explicitly destroy all Class::Singleton objects since
# destruction order at program exit is not predictable. See CPAN RT
# bugs #23568 and #68526 for examples of what can go wrong without this.
#========================================================================

END {
    # dereferences and causes orderly destruction of all instances
    undef(%_INSTANCES);
}


1;

__END__