releasing/cbrtools/perl/Class/Singleton.pm
changeset 607 378360dbbdba
parent 602 3145852acc89
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/releasing/cbrtools/perl/Class/Singleton.pm	Wed Jun 30 11:35:58 2010 +0800
@@ -0,0 +1,352 @@
+#============================================================================
+#
+# 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 <abw@cre.canon.co.uk>
+#
+# Copyright (C) 1998 Canon Research Centre Europe Ltd.  All Rights Reserved.
+#
+#----------------------------------------------------------------------------
+#
+# $Id: Singleton.pm,v 1.3 1999/01/19 15:57:43 abw Exp $
+#
+#============================================================================
+
+package Class::Singleton;
+
+require 5.004;
+
+use strict;
+use vars qw( $RCS_ID $VERSION );
+
+$VERSION = sprintf("%d.%02d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/);
+$RCS_ID  = q$Id: Singleton.pm,v 1.3 1999/01/19 15:57:43 abw Exp $;
+
+
+
+#========================================================================
+#                      -----  PUBLIC METHODS -----
+#========================================================================
+
+#========================================================================
+#
+# instance()
+#
+# Module constructor.  Creates an Class::Singleton (or derivative) 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;
+
+    # get a reference to the _instance variable in the $class package 
+    no strict 'refs';
+    my $instance = \${ "$class\::_instance" };
+
+    defined $$instance
+	? $$instance
+	: ($$instance = $class->_new_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.
+#
+# Returns a reference to the blessed hash.
+#
+#========================================================================
+
+sub _new_instance {
+    bless { }, $_[0];
+}
+
+
+
+1;
+
+__END__
+
+=head1 NAME
+
+Class::Singleton - Implementation of a "Singleton" class 
+
+=head1 SYNOPSIS
+
+    use Class::Singleton;
+
+    my $one = Class::Singleton->instance();   # returns a new instance
+    my $two = Class::Singleton->instance();   # returns same instance
+
+=head1 DESCRIPTION
+
+This is the Class::Singleton module.  A Singleton describes an object class
+that can have only one instance in any system.  An example of a Singleton
+might be a print spooler or system registry.  This module implements a
+Singleton class from which other classes can be derived.  By itself, the
+Class::Singleton module does very little other than manage the instantiation
+of a single object.  In deriving a class from Class::Singleton, your module 
+will inherit the Singleton instantiation method and can implement whatever
+specific functionality is required.
+
+For a description and discussion of the Singleton class, see 
+"Design Patterns", Gamma et al, Addison-Wesley, 1995, ISBN 0-201-63361-2.
+
+=head1 PREREQUISITES
+
+Class::Singleton requires Perl version 5.004 or later.  If you have an older 
+version of Perl, please upgrade to latest version.  Perl 5.004 is known 
+to be stable and includes new features and defect fixes over previous
+versions.  Perl itself is available from your nearest CPAN site (see
+INSTALLATION below).
+
+=head1 INSTALLATION
+
+The Class::Singleton module is available from CPAN. As the 'perlmod' man
+page explains:
+
+    CPAN stands for the Comprehensive Perl Archive Network.
+    This is a globally replicated collection of all known Perl
+    materials, including hundreds of unbunded modules.
+
+    [...]
+
+    For an up-to-date listing of CPAN sites, see
+    http://www.perl.com/perl/ or ftp://ftp.perl.com/perl/ .
+
+The module is available in the following directories:
+
+    /modules/by-module/Class/Class-Singleton-<version>.tar.gz
+    /authors/id/ABW/Class-Singleton-<version>.tar.gz
+
+For the latest information on Class-Singleton or to download the latest
+pre-release/beta version of the module, consult the definitive reference:
+
+    http://www.kfs.org/~abw/perl/
+
+Class::Singleton is distributed as a single gzipped tar archive file:
+
+    Class-Singleton-<version>.tar.gz
+
+Note that "<version>" represents the current version number, of the 
+form "1.23".  See L<REVISION> below to determine the current version 
+number for Class::Singleton.
+
+Unpack the archive to create an installation directory:
+
+    gunzip Class-Singleton-<version>.tar.gz
+    tar xvf Class-Singleton-<version>.tar
+
+'cd' into that directory, make, test and install the module:
+
+    cd Class-Singleton-<version>
+    perl Makefile.PL
+    make
+    make test
+    make install
+
+The 'make install' will install the module on your system.  You may need 
+root access to perform this task.  If you install the module in a local 
+directory (for example, by executing "perl Makefile.PL LIB=~/lib" in the 
+above - see C<perldoc MakeMaker> for full details), you will need to ensure 
+that the PERL5LIB environment variable is set to include the location, or 
+add a line to your scripts explicitly naming the library location:
+
+    use lib '/local/path/to/lib';
+
+=head1 USING THE CLASS::SINGLETON MODULE
+
+To import and use the Class::Singleton module the following line should 
+appear in your Perl script:
+
+    use Class::Singleton;
+
+The instance() method is used to create a new Class::Singleton instance, 
+or return a reference to an existing instance.  Using this method, it
+is only possible to have a single instance of the class in any system.
+
+    my $highlander = Class::Singleton->instance();
+
+Assuming that no Class::Singleton object currently exists, this first
+call to instance() will create a new Class::Singleton and return a reference
+to it.  Future invocations of instance() will return the same reference.
+
+    my $macleod    = Class::Singleton->instance();
+
+In the above example, both $highlander and $macleod contain the same
+reference to a Class::Singleton instance.  There can be only one.
+
+=head1 DERIVING SINGLETON CLASSES
+
+A module class may be derived from Class::Singleton and will inherit the 
+instance() method that correctly instantiates only one object.
+
+    package PrintSpooler;
+    use vars qw(@ISA);
+    @ISA = qw(Class::Singleton);
+
+    # derived class specific code
+    sub submit_job {
+        ...
+    }
+
+    sub cancel_job {
+        ...
+    }
+
+The PrintSpooler class defined above could be used as follows:
+
+    use PrintSpooler;
+
+    my $spooler = PrintSpooler->instance();
+
+    $spooler->submit_job(...);
+
+The instance() method calls the _new_instance() constructor method the 
+first and only time a new instance is created.  All parameters passed to 
+the instance() method are forwarded to _new_instance().  In the base class
+this method returns a blessed reference to an empty hash array.  Derived 
+classes may redefine it to provide specific object initialisation or change
+the underlying object type (to a list reference, for example).
+
+    package MyApp::Database;
+    use vars qw( $ERROR );
+    use base qw( Class::Singleton );
+    use DBI;
+
+    $ERROR = '';
+
+    # this only gets called the first time instance() is called
+    sub _new_instance {
+	my $class = shift;
+	my $self  = bless { }, $class;
+	my $db    = shift || "myappdb";    
+	my $host  = shift || "localhost";
+
+	unless (defined ($self->{ DB } 
+			 = DBI->connect("DBI:mSQL:$db:$host"))) {
+	    $ERROR = "Cannot connect to database: $DBI::errstr\n";
+	    # return failure;
+	    return undef;
+	}
+
+	# any other initialisation...
+	
+	# return sucess
+	$self;
+    }
+
+The above example might be used as follows:
+
+    use MyApp::Database;
+
+    # first use - database gets initialised
+    my $database = MyApp::Database->instance();
+    die $MyApp::Database::ERROR unless defined $database;
+
+Some time later on in a module far, far away...
+
+    package MyApp::FooBar
+    use MyApp::Database;
+
+    sub new {
+	# usual stuff...
+	
+	# this FooBar object needs access to the database; the Singleton
+	# approach gives a nice wrapper around global variables.
+
+	# subsequent use - existing instance gets returned
+	my $database = MyApp::Database->instance();
+
+	# the new() isn't called if an instance already exists,
+	# so the above constructor shouldn't fail, but we check
+	# anyway.  One day things might change and this could be the
+	# first call to instance()...  
+	die $MyAppDatabase::ERROR unless defined $database;
+
+	# more stuff...
+    }
+
+The Class::Singleton instance() method uses a package variable to store a
+reference to any existing instance of the object.  This variable, 
+"_instance", is coerced into the derived class package rather than
+the base class package.
+
+Thus, in the MyApp::Database example above, the instance variable would
+be:
+
+    $MyApp::Database::_instance;
+
+This allows different classes to be derived from Class::Singleton that 
+can co-exist in the same system, while still allowing only one instance
+of any one class to exists.  For example, it would be possible to 
+derive both 'PrintSpooler' and 'MyApp::Database' from Class::Singleton and
+have a single instance of I<each> in a system, rather than a single 
+instance of I<either>.
+
+=head1 AUTHOR
+
+Andy Wardley, C<E<lt>abw@cre.canon.co.ukE<gt>>
+
+Web Technology Group, Canon Research Centre Europe Ltd.
+
+Thanks to Andreas Koenig C<E<lt>andreas.koenig@anima.deE<gt>> for providing
+some significant speedup patches and other ideas.
+
+=head1 REVISION
+
+$Revision: 1.3 $
+
+=head1 COPYRIGHT
+
+Copyright (C) 1998 Canon Research Centre Europe Ltd.  All Rights Reserved.
+
+This module is free software; you can redistribute it and/or modify it under 
+the term of the Perl Artistic License.
+
+=head1 SEE ALSO
+
+=over 4
+
+=item Canon Research Centre Europe Perl Pages
+
+http://www.cre.canon.co.uk/perl/
+
+=item The Author's Home Page
+
+http://www.kfs.org/~abw/
+
+=item Design Patterns
+
+Class::Singleton is an implementation of the Singleton class described in 
+"Design Patterns", Gamma et al, Addison-Wesley, 1995, ISBN 0-201-63361-2
+
+=back
+
+=cut