| 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 | Class::Singleton::instance |
| 1 | 1 | 1 | 12µs | 14µs | Class::Singleton::BEGIN@19 |
| 1 | 1 | 1 | 7µs | 14µs | Class::Singleton::BEGIN@20 |
| 1 | 1 | 1 | 6µs | 21µs | Class::Singleton::BEGIN@56 |
| 1 | 1 | 1 | 6µs | 13µs | Class::Singleton::BEGIN@73 |
| 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 | 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 | 2360 | 7.23ms | my $class = shift; | ||
| 51 | |||||
| 52 | # already got an object | ||||
| 53 | 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 | my $instance = \${ "$class\::_instance" }; | ||||
| 58 | 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__ |