File Coverage

blib/lib/Class/Singleton.pm
Criterion Covered Total %
statement 14 14 100.0
branch 2 2 100.0
condition n/a
subroutine 5 5 100.0
pod 0 1 0.0
total 21 22 95.5


line stmt bran cond sub pod time code
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 1     1   24 use strict;
  1         17  
  1         19  
25 1     1   16 use vars qw( $RCS_ID $VERSION );
  1         9  
  1         13  
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 10     10 0 6412     my $class = shift;
62              
63             # get a reference to the _instance variable in the $class package
64 1     1   19     no strict 'refs';
  1         10  
  1         15  
65 10         87     my $instance = \${ "$class\::_instance" };
  10         132  
66              
67 10 100       186     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 3     3   40     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 bug 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
353