1 #============================================================================

     2 #

     3 # Class::Singleton.pm

     4 #

     5 # Implementation of a "singleton" module which ensures that a class has

     6 # only one instance and provides global access to it.  For a description 

     7 # of the Singleton class, see "Design Patterns", Gamma et al, Addison-

     8 # Wesley, 1995, ISBN 0-201-63361-2

     9 #

    10 # Written by Andy Wardley <abw@cre.canon.co.uk>

    11 #

    12 # Copyright (C) 1998 Canon Research Centre Europe Ltd.  All Rights Reserved.

    13 #

    14 #----------------------------------------------------------------------------

    15 #

    16 # $Id: Singleton.pm,v 1.3 1999/01/19 15:57:43 abw Exp $

    17 #

    18 #============================================================================

    19 

    20 package Class::Singleton;

    21 

    22 require 5.004;

    23 

    24 use strict;

    25 use vars qw( $RCS_ID $VERSION );

    26 

    27 $VERSION = sprintf("%d.%02d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/);

    28 $RCS_ID  = q$Id: Singleton.pm,v 1.3 1999/01/19 15:57:43 abw Exp $;

    29 

    30 

    31 

    32 #========================================================================

    33 #                      -----  PUBLIC METHODS -----

    34 #========================================================================

    35 

    36 #========================================================================

    37 #

    38 # instance()

    39 #

    40 # Module constructor.  Creates an Class::Singleton (or derivative) instance 

    41 # if one doesn't already exist.  The instance reference is stored in the

    42 # _instance variable of the $class package.  This means that classes 

    43 # derived from Class::Singleton will have the variables defined in *THEIR*

    44 # package, rather than the Class::Singleton package.  The impact of this is

    45 # that you can create any number of classes derived from Class::Singleton

    46 # and create a single instance of each one.  If the _instance variable

    47 # was stored in the Class::Singleton package, you could only instantiate 

    48 # *ONE* object of *ANY* class derived from Class::Singleton.  The first

    49 # time the instance is created, the _new_instance() constructor is called 

    50 # which simply returns a reference to a blessed hash.  This can be 

    51 # overloaded for custom constructors.  Any addtional parameters passed to 

    52 # instance() are forwarded to _new_instance().

    53 #

    54 # Returns a reference to the existing, or a newly created Class::Singleton

    55 # object.  If the _new_instance() method returns an undefined value

    56 # then the constructer is deemed to have failed.

    57 #

    58 #========================================================================

    59 

    60 sub instance {

    61     my $class = shift;

    62 

    63     # get a reference to the _instance variable in the $class package 

    64     no strict 'refs';

    65     my $instance = \${ "$class\::_instance" };

    66 

    67     defined $$instance

    68 	? $$instance

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

    70 }

    71 

    72 

    73 

    74 #========================================================================

    75 #

    76 # _new_instance(...)

    77 #

    78 # Simple constructor which returns a hash reference blessed into the 

    79 # current class.  May be overloaded to create non-hash objects or 

    80 # handle any specific initialisation required.

    81 #

    82 # Returns a reference to the blessed hash.

    83 #

    84 #========================================================================

    85 

    86 sub _new_instance {

    87     bless { }, $_[0];

    88 }

    89 

    90 

    91 

    92 1;

    93 

    94 __END__

    95 

    96 =head1 NAME

    97 

    98 Class::Singleton - Implementation of a "Singleton" class 

    99 

   100 =head1 SYNOPSIS

   101 

   102     use Class::Singleton;

   103 

   104     my $one = Class::Singleton->instance();   # returns a new instance

   105     my $two = Class::Singleton->instance();   # returns same instance

   106 

   107 =head1 DESCRIPTION

   108 

   109 This is the Class::Singleton module.  A Singleton describes an object class

   110 that can have only one instance in any system.  An example of a Singleton

   111 might be a print spooler or system registry.  This module implements a

   112 Singleton class from which other classes can be derived.  By itself, the

   113 Class::Singleton module does very little other than manage the instantiation

   114 of a single object.  In deriving a class from Class::Singleton, your module 

   115 will inherit the Singleton instantiation method and can implement whatever

   116 specific functionality is required.

   117 

   118 For a description and discussion of the Singleton class, see 

   119 "Design Patterns", Gamma et al, Addison-Wesley, 1995, ISBN 0-201-63361-2.

   120 

   121 =head1 PREREQUISITES

   122 

   123 Class::Singleton requires Perl version 5.004 or later.  If you have an older 

   124 version of Perl, please upgrade to latest version.  Perl 5.004 is known 

   125 to be stable and includes new features and defect fixes over previous

   126 versions.  Perl itself is available from your nearest CPAN site (see

   127 INSTALLATION below).

   128 

   129 =head1 INSTALLATION

   130 

   131 The Class::Singleton module is available from CPAN. As the 'perlmod' man

   132 page explains:

   133 

   134     CPAN stands for the Comprehensive Perl Archive Network.

   135     This is a globally replicated collection of all known Perl

   136     materials, including hundreds of unbunded modules.

   137 

   138     [...]

   139 

   140     For an up-to-date listing of CPAN sites, see

   141     http://www.perl.com/perl/ or ftp://ftp.perl.com/perl/ .

   142 

   143 The module is available in the following directories:

   144 

   145     /modules/by-module/Class/Class-Singleton-<version>.tar.gz

   146     /authors/id/ABW/Class-Singleton-<version>.tar.gz

   147 

   148 For the latest information on Class-Singleton or to download the latest

   149 pre-release/beta version of the module, consult the definitive reference:

   150 

   151     http://www.kfs.org/~abw/perl/

   152 

   153 Class::Singleton is distributed as a single gzipped tar archive file:

   154 

   155     Class-Singleton-<version>.tar.gz

   156 

   157 Note that "<version>" represents the current version number, of the 

   158 form "1.23".  See L<REVISION> below to determine the current version 

   159 number for Class::Singleton.

   160 

   161 Unpack the archive to create an installation directory:

   162 

   163     gunzip Class-Singleton-<version>.tar.gz

   164     tar xvf Class-Singleton-<version>.tar

   165 

   166 'cd' into that directory, make, test and install the module:

   167 

   168     cd Class-Singleton-<version>

   169     perl Makefile.PL

   170     make

   171     make test

   172     make install

   173 

   174 The 'make install' will install the module on your system.  You may need 

   175 root access to perform this task.  If you install the module in a local 

   176 directory (for example, by executing "perl Makefile.PL LIB=~/lib" in the 

   177 above - see C<perldoc MakeMaker> for full details), you will need to ensure 

   178 that the PERL5LIB environment variable is set to include the location, or 

   179 add a line to your scripts explicitly naming the library location:

   180 

   181     use lib '/local/path/to/lib';

   182 

   183 =head1 USING THE CLASS::SINGLETON MODULE

   184 

   185 To import and use the Class::Singleton module the following line should 

   186 appear in your Perl script:

   187 

   188     use Class::Singleton;

   189 

   190 The instance() method is used to create a new Class::Singleton instance, 

   191 or return a reference to an existing instance.  Using this method, it

   192 is only possible to have a single instance of the class in any system.

   193 

   194     my $highlander = Class::Singleton->instance();

   195 

   196 Assuming that no Class::Singleton object currently exists, this first

   197 call to instance() will create a new Class::Singleton and return a reference

   198 to it.  Future invocations of instance() will return the same reference.

   199 

   200     my $macleod    = Class::Singleton->instance();

   201 

   202 In the above example, both $highlander and $macleod contain the same

   203 reference to a Class::Singleton instance.  There can be only one.

   204 

   205 =head1 DERIVING SINGLETON CLASSES

   206 

   207 A module class may be derived from Class::Singleton and will inherit the 

   208 instance() method that correctly instantiates only one object.

   209 

   210     package PrintSpooler;

   211     use vars qw(@ISA);

   212     @ISA = qw(Class::Singleton);

   213 

   214     # derived class specific code

   215     sub submit_job {

   216         ...

   217     }

   218 

   219     sub cancel_job {

   220         ...

   221     }

   222 

   223 The PrintSpooler class defined above could be used as follows:

   224 

   225     use PrintSpooler;

   226 

   227     my $spooler = PrintSpooler->instance();

   228 

   229     $spooler->submit_job(...);

   230 

   231 The instance() method calls the _new_instance() constructor method the 

   232 first and only time a new instance is created.  All parameters passed to 

   233 the instance() method are forwarded to _new_instance().  In the base class

   234 this method returns a blessed reference to an empty hash array.  Derived 

   235 classes may redefine it to provide specific object initialisation or change

   236 the underlying object type (to a list reference, for example).

   237 

   238     package MyApp::Database;

   239     use vars qw( $ERROR );

   240     use base qw( Class::Singleton );

   241     use DBI;

   242 

   243     $ERROR = '';

   244 

   245     # this only gets called the first time instance() is called

   246     sub _new_instance {

   247 	my $class = shift;

   248 	my $self  = bless { }, $class;

   249 	my $db    = shift || "myappdb";    

   250 	my $host  = shift || "localhost";

   251 

   252 	unless (defined ($self->{ DB } 

   253 			 = DBI->connect("DBI:mSQL:$db:$host"))) {

   254 	    $ERROR = "Cannot connect to database: $DBI::errstr\n";

   255 	    # return failure;

   256 	    return undef;

   257 	}

   258 

   259 	# any other initialisation...

   260 	

   261 	# return sucess

   262 	$self;

   263     }

   264 

   265 The above example might be used as follows:

   266 

   267     use MyApp::Database;

   268 

   269     # first use - database gets initialised

   270     my $database = MyApp::Database->instance();

   271     die $MyApp::Database::ERROR unless defined $database;

   272 

   273 Some time later on in a module far, far away...

   274 

   275     package MyApp::FooBar

   276     use MyApp::Database;

   277 

   278     sub new {

   279 	# usual stuff...

   280 	

   281 	# this FooBar object needs access to the database; the Singleton

   282 	# approach gives a nice wrapper around global variables.

   283 

   284 	# subsequent use - existing instance gets returned

   285 	my $database = MyApp::Database->instance();

   286 

   287 	# the new() isn't called if an instance already exists,

   288 	# so the above constructor shouldn't fail, but we check

   289 	# anyway.  One day things might change and this could be the

   290 	# first call to instance()...  

   291 	die $MyAppDatabase::ERROR unless defined $database;

   292 

   293 	# more stuff...

   294     }

   295 

   296 The Class::Singleton instance() method uses a package variable to store a

   297 reference to any existing instance of the object.  This variable, 

   298 "_instance", is coerced into the derived class package rather than

   299 the base class package.

   300 

   301 Thus, in the MyApp::Database example above, the instance variable would

   302 be:

   303 

   304     $MyApp::Database::_instance;

   305 

   306 This allows different classes to be derived from Class::Singleton that 

   307 can co-exist in the same system, while still allowing only one instance

   308 of any one class to exists.  For example, it would be possible to 

   309 derive both 'PrintSpooler' and 'MyApp::Database' from Class::Singleton and

   310 have a single instance of I<each> in a system, rather than a single 

   311 instance of I<either>.

   312 

   313 =head1 AUTHOR

   314 

   315 Andy Wardley, C<E<lt>abw@cre.canon.co.ukE<gt>>

   316 

   317 Web Technology Group, Canon Research Centre Europe Ltd.

   318 

   319 Thanks to Andreas Koenig C<E<lt>andreas.koenig@anima.deE<gt>> for providing

   320 some significant speedup patches and other ideas.

   321 

   322 =head1 REVISION

   323 

   324 $Revision: 1.3 $

   325 

   326 =head1 COPYRIGHT

   327 

   328 Copyright (C) 1998 Canon Research Centre Europe Ltd.  All Rights Reserved.

   329 

   330 This module is free software; you can redistribute it and/or modify it under 

   331 the term of the Perl Artistic License.

   332 

   333 =head1 SEE ALSO

   334 

   335 =over 4

   336 

   337 =item Canon Research Centre Europe Perl Pages

   338 

   339 http://www.cre.canon.co.uk/perl/

   340 

   341 =item The Author's Home Page

   342 

   343 http://www.kfs.org/~abw/

   344 

   345 =item Design Patterns

   346 

   347 Class::Singleton is an implementation of the Singleton class described in 

   348 "Design Patterns", Gamma et al, Addison-Wesley, 1995, ISBN 0-201-63361-2

   349 

   350 =back

   351 

   352 =cut