← Index
NYTProf Performance Profile   « block view • line view • sub view »
For xt/tapper-mcp-scheduler-with-db-longrun.t
  Run on Tue May 22 17:18:39 2012
Reported on Tue May 22 17:23:58 2012

Filename/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/Class/Singleton.pm
StatementsExecuted 2375 statements in 7.46ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
590216.68ms6.72msClass::Singleton::::instanceClass::Singleton::instance
11112µs14µsClass::Singleton::::BEGIN@19Class::Singleton::BEGIN@19
1117µs14µsClass::Singleton::::BEGIN@20Class::Singleton::BEGIN@20
1116µs21µsClass::Singleton::::BEGIN@56Class::Singleton::BEGIN@56
1116µs13µsClass::Singleton::::BEGIN@73Class::Singleton::BEGIN@73
0000s0sClass::Singleton::::_new_instanceClass::Singleton::_new_instance
0000s0sClass::Singleton::::has_instanceClass::Singleton::has_instance
Call graph for these subroutines as a Graphviz dot language file.
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
17package Class::Singleton;
18124µsrequire 5.004;
19317µs216µ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
use strict;
# spent 14µs making 1 call to Class::Singleton::BEGIN@19 # spent 2µs making 1 call to strict::import
20354µs222µ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
use warnings;
# spent 14µs making 1 call to Class::Singleton::BEGIN@20 # spent 8µs making 1 call to warnings::import
21
221500nsour $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
sub instance {
50590747µs my $class = shift;
51
52 # already got an object
53590376µs return $class if ref $class;
54
55 # we store the instance in the _instance variable in the $class package.
56367µs236µ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
no strict 'refs';
# spent 21µs making 1 call to Class::Singleton::BEGIN@56 # spent 15µs making 1 call to strict::unimport
575903.13ms my $instance = \${ "$class\::_instance" };
585902.97ms230µ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
70sub has_instance {
71 my $class = shift;
72 $class = ref $class || $class;
73369µs221µ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
no strict 'refs';
# 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
86sub _new_instance {
87 my $class = shift;
88 my %args = @_ && ref $_[0] eq 'HASH' ? %{ $_[0] } : @_;
89 bless { %args }, $class;
90}
91
- -
9412µs1;
95
96__END__