Filename | /usr/local/lib/perl5/site_perl/Class/Singleton.pm |
Statements | Executed 9836 statements in 10.9ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1967 | 4 | 4 | 5.10ms | 5.13ms | instance | Class::Singleton::
1 | 1 | 1 | 19µs | 19µs | END | Class::Singleton::
0 | 0 | 0 | 0s | 0s | BEGIN@23 | Class::Singleton::
0 | 0 | 0 | 0s | 0s | BEGIN@24 | Class::Singleton::
0 | 0 | 0 | 0s | 0s | BEGIN@25 | 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 Canon Research Centre Europe Ltd. | ||||
13 | # Copyright (C) 1998-2008 Andy Wardley. All rights reserved. | ||||
14 | # Copyright (C) 2014 Steve Hay. All rights reserved. | ||||
15 | # | ||||
16 | # This module is free software; you can redistribute it and/or modify it under | ||||
17 | # the same terms as Perl itself, i.e. under the terms of either the GNU General | ||||
18 | # Public License or the Artistic License, as specified in the F<LICENCE> file. | ||||
19 | # | ||||
20 | #============================================================================ | ||||
21 | |||||
22 | package Class::Singleton; | ||||
23 | use 5.008001; | ||||
24 | use strict; | ||||
25 | use warnings; | ||||
26 | |||||
27 | our $VERSION = 1.6; | ||||
28 | my %_INSTANCES = (); | ||||
29 | |||||
30 | |||||
31 | #======================================================================== | ||||
32 | # | ||||
33 | # instance() | ||||
34 | # | ||||
35 | # Module constructor. Creates an Class::Singleton (or derived) instance | ||||
36 | # if one doesn't already exist. The instance reference is stored in the | ||||
37 | # %_INSTANCES hash of the Class::Singleton package. The impact of this is | ||||
38 | # that you can create any number of classes derived from Class::Singleton | ||||
39 | # and create a single instance of each one. If the instance reference | ||||
40 | # was stored in a scalar $_INSTANCE variable, you could only instantiate | ||||
41 | # *ONE* object of *ANY* class derived from Class::Singleton. The first | ||||
42 | # time the instance is created, the _new_instance() constructor is called | ||||
43 | # which simply returns a reference to a blessed hash. This can be | ||||
44 | # overloaded for custom constructors. Any additional parameters passed to | ||||
45 | # instance() are forwarded to _new_instance(). | ||||
46 | # | ||||
47 | # Returns a reference to the existing, or a newly created Class::Singleton | ||||
48 | # object. If the _new_instance() method returns an undefined value | ||||
49 | # then the constructer is deemed to have failed. | ||||
50 | # | ||||
51 | #======================================================================== | ||||
52 | |||||
53 | # spent 5.13ms (5.10+34µs) within Class::Singleton::instance which was called 1967 times, avg 3µs/call:
# 1507 times (4.31ms+0s) by Sympa::get_supported_languages at line 582 of /usr/local/libexec/sympa/Sympa.pm, avg 3µs/call
# 230 times (282µs+13µs) by Sympa::Spool::Listmaster::flush at line 106 of /usr/local/libexec/sympa/Sympa/Spool/Listmaster.pm, avg 1µs/call
# 229 times (504µs+21µs) by Sympa::Spindle::ProcessTask::_init at line 56 of /usr/local/libexec/sympa/Sympa/Spindle/ProcessTask.pm, avg 2µs/call
# once (4µs+0s) by main::RUNTIME at line 157 of /usr/local/libexec/sympa/task_manager-debug.pl | ||||
54 | 1967 | 590µs | my $class = shift; | ||
55 | |||||
56 | # already got an object | ||||
57 | 1967 | 483µs | return $class if ref $class; | ||
58 | |||||
59 | # we store the instance against the $class key of %_INSTANCES | ||||
60 | 1967 | 1.27ms | my $instance = $_INSTANCES{$class}; | ||
61 | 1967 | 390µs | 2 | 34µs | unless(defined $instance) { # spent 21µs making 1 call to Sympa::Spool::Listmaster::_new_instance
# spent 13µs making 1 call to Sympa::Mailer::_new_instance |
62 | $_INSTANCES{$class} = $instance = $class->_new_instance(@_); | ||||
63 | } | ||||
64 | 1967 | 8.12ms | return $instance; | ||
65 | } | ||||
66 | |||||
67 | |||||
68 | #======================================================================= | ||||
69 | # has_instance() | ||||
70 | # | ||||
71 | # Public method to return the current instance if it exists. | ||||
72 | #======================================================================= | ||||
73 | |||||
74 | sub has_instance { | ||||
75 | my $class = shift; | ||||
76 | $class = ref $class || $class; | ||||
77 | return $_INSTANCES{$class}; | ||||
78 | } | ||||
79 | |||||
80 | |||||
81 | #======================================================================== | ||||
82 | # _new_instance(...) | ||||
83 | # | ||||
84 | # Simple constructor which returns a hash reference blessed into the | ||||
85 | # current class. May be overloaded to create non-hash objects or | ||||
86 | # handle any specific initialisation required. | ||||
87 | #======================================================================== | ||||
88 | |||||
89 | sub _new_instance { | ||||
90 | my $class = shift; | ||||
91 | my %args = @_ && ref $_[0] eq 'HASH' ? %{ $_[0] } : @_; | ||||
92 | bless { %args }, $class; | ||||
93 | } | ||||
94 | |||||
95 | |||||
96 | #======================================================================== | ||||
97 | # END() | ||||
98 | # | ||||
99 | # END block to explicitly destroy all Class::Singleton objects since | ||||
100 | # destruction order at program exit is not predictable. See CPAN RT | ||||
101 | # bugs #23568 and #68526 for examples of what can go wrong without this. | ||||
102 | #======================================================================== | ||||
103 | |||||
104 | # spent 19µs within Class::Singleton::END which was called:
# once (19µs+0s) by main::RUNTIME at line 0 of /usr/local/libexec/sympa/task_manager-debug.pl | ||||
105 | # dereferences and causes orderly destruction of all instances | ||||
106 | 1 | 18µs | undef(%_INSTANCES); | ||
107 | } | ||||
108 | |||||
109 | |||||
110 | 1; | ||||
111 | |||||
112 | __END__ |