| Filename | /home/s1/perl5/perlbrew/perls/perl-5.22.1/lib/site_perl/5.22.1/Class/Singleton.pm |
| Statements | Executed 15019 statements in 7.32ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 3002 | 2 | 1 | 5.23ms | 5.24ms | Class::Singleton::instance |
| 1 | 1 | 1 | 30µs | 34µs | Class::Singleton::BEGIN@19 |
| 1 | 1 | 1 | 11µs | 18µs | Class::Singleton::BEGIN@20 |
| 1 | 1 | 1 | 3µs | 3µs | Class::Singleton::END |
| 0 | 0 | 0 | 0s | 0s | Class::Singleton::_new_instance |
| 0 | 0 | 0 | 0s | 0s | Class::Singleton::has_instance |
| Line | State ments |
Time on line |
Calls | Time in subs |
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@wardley.org> | ||||
| 11 | # | ||||
| 12 | # Copyright (C) 1998-2008 Andy Wardley. All Rights Reserved. | ||||
| 13 | # Copyright (C) 1998 Canon Research Centre Europe Ltd. | ||||
| 14 | # | ||||
| 15 | #============================================================================ | ||||
| 16 | |||||
| 17 | package Class::Singleton; | ||||
| 18 | 1 | 12µs | require 5.004; | ||
| 19 | 2 | 53µs | 2 | 38µs | # spent 34µs (30+4) within Class::Singleton::BEGIN@19 which was called:
# once (30µs+4µs) by parent::import at line 19 # spent 34µs making 1 call to Class::Singleton::BEGIN@19
# spent 4µs making 1 call to strict::import |
| 20 | 2 | 253µs | 2 | 25µs | # spent 18µs (11+7) within Class::Singleton::BEGIN@20 which was called:
# once (11µs+7µs) by parent::import at line 20 # spent 18µs making 1 call to Class::Singleton::BEGIN@20
# spent 7µs making 1 call to warnings::import |
| 21 | |||||
| 22 | 1 | 300ns | our $VERSION = 1.5; | ||
| 23 | 1 | 900ns | my %_INSTANCES = (); | ||
| 24 | |||||
| 25 | |||||
| 26 | #======================================================================== | ||||
| 27 | # | ||||
| 28 | # instance() | ||||
| 29 | # | ||||
| 30 | # Module constructor. Creates an Class::Singleton (or derived) instance | ||||
| 31 | # if one doesn't already exist. The instance reference is stored in the | ||||
| 32 | # %_INSTANCES hash of the Class::Singleton package. The impact of this is | ||||
| 33 | # that you can create any number of classes derived from Class::Singleton | ||||
| 34 | # and create a single instance of each one. If the instance reference | ||||
| 35 | # was stored in a scalar $_INSTANCE variable, you could only instantiate | ||||
| 36 | # *ONE* object of *ANY* class derived from Class::Singleton. The first | ||||
| 37 | # time the instance is created, the _new_instance() constructor is called | ||||
| 38 | # which simply returns a reference to a blessed hash. This can be | ||||
| 39 | # overloaded for custom constructors. Any addtional parameters passed to | ||||
| 40 | # instance() are forwarded to _new_instance(). | ||||
| 41 | # | ||||
| 42 | # Returns a reference to the existing, or a newly created Class::Singleton | ||||
| 43 | # object. If the _new_instance() method returns an undefined value | ||||
| 44 | # then the constructer is deemed to have failed. | ||||
| 45 | # | ||||
| 46 | #======================================================================== | ||||
| 47 | |||||
| 48 | # spent 5.24ms (5.23+9µs) within Class::Singleton::instance which was called 3002 times, avg 2µs/call:
# 3000 times (5.22ms+4µs) by DateTime::TimeZone::new at line 57 of DateTime/TimeZone.pm, avg 2µs/call
# 2 times (17µs+5µs) by DateTime::TimeZone::new at line 49 of DateTime/TimeZone.pm, avg 11µs/call | ||||
| 49 | 3002 | 700µs | my $class = shift; | ||
| 50 | |||||
| 51 | # already got an object | ||||
| 52 | 3002 | 302µs | return $class if ref $class; | ||
| 53 | |||||
| 54 | # we store the instance against the $class key of %_INSTANCES | ||||
| 55 | 3002 | 794µs | my $instance = $_INSTANCES{$class}; | ||
| 56 | 3002 | 500µs | 2 | 9µs | unless(defined $instance) { # spent 5µs making 1 call to DateTime::TimeZone::Floating::_new_instance
# spent 4µs making 1 call to DateTime::TimeZone::UTC::_new_instance |
| 57 | $_INSTANCES{$class} = $instance = $class->_new_instance(@_); | ||||
| 58 | } | ||||
| 59 | 3002 | 4.69ms | return $instance; | ||
| 60 | } | ||||
| 61 | |||||
| 62 | |||||
| 63 | #======================================================================= | ||||
| 64 | # has_instance() | ||||
| 65 | # | ||||
| 66 | # Public method to return the current instance if it exists. | ||||
| 67 | #======================================================================= | ||||
| 68 | |||||
| 69 | sub has_instance { | ||||
| 70 | my $class = shift; | ||||
| 71 | $class = ref $class || $class; | ||||
| 72 | return $_INSTANCES{$class}; | ||||
| 73 | } | ||||
| 74 | |||||
| 75 | |||||
| 76 | #======================================================================== | ||||
| 77 | # _new_instance(...) | ||||
| 78 | # | ||||
| 79 | # Simple constructor which returns a hash reference blessed into the | ||||
| 80 | # current class. May be overloaded to create non-hash objects or | ||||
| 81 | # handle any specific initialisation required. | ||||
| 82 | #======================================================================== | ||||
| 83 | |||||
| 84 | sub _new_instance { | ||||
| 85 | my $class = shift; | ||||
| 86 | my %args = @_ && ref $_[0] eq 'HASH' ? %{ $_[0] } : @_; | ||||
| 87 | bless { %args }, $class; | ||||
| 88 | } | ||||
| 89 | |||||
| 90 | |||||
| 91 | #======================================================================== | ||||
| 92 | # END() | ||||
| 93 | # | ||||
| 94 | # END block to explicitly destroy all Class::Singleton objects since | ||||
| 95 | # destruction order at program exit is not predictable. See CPAN RT | ||||
| 96 | # bugs #23568 and #68526 for examples of what can go wrong without this. | ||||
| 97 | #======================================================================== | ||||
| 98 | |||||
| 99 | # spent 3µs within Class::Singleton::END which was called:
# once (3µs+0s) by main::RUNTIME at line 0 of -e | ||||
| 100 | # dereferences and causes orderly destruction of all instances | ||||
| 101 | 1 | 5µs | undef(%_INSTANCES); | ||
| 102 | } | ||||
| 103 | |||||
| 104 | |||||
| 105 | 1 | 5µs | 1; | ||
| 106 | |||||
| 107 | __END__ |