diff -r 22486c9c7b15 -r 378360dbbdba releasing/cbrtools/perl/Class/Singleton.pm --- /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 +# +# 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-.tar.gz + /authors/id/ABW/Class-Singleton-.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-.tar.gz + +Note that "" represents the current version number, of the +form "1.23". See L below to determine the current version +number for Class::Singleton. + +Unpack the archive to create an installation directory: + + gunzip Class-Singleton-.tar.gz + tar xvf Class-Singleton-.tar + +'cd' into that directory, make, test and install the module: + + cd Class-Singleton- + 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 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 in a system, rather than a single +instance of I. + +=head1 AUTHOR + +Andy Wardley, Cabw@cre.canon.co.ukE> + +Web Technology Group, Canon Research Centre Europe Ltd. + +Thanks to Andreas Koenig Candreas.koenig@anima.deE> 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