Class-Singleton-1.5/0000755000177200010010000000000012427235027013130 5ustar SteveNoneClass-Singleton-1.5/Changes0000644000177200010010000000360612427232625014431 0ustar SteveNone#------------------------------------------------------------------------ # Version 1.5 Date: 2014/11/07 #------------------------------------------------------------------------ * Work around global destruction order issue. [Craig Manley , CPAN RT#23568/68526] #------------------------------------------------------------------------ # Version 1.4 Date: 2007/09/28 #------------------------------------------------------------------------ * Added the has_instance() method to return an existing instance without creating a new one. * General cleanup of code, documentation and tests. * Changed licence from Perl Artistic to the same terms as Perl itself (e.g. Artistic 2.0/GPL) #------------------------------------------------------------------------ # Version 1.03 Date: 1999/01/19 #------------------------------------------------------------------------ * Incorporated patches from Andreas Koenig to inline calculation of $instance variable. This results in a speedup of around 35%. * Added _new_instance() constructor which is called the first time _instance() is called. This can be overloaded in derived classes to provide more specific object initialisation. * Updated documentation accordingly. #------------------------------------------------------------------------ # Version 1.02 Date: 1998/04/16 #------------------------------------------------------------------------ * Fixed minor typos and corrected example in documentation. #------------------------------------------------------------------------ # Version 1.01 Date: 1998/02/10 #------------------------------------------------------------------------ * Minor documentation changes #------------------------------------------------------------------------ # Version 1.00 Date: 1998/02/10 #------------------------------------------------------------------------ * Initial revision Class-Singleton-1.5/lib/0000755000177200010010000000000010677134420013676 5ustar SteveNoneClass-Singleton-1.5/lib/Class/0000755000177200010010000000000010677134420014743 5ustar SteveNoneClass-Singleton-1.5/lib/Class/Singleton.pm0000644000177200010010000003024712427234760017254 0ustar SteveNone#============================================================================ # # 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-2008 Andy Wardley. All Rights Reserved. # Copyright (C) 1998 Canon Research Centre Europe Ltd. # #============================================================================ package Class::Singleton; require 5.004; use strict; use warnings; our $VERSION = 1.5; my %_INSTANCES = (); #======================================================================== # # instance() # # Module constructor. Creates an Class::Singleton (or derived) instance # if one doesn't already exist. The instance reference is stored in the # %_INSTANCES hash of 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 reference # was stored in a scalar $_INSTANCE variable, 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; # already got an object return $class if ref $class; # we store the instance against the $class key of %_INSTANCES my $instance = $_INSTANCES{$class}; unless(defined $instance) { $_INSTANCES{$class} = $instance = $class->_new_instance(@_); } return $instance; } #======================================================================= # has_instance() # # Public method to return the current instance if it exists. #======================================================================= sub has_instance { my $class = shift; $class = ref $class || $class; return $_INSTANCES{$class}; } #======================================================================== # _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. #======================================================================== sub _new_instance { my $class = shift; my %args = @_ && ref $_[0] eq 'HASH' ? %{ $_[0] } : @_; bless { %args }, $class; } #======================================================================== # END() # # END block to explicitly destroy all Class::Singleton objects since # destruction order at program exit is not predictable. See CPAN RT # bugs #23568 and #68526 for examples of what can go wrong without this. #======================================================================== END { # dereferences and causes orderly destruction of all instances undef(%_INSTANCES); } 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 C 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 C module does very little other than manage the instantiation of a single object. In deriving a class from C, 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 C requires Perl version 5.004 or later. If you have an older version of Perl, please upgrade to latest version, available from your nearest CPAN site (see L below). =head1 INSTALLATION The C 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 C is distributed as a single gzipped tar archive file: Class-Singleton-.tar.gz Note that "" represents the current version number, of the form "C<1.23>". See L below to determine the current version number for C. 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 'C' 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 "C" in the above - see C for full details), you will need to ensure that the C 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 C module the following line should appear in your Perl program: use Class::Singleton; The L method is used to create a new C 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 C object currently exists, this first call to L will create a new C and return a reference to it. Future invocations of L will return the same reference. my $macleod = Class::Singleton->instance(); In the above example, both C<$highlander> and C<$macleod> contain the same reference to a C instance. There can be only one. =head1 DERIVING SINGLETON CLASSES A module class may be derived from C and will inherit the L method that correctly instantiates only one object. package PrintSpooler; use base 'Class::Singleton'; # derived class specific code sub submit_job { ... } sub cancel_job { ... } The C class defined above could be used as follows: use PrintSpooler; my $spooler = PrintSpooler->instance(); $spooler->submit_job(...); The L method calls the L<_new_instance()> constructor method the first and only time a new instance is created. All parameters passed to the L method are forwarded to L<_new_instance()>. In the base class the L<_new_instance()> method returns a blessed reference to a hash array containing any arguments passed as either a hash reference or list of named parameters. package MyConfig; use base 'Class::Singleton'; sub foo { shift->{ foo }; } sub bar { shift->{ bar }; } package main; # either: hash reference of named parameters my $config = MyConfig->instance({ foo => 10, bar => 20 }); # or: list of named parameters my $config = MyConfig->instance( foo => 10, bar => 20 ); print $config->foo(); # 10 print $config->bar(); # 20 Derived classes may redefine the L<_new_instance()> method to provide more specific object initialisation or change the underlying object type (to a list reference, for example). package MyApp::Database; use base 'Class::Singleton'; use DBI; # 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"; $self->{ DB } = DBI->connect("DBI:mSQL:$db:$host") || die "Cannot connect to database: $DBI::errstr"; # any other initialisation... return $self; } The above example might be used as follows: use MyApp::Database; # first use - database gets initialised my $database = MyApp::Database->instance(); Some time later on in a module far, far away... package MyApp::FooBar use MyApp::Database; # this FooBar object needs access to the database; the Singleton # approach gives a nice wrapper around global variables. sub new { my $class = shift; bless { database => MyApp::Database->instance(), }, $class; } The C L method uses a private hash to store a reference to any existing instance of the object, keyed against the derived class package name. This allows different classes to be derived from C that can co-exist in the same system, while still allowing only one instance of any one class to exist. For example, it would be possible to derive both 'C' and 'C' from C and have a single instance of I in a system, rather than a single instance of I. You can use the L method to find out if a particular class already has an instance defined. A reference to the instance is returned or C if none is currently defined. my $instance = MyApp::Database->has_instance() || warn "No instance is defined yet"; =head1 METHODS =head2 instance() This method is called to return a current object instance or create a new one by calling L<_new_instance()>. =head2 has_instance() This method returns a reference to any existing instance or C if none is defined. my $testing = MySingleton1->has_instance() || warn "No instance defined for MySingleton1"; =head2 _new_instance() This "private" method is called by L to create a new object instance if one doesn't already exist. It is not intended to be called directly (although there's nothing to stop you from calling it if you're really determined to do so). It creates a blessed hash reference containing any arguments passed to the method as either a hash reference or list of named parameters. # either: hash reference of named parameters my $example1 = MySingleton1->new({ pi => 3.14, e => 2.718 }); # or: list of named parameters my $example2 = MySingleton2->new( pi => 3.14, e => 2.718 ); It is important to remember that the L method will I call the I<_new_instance()> method once, so any arguments you pass may be silently ignored if an instance already exists. You can use the L method to determine if an instance is already defined. =head1 AUTHOR Andy Wardley Eabw@wardley.orgE L Thanks to Andreas Koenig for providing some significant speedup patches and other ideas. =head1 VERSION This is version 1.5, released November 2014 =head1 COPYRIGHT Copyright Andy Wardley 1998-2007. All Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Class-Singleton-1.5/Makefile.PL0000644000177200010010000000073010677126112015101 0ustar SteveNoneuse ExtUtils::MakeMaker; my %opts = ( 'NAME' => 'Class::Singleton', 'VERSION_FROM' => 'lib/Class/Singleton.pm', # finds $VERSION 'PMLIBDIRS' => [ 'lib' ], 'dist' => { 'COMPRESS' => 'gzip', 'SUFFIX' => 'gz', }, ); if ($ExtUtils::MakeMaker::VERSION >= 5.43) { $opts{ AUTHOR } = 'Andy Wardley '; $opts{ ABSTRACT } = 'Base class for creating singleton objects', } WriteMakefile( %opts ); Class-Singleton-1.5/MANIFEST0000644000177200010010000000023010677134420014254 0ustar SteveNoneChanges MANIFEST Makefile.PL README lib/Class/Singleton.pm t/singleton.t META.yml Module meta-data (added by MakeMaker) Class-Singleton-1.5/META.yml0000644000177200010010000000062112427232251014374 0ustar SteveNone--- #YAML:1.0 name: Class-Singleton version: 1.5 abstract: Base class for creating singleton objects license: ~ generated_by: ExtUtils::MakeMaker version 6.31 distribution_type: module requires: meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.2.html version: 1.2 author: - Andy Wardley Class-Singleton-1.5/README0000644000177200010010000002213012427235577014020 0ustar SteveNoneNAME Class::Singleton - Implementation of a "Singleton" class SYNOPSIS use Class::Singleton; my $one = Class::Singleton->instance(); # returns a new instance my $two = Class::Singleton->instance(); # returns same instance 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. PREREQUISITES "Class::Singleton" requires Perl version 5.004 or later. If you have an older version of Perl, please upgrade to latest version, available from your nearest CPAN site (see INSTALLATION below). 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 "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 VERSION 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 "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'; USING THE CLASS::SINGLETON MODULE To import and use the "Class::Singleton" module the following line should appear in your Perl program: 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. 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 base '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 the _new_instance() method returns a blessed reference to a hash array containing any arguments passed as either a hash reference or list of named parameters. package MyConfig; use base 'Class::Singleton'; sub foo { shift->{ foo }; } sub bar { shift->{ bar }; } package main; # either: hash reference of named parameters my $config = MyConfig->instance({ foo => 10, bar => 20 }); # or: list of named parameters my $config = MyConfig->instance( foo => 10, bar => 20 ); print $config->foo(); # 10 print $config->bar(); # 20 Derived classes may redefine the _new_instance() method to provide more specific object initialisation or change the underlying object type (to a list reference, for example). package MyApp::Database; use base 'Class::Singleton'; use DBI; # 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"; $self->{ DB } = DBI->connect("DBI:mSQL:$db:$host") || die "Cannot connect to database: $DBI::errstr"; # any other initialisation... return $self; } The above example might be used as follows: use MyApp::Database; # first use - database gets initialised my $database = MyApp::Database->instance(); Some time later on in a module far, far away... package MyApp::FooBar use MyApp::Database; # this FooBar object needs access to the database; the Singleton # approach gives a nice wrapper around global variables. sub new { my $class = shift; bless { database => MyApp::Database->instance(), }, $class; } The "Class::Singleton" instance() method uses a private hash to store a reference to any existing instance of the object, keyed against the derived class package name. 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 exist. For example, it would be possible to derive both '"PrintSpooler"' and '"MyApp::Database"' from "Class::Singleton" and have a single instance of *each* in a system, rather than a single instance of *either*. You can use the has_instance() method to find out if a particular class already has an instance defined. A reference to the instance is returned or "undef" if none is currently defined. my $instance = MyApp::Database->has_instance() || warn "No instance is defined yet"; METHODS instance() This method is called to return a current object instance or create a new one by calling _new_instance(). has_instance() This method returns a reference to any existing instance or "undef" if none is defined. my $testing = MySingleton1->has_instance() || warn "No instance defined for MySingleton1"; _new_instance() This "private" method is called by instance() to create a new object instance if one doesn't already exist. It is not intended to be called directly (although there's nothing to stop you from calling it if you're really determined to do so). It creates a blessed hash reference containing any arguments passed to the method as either a hash reference or list of named parameters. # either: hash reference of named parameters my $example1 = MySingleton1->new({ pi => 3.14, e => 2.718 }); # or: list of named parameters my $example2 = MySingleton2->new( pi => 3.14, e => 2.718 ); It is important to remember that the instance() method will *only* call the *_new_instance()* method once, so any arguments you pass may be silently ignored if an instance already exists. You can use the has_instance() method to determine if an instance is already defined. AUTHOR Andy Wardley Thanks to Andreas Koenig for providing some significant speedup patches and other ideas. VERSION This is version 1.5, released November 2014 COPYRIGHT Copyright Andy Wardley 1998-2007. All Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Class-Singleton-1.5/t/0000755000177200010010000000000010677134420013373 5ustar SteveNoneClass-Singleton-1.5/t/singleton.t0000755000177200010010000001322610677133151015571 0ustar SteveNone# # Class::Singleton test script # # Andy Wardley # use strict; use warnings; use Test::More tests => 29; use lib qw( lib ../lib ); use Class::Singleton; # the final test is run by a destructor which is called after Test::Builder # would normally print the test summary, so we disable that Test::More->builder->no_ending(1); ok(1, 'loaded Class::Singleton'); #------------------------------------------------------------------------ # define 'DerivedSingleton', a class derived from Class::Singleton #------------------------------------------------------------------------ package DerivedSingleton; use base 'Class::Singleton'; #------------------------------------------------------------------------ # define 'AnotherSingleton', a class derived from DerivedSingleton #------------------------------------------------------------------------ package AnotherSingleton; use base 'DerivedSingleton'; sub x { shift->{ x }; } #------------------------------------------------------------------------ # define 'ListSingleton', which uses a list reference as its type #------------------------------------------------------------------------ package ListSingleton; use base 'Class::Singleton'; sub _new_instance { my $class = shift; bless [], $class; } #------------------------------------------------------------------------ # define 'ConfigSingleton', which has specific configuration needs. #------------------------------------------------------------------------ package ConfigSingleton; use base 'Class::Singleton'; sub _new_instance { my $class = shift; my $config = shift || { }; my $self = { 'one' => 'This is the first parameter', 'two' => 'This is the second parameter', %$config, }; bless $self, $class; } #----------------------------------------------------------------------- # define 'DestructorSingleton' which has a destructor method #----------------------------------------------------------------------- package DestructorSingleton; use base 'Class::Singleton'; sub DESTROY { main::ok(1, 'destructor called' ); } #======================================================================== # -- TESTS -- #======================================================================== package main; # call Class::Singleton->instance() twice and expect to get the same # reference returned on both occasions. ok( ! Class::Singleton->has_instance(), 'no Class::Singleton instance yet' ); my $s1 = Class::Singleton->instance(); ok( $s1, 'created Class::Singleton instance 1' ); my $s2 = Class::Singleton->instance(); ok( $s2, 'created Class::Singleton instance 2' ); is( $s1, $s2, 'both instances are the same object' ); is( Class::Singleton->has_instance(), $s1, 'Class::Singleton has instance' ); # call MySingleton->instance() twice and expect to get the same # reference returned on both occasions. ok( ! DerivedSingleton->has_instance(), 'no DerivedSingleton instance yet' ); my $s3 = DerivedSingleton->instance(); ok( $s3, 'created DerivedSingleton instance 1' ); my $s4 = DerivedSingleton->instance(); ok( $s4, 'created DerivedSingleton instance 2' ); is( $s3, $s4, 'both derived instances are the same object' ); is( DerivedSingleton->has_instance(), $s3, 'DerivedSingleton has instance' ); # call MyOtherSingleton->instance() twice and expect to get the same # reference returned on both occasions. my $s5 = AnotherSingleton->instance( x => 10 ); ok( $s5, 'created AnotherSingleton instance 1' ); is( $s5->x, 10, 'first instance x is 10' ); my $s6 = AnotherSingleton->instance(); ok( $s6, 'created AnotherSingleton instance 2' ); is( $s6->x, 10, 'second instance x is 10' ); is( $s5, $s6, 'both another instances are the same object' ); #------------------------------------------------------------------------ # having checked that each instance of the same class is the same, we now # check that the instances of the separate classes are actually different # from each other #------------------------------------------------------------------------ isnt( $s1, $s3, "Class::Singleton and DerviedSingleton are different"); isnt( $s1, $s5, "Class::Singleton and AnotherSingleton are different"); isnt( $s3, $s5, "DerivedSingleton and AnotherSingleton are different"); #------------------------------------------------------------------------ # test ListSingleton #------------------------------------------------------------------------ my $ls1 = ListSingleton->instance(); ok( $ls1, 'created ListSingleton instance 1' ); my $ls2 = ListSingleton->instance(); ok( $ls2, 'created ListSingleton instance 2' ); is( $ls1, $ls2, 'both list instances are the same object' ); ok( $ls1 =~ /ARRAY/, "ListSingleton is a list reference"); #------------------------------------------------------------------------ # test ConfigSingleton #------------------------------------------------------------------------ # create a ConfigSingleton my $config = { 'foo' => 'This is foo' }; my $cs1 = ConfigSingleton->instance($config); ok( $cs1, 'created ConfigSingleton instance 1' ); # add another parameter to the config $config->{'bar'} = 'This is bar'; # shouldn't call new() so changes to $config shouldn't matter my $cs2 = ConfigSingleton->instance($config); ok( $cs2, 'created ConfigSingleton instance 2' ); is( $cs1, $cs2, 'both config instances are the same object' ); is( scalar(keys %$cs1), 3, "ConfigSingleton 1 has 3 keys"); is( scalar(keys %$cs2), 3, "ConfigSingleton 2 has 3 keys"); #----------------------------------------------------------------------- # test DestructorSingleton #----------------------------------------------------------------------- my $ds1 = DestructorSingleton->instance();