FCL/sftools/dev/build: comparison releasing/cbrtools/perl/Class/Singleton.pm

equal deleted inserted replaced

-:6d08f4a05d93
+:3145852acc89
+#============================================================================
+#
+# 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