Filename | /usr/local/share/perl/5.14.2/Class/Singleton.pm |
Statements | Executed 31 statements in 677µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
4 | 3 | 1 | 72µs | 284µs | instance | Class::Singleton::
1 | 1 | 1 | 30µs | 42µs | BEGIN@20 | Class::Singleton::
1 | 1 | 1 | 26µs | 33µs | BEGIN@19 | Class::Singleton::
1 | 1 | 1 | 14µs | 35µs | BEGIN@73 | Class::Singleton::
1 | 1 | 1 | 14µs | 39µs | BEGIN@56 | 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 | 26µs | require 5.004; | ||
19 | 2 | 64µs | 2 | 40µs | # spent 33µs (26+7) within Class::Singleton::BEGIN@19 which was called:
# once (26µs+7µs) by parent::import at line 19 # spent 33µs making 1 call to Class::Singleton::BEGIN@19
# spent 7µs making 1 call to strict::import |
20 | 2 | 142µs | 2 | 55µs | # spent 42µs (30+12) within Class::Singleton::BEGIN@20 which was called:
# once (30µs+12µs) by parent::import at line 20 # spent 42µs making 1 call to Class::Singleton::BEGIN@20
# spent 12µs making 1 call to warnings::import |
21 | |||||
22 | 1 | 700ns | our $VERSION = 1.4; | ||
23 | |||||
24 | |||||
25 | #======================================================================== | ||||
26 | # | ||||
27 | # instance() | ||||
28 | # | ||||
29 | # Module constructor. Creates an Class::Singleton (or derived) instance | ||||
30 | # if one doesn't already exist. The instance reference is stored in the | ||||
31 | # _instance variable of the $class package. This means that classes | ||||
32 | # derived from Class::Singleton will have the variables defined in *THEIR* | ||||
33 | # package, rather than the Class::Singleton package. The impact of this is | ||||
34 | # that you can create any number of classes derived from Class::Singleton | ||||
35 | # and create a single instance of each one. If the _instance variable | ||||
36 | # was stored in the Class::Singleton package, you could only instantiate | ||||
37 | # *ONE* object of *ANY* class derived from Class::Singleton. The first | ||||
38 | # time the instance is created, the _new_instance() constructor is called | ||||
39 | # which simply returns a reference to a blessed hash. This can be | ||||
40 | # overloaded for custom constructors. Any addtional parameters passed to | ||||
41 | # instance() are forwarded to _new_instance(). | ||||
42 | # | ||||
43 | # Returns a reference to the existing, or a newly created Class::Singleton | ||||
44 | # object. If the _new_instance() method returns an undefined value | ||||
45 | # then the constructer is deemed to have failed. | ||||
46 | # | ||||
47 | #======================================================================== | ||||
48 | |||||
49 | # spent 284µs (72+212) within Class::Singleton::instance which was called 4 times, avg 71µs/call:
# 2 times (32µs+22µs) by DateTime::TimeZone::new at line 53 of DateTime/TimeZone.pm, avg 27µs/call
# once (21µs+172µs) by DateTime::TimeZone::new at line 97 of DateTime/TimeZone.pm
# once (19µs+18µs) by DateTime::TimeZone::new at line 61 of DateTime/TimeZone.pm | ||||
50 | 4 | 4µs | my $class = shift; | ||
51 | |||||
52 | # already got an object | ||||
53 | 4 | 2µs | return $class if ref $class; | ||
54 | |||||
55 | # we store the instance in the _instance variable in the $class package. | ||||
56 | 2 | 184µs | 2 | 65µs | # spent 39µs (14+26) within Class::Singleton::BEGIN@56 which was called:
# once (14µs+26µs) by parent::import at line 56 # spent 39µs making 1 call to Class::Singleton::BEGIN@56
# spent 26µs making 1 call to strict::unimport |
57 | 8 | 24µs | my $instance = \${ "$class\::_instance" }; | ||
58 | 4 | 36µs | 3 | 212µs | defined $$instance # spent 172µs making 1 call to DateTime::TimeZone::Europe::Prague::_new_instance
# spent 22µs making 1 call to DateTime::TimeZone::Floating::_new_instance
# spent 18µs making 1 call to DateTime::TimeZone::UTC::_new_instance |
59 | ? $$instance | ||||
60 | : ($$instance = $class->_new_instance(@_)); | ||||
61 | } | ||||
62 | |||||
63 | |||||
64 | #======================================================================= | ||||
65 | # has_instance() | ||||
66 | # | ||||
67 | # Public method to return the current instance if it exists. | ||||
68 | #======================================================================= | ||||
69 | |||||
70 | sub has_instance { | ||||
71 | my $class = shift; | ||||
72 | $class = ref $class || $class; | ||||
73 | 2 | 188µs | 2 | 55µs | # spent 35µs (14+21) within Class::Singleton::BEGIN@73 which was called:
# once (14µs+21µs) by parent::import at line 73 # spent 35µs making 1 call to Class::Singleton::BEGIN@73
# spent 21µs making 1 call to strict::unimport |
74 | return ${"$class\::_instance"}; | ||||
75 | } | ||||
76 | |||||
77 | |||||
78 | #======================================================================== | ||||
79 | # _new_instance(...) | ||||
80 | # | ||||
81 | # Simple constructor which returns a hash reference blessed into the | ||||
82 | # current class. May be overloaded to create non-hash objects or | ||||
83 | # handle any specific initialisation required. | ||||
84 | #======================================================================== | ||||
85 | |||||
86 | sub _new_instance { | ||||
87 | my $class = shift; | ||||
88 | my %args = @_ && ref $_[0] eq 'HASH' ? %{ $_[0] } : @_; | ||||
89 | bless { %args }, $class; | ||||
90 | } | ||||
91 | |||||
- - | |||||
94 | 1 | 6µs | 1; | ||
95 | |||||
96 | __END__ |