Filename | /home/s1/perl5/perlbrew/perls/perl-5.22.1/lib/site_perl/5.22.1/Class/Singleton.pm |
Statements | Executed 15019 statements in 12.4ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
3002 | 2 | 1 | 5.01ms | 5.02ms | instance | Class::Singleton::
1 | 1 | 1 | 23µs | 26µs | BEGIN@19 | Class::Singleton::
1 | 1 | 1 | 8µs | 14µs | BEGIN@20 | Class::Singleton::
1 | 1 | 1 | 3µs | 3µs | END | Class::Singleton::
0 | 0 | 0 | 0s | 0s | _new_instance | Class::Singleton::
0 | 0 | 0 | 0s | 0s | has_instance | Class::Singleton::
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 | 9µs | require 5.004; | ||
19 | 2 | 28µs | 2 | 29µs | # spent 26µs (23+3) within Class::Singleton::BEGIN@19 which was called:
# once (23µs+3µs) by parent::import at line 19 # spent 26µs making 1 call to Class::Singleton::BEGIN@19
# spent 3µs making 1 call to strict::import |
20 | 2 | 196µs | 2 | 20µs | # spent 14µs (8+6) within Class::Singleton::BEGIN@20 which was called:
# once (8µs+6µs) by parent::import at line 20 # spent 14µs making 1 call to Class::Singleton::BEGIN@20
# spent 6µs making 1 call to warnings::import |
21 | |||||
22 | 1 | 200ns | our $VERSION = 1.5; | ||
23 | 1 | 700ns | 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.02ms (5.01+7µs) within Class::Singleton::instance which was called 3002 times, avg 2µs/call:
# 3000 times (5.00ms+3µs) by DateTime::TimeZone::new at line 57 of DateTime/TimeZone.pm, avg 2µs/call
# 2 times (10µs+4µs) by DateTime::TimeZone::new at line 49 of DateTime/TimeZone.pm, avg 7µs/call | ||||
49 | 3002 | 645µs | my $class = shift; | ||
50 | |||||
51 | # already got an object | ||||
52 | 3002 | 322µs | return $class if ref $class; | ||
53 | |||||
54 | # we store the instance against the $class key of %_INSTANCES | ||||
55 | 3002 | 761µs | my $instance = $_INSTANCES{$class}; | ||
56 | 3002 | 483µs | 2 | 7µs | unless(defined $instance) { # spent 4µs making 1 call to DateTime::TimeZone::Floating::_new_instance
# spent 3µs making 1 call to DateTime::TimeZone::UTC::_new_instance |
57 | $_INSTANCES{$class} = $instance = $class->_new_instance(@_); | ||||
58 | } | ||||
59 | 3002 | 10.00ms | 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 | 4µs | undef(%_INSTANCES); | ||
102 | } | ||||
103 | |||||
104 | |||||
105 | 1 | 4µs | 1; | ||
106 | |||||
107 | __END__ |