File Coverage

lib/Class/Singleton.pm

Criterion	Covered	Total	%
statement	24	25	96.0
branch	4	6	66.6
condition	3	6	50.0
subroutine	7	7	100.0
pod	2	2	100.0
total	40	46	86.9

#============================================================================
#
# 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.4;


#========================================================================
#
# instance()
#
# Module constructor.  Creates an Class::Singleton (or derived) instance
# if one doesn't already exist.  The instance reference is stored in the
# _instance variable of the $class package.  This means that classes
# derived from Class::Singleton will have the variables defined in *THEIR*
# package, rather than 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 variable
# was stored in the Class::Singleton package, 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 in the _instance variable in the $class package.
    no strict 'refs';
    my $instance = \${ "$class\::_instance" };
    defined $$instance
        ? $$instance
        : ($$instance = $class->_new_instance(@_));
}


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

sub has_instance {
    my $class = shift;
    $class = ref $class || $class;
    no strict 'refs';
    return ${"$class\::_instance"};
}


#========================================================================
# _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;
}



1;

__END__