Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/Class/Singleton.pm |
Statements | Executed 2375 statements in 7.46ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
590 | 2 | 1 | 6.68ms | 6.72ms | instance | Class::Singleton::
1 | 1 | 1 | 12µs | 14µs | BEGIN@19 | Class::Singleton::
1 | 1 | 1 | 7µs | 14µs | BEGIN@20 | Class::Singleton::
1 | 1 | 1 | 6µs | 21µs | BEGIN@56 | Class::Singleton::
1 | 1 | 1 | 6µs | 13µs | BEGIN@73 | 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 | 24µs | require 5.004; | ||
19 | 3 | 17µs | 2 | 16µs | # spent 14µs (12+2) within Class::Singleton::BEGIN@19 which was called:
# once (12µs+2µs) by parent::import at line 19 # spent 14µs making 1 call to Class::Singleton::BEGIN@19
# spent 2µs making 1 call to strict::import |
20 | 3 | 54µs | 2 | 22µs | # spent 14µs (7+8) within Class::Singleton::BEGIN@20 which was called:
# once (7µs+8µs) by parent::import at line 20 # spent 14µs making 1 call to Class::Singleton::BEGIN@20
# spent 8µs making 1 call to warnings::import |
21 | |||||
22 | 1 | 500ns | 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 6.72ms (6.68+31µs) within Class::Singleton::instance which was called 590 times, avg 11µs/call:
# 588 times (6.67ms+13µs) by DateTime::TimeZone::new at line 57 of DateTime/TimeZone.pm, avg 11µs/call
# 2 times (19µs+17µs) by DateTime::TimeZone::new at line 49 of DateTime/TimeZone.pm, avg 18µs/call | ||||
50 | 590 | 747µs | my $class = shift; | ||
51 | |||||
52 | # already got an object | ||||
53 | 590 | 376µs | return $class if ref $class; | ||
54 | |||||
55 | # we store the instance in the _instance variable in the $class package. | ||||
56 | 3 | 67µs | 2 | 36µs | # spent 21µs (6+15) within Class::Singleton::BEGIN@56 which was called:
# once (6µs+15µs) by parent::import at line 56 # spent 21µs making 1 call to Class::Singleton::BEGIN@56
# spent 15µs making 1 call to strict::unimport |
57 | 590 | 3.13ms | my $instance = \${ "$class\::_instance" }; | ||
58 | 590 | 2.97ms | 2 | 30µs | defined $$instance # spent 17µs making 1 call to DateTime::TimeZone::Floating::_new_instance
# spent 13µ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 | 3 | 69µs | 2 | 21µs | # spent 13µs (6+8) within Class::Singleton::BEGIN@73 which was called:
# once (6µs+8µs) by parent::import at line 73 # spent 13µs making 1 call to Class::Singleton::BEGIN@73
# spent 8µ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 | 2µs | 1; | ||
95 | |||||
96 | __END__ |