Profile of /usr/local/lib/perl5/site_perl/5.10.1/DateTime/TimeZone/Local.pm

← Index
NYTProf Performance Profile «block view•line view•sub view»
For 05.Domain_and_Item.t
Run on Tue May 4 17:21:41 2010
Reported on Tue May 4 17:22:51 2010

File | /usr/local/lib/perl5/site_perl/5.10.1/DateTime/TimeZone/Local.pm
Statements Executed | 19
Statement Execution Time | 361µs

Subroutines — ordered by exclusive time
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 14µs | 17µs | DateTime::TimeZone::Local::::BEGIN@3DateTime::TimeZone::Local::BEGIN@3
1 | 1 | 1 | 7µs | 16µs | DateTime::TimeZone::Local::::BEGIN@4DateTime::TimeZone::Local::BEGIN@4
1 | 1 | 1 | 6µs | 24µs | DateTime::TimeZone::Local::::BEGIN@6DateTime::TimeZone::Local::BEGIN@6
1 | 1 | 1 | 6µs | 6µs | DateTime::TimeZone::Local::::BEGIN@10DateTime::TimeZone::Local::BEGIN@10
1 | 1 | 1 | 4µs | 4µs | DateTime::TimeZone::Local::::BEGIN@9DateTime::TimeZone::Local::BEGIN@9
0 | 0 | 0 | 0s | 0s | DateTime::TimeZone::Local::::FromEnvDateTime::TimeZone::Local::FromEnv
0 | 0 | 0 | 0s | 0s | DateTime::TimeZone::Local::::TimeZoneDateTime::TimeZone::Local::TimeZone
0 | 0 | 0 | 0s | 0s | DateTime::TimeZone::Local::::_IsValidNameDateTime::TimeZone::Local::_IsValidName
0 | 0 | 0 | 0s | 0s | DateTime::TimeZone::Local::::_load_subclassDateTime::TimeZone::Local::_load_subclass

Call graph for these subroutines as a Graphviz dot language file.

Line | State ments | Time on line | Calls | Time in subs | Code
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package DateTime::TimeZone::Local;
2 |  |  |  |  |
3 | 3 | 21µs | 2 | 20µs | # spent 17µs (14+3) within DateTime::TimeZone::Local::BEGIN@3 which was called # once (14µs+3µs) by DateTime::TimeZone::BEGIN@12 at line 3 use strict; # spent 17µs making 1 call to DateTime::TimeZone::Local::BEGIN@3 # spent 3µs making 1 call to strict::import
4 | 3 | 21µs | 2 | 25µs | # spent 16µs (7+9) within DateTime::TimeZone::Local::BEGIN@4 which was called # once (7µs+9µs) by DateTime::TimeZone::BEGIN@12 at line 4 use warnings; # spent 16µs making 1 call to DateTime::TimeZone::Local::BEGIN@4 # spent 9µs making 1 call to warnings::import
5 |  |  |  |  |
6 | 3 | 25µs | 2 | 41µs | # spent 24µs (6+18) within DateTime::TimeZone::Local::BEGIN@6 which was called # once (6µs+18µs) by DateTime::TimeZone::BEGIN@12 at line 6 use vars qw( $VERSION ); # spent 24µs making 1 call to DateTime::TimeZone::Local::BEGIN@6 # spent 18µs making 1 call to vars::import
7 | 1 | 600ns |  |  | $VERSION = '0.01';
8 |  |  |  |  |
9 | 3 | 19µs | 1 | 4µs | # spent 4µs within DateTime::TimeZone::Local::BEGIN@9 which was called # once (4µs+0s) by DateTime::TimeZone::BEGIN@12 at line 9 use DateTime::TimeZone; # spent 4µs making 1 call to DateTime::TimeZone::Local::BEGIN@9
10 | 3 | 259µs | 1 | 6µs | # spent 6µs within DateTime::TimeZone::Local::BEGIN@10 which was called # once (6µs+0s) by DateTime::TimeZone::BEGIN@12 at line 10 use File::Spec; # spent 6µs making 1 call to DateTime::TimeZone::Local::BEGIN@10
11 |  |  |  |  |
12 |  |  |  |  | sub TimeZone {
13 |  |  |  |  | my $class = shift;
14 |  |  |  |  |
15 |  |  |  |  | my $subclass = $class->_load_subclass();
16 |  |  |  |  |
17 |  |  |  |  | for my $meth ( $subclass->Methods() ) {
18 |  |  |  |  | my $tz = $subclass->$meth();
19 |  |  |  |  |
20 |  |  |  |  | return $tz if $tz;
21 |  |  |  |  | }
22 |  |  |  |  |
23 |  |  |  |  | die "Cannot determine local time zone\n";
24 |  |  |  |  | }
25 |  |  |  |  |
26 |  |  |  |  | {
27 |  |  |  |  | # Stolen from File::Spec. My theory is that other folks can write
28 |  |  |  |  | # the non-existent modules if they feel a need, and release them
29 |  |  |  |  | # to CPAN separately.
30 | 2 | 6µs |  |  | my %subclass = (
31 |  |  |  |  | MSWin32 => 'Win32',
32 |  |  |  |  | VMS => 'VMS',
33 |  |  |  |  | MacOS => 'Mac',
34 |  |  |  |  | os2 => 'OS2',
35 |  |  |  |  | epoc => 'Epoc',
36 |  |  |  |  | NetWare => 'Win32',
37 |  |  |  |  | symbian => 'Win32',
38 |  |  |  |  | dos => 'OS2',
39 |  |  |  |  | cygwin => 'Unix',
40 |  |  |  |  | );
41 |  |  |  |  |
42 |  |  |  |  | sub _load_subclass {
43 |  |  |  |  | my $class = shift;
44 |  |  |  |  |
45 |  |  |  |  | my $os_name = $subclass{$^O} || $^O;
46 |  |  |  |  | my $subclass = $class . '::' . $os_name;
47 |  |  |  |  |
48 |  |  |  |  | return $subclass if $subclass->can('Methods');
49 |  |  |  |  |
50 |  |  |  |  | local $@;
51 |  |  |  |  | local $SIG{__DIE__};
52 |  |  |  |  | eval "use $subclass";
53 |  |  |  |  | if ( my $e = $@ ) {
54 |  |  |  |  | if ( $e =~ /locate.+$os_name/ ) {
55 |  |  |  |  | $subclass = $class . '::' . 'Unix';
56 |  |  |  |  |
57 |  |  |  |  | eval "use $subclass";
58 |  |  |  |  | my $e2 = $@;
59 |  |  |  |  | die $e2 if $e2;
60 |  |  |  |  | }
61 |  |  |  |  | else {
62 |  |  |  |  | die $e;
63 |  |  |  |  | }
64 |  |  |  |  | }
65 |  |  |  |  |
66 |  |  |  |  | return $subclass;
67 |  |  |  |  | }
68 |  |  |  |  | }
69 |  |  |  |  |
70 |  |  |  |  | sub FromEnv {
71 |  |  |  |  | my $class = shift;
72 |  |  |  |  |
73 |  |  |  |  | foreach my $var ( $class->EnvVars() ) {
74 |  |  |  |  | if ( $class->_IsValidName( $ENV{$var} ) ) {
75 |  |  |  |  | my $tz;
76 |  |  |  |  | {
77 |  |  |  |  | local $@;
78 |  |  |  |  | local $SIG{__DIE__};
79 |  |  |  |  | $tz = eval { DateTime::TimeZone->new( name => $ENV{$var} ) };
80 |  |  |  |  | }
81 |  |  |  |  | return $tz if $tz;
82 |  |  |  |  | }
83 |  |  |  |  | }
84 |  |  |  |  |
85 |  |  |  |  | return;
86 |  |  |  |  | }
87 |  |  |  |  |
88 |  |  |  |  | sub _IsValidName {
89 |  |  |  |  | shift;
90 |  |  |  |  |
91 |  |  |  |  | return 0 unless defined $_[0];
92 |  |  |  |  | return 0 if $_[0] eq 'local';
93 |  |  |  |  |
94 |  |  |  |  | return $_[0] =~ m{^[\w/\-\+]+$};
95 |  |  |  |  | }
96 |  |  |  |  |
97 | 1 | 8µs |  |  | 1;
98 |  |  |  |  |
99 |  |  |  |  | __END__
100 |  |  |  |  |
101 |  |  |  |  | =head1 NAME
102 |  |  |  |  |
103 |  |  |  |  | DateTime::TimeZone::Local - Determine the local system's time zone
104 |  |  |  |  |
105 |  |  |  |  | =head1 SYNOPSIS
106 |  |  |  |  |
107 |  |  |  |  | my $tz = DateTime::TimeZone->new( name => 'local' );
108 |  |  |  |  |
109 |  |  |  |  | my $tz = DateTime::TimeZone::Local->TimeZone();
110 |  |  |  |  |
111 |  |  |  |  | =head1 DESCRIPTION
112 |  |  |  |  |
113 |  |  |  |  | This module provides an interface for determining the local system's
114 |  |  |  |  | time zone. Most of the functionality for doing this is in OS-specific
115 |  |  |  |  | subclasses.
116 |  |  |  |  |
117 |  |  |  |  | =head1 USAGE
118 |  |  |  |  |
119 |  |  |  |  | This class provides the following methods:
120 |  |  |  |  |
121 |  |  |  |  | =head2 DateTime::TimeZone::Local->TimeZone()
122 |  |  |  |  |
123 |  |  |  |  | This attempts to load an appropriate subclass and asks it to find the
124 |  |  |  |  | local time zone. This method is called by when you pass "local" as the
125 |  |  |  |  | time zone name to C<< DateTime:TimeZone->new() >>.
126 |  |  |  |  |
127 |  |  |  |  | If your OS is not explicitly handled, you can create a module with a
128 |  |  |  |  | name of the form C<DateTime::TimeZone::Local::$^O>. If it exists, it
129 |  |  |  |  | will be used instead of falling back to the Unix subclass.
130 |  |  |  |  |
131 |  |  |  |  | If no OS-specific module exists, we fall back to using the Unix
132 |  |  |  |  | subclass.
133 |  |  |  |  |
134 |  |  |  |  | See L<DateTime::TimeZone::Local::Unix>,
135 |  |  |  |  | L<DateTime::TimeZone::Local::Win32>, and
136 |  |  |  |  | L<DateTime::TimeZone::Local::VMS> for OS-specific details.
137 |  |  |  |  |
138 |  |  |  |  | =head1 SUBCLASSING
139 |  |  |  |  |
140 |  |  |  |  | If you want to make a new OS-specific subclass, there are several
141 |  |  |  |  | methods provided by this module you should know about.
142 |  |  |  |  |
143 |  |  |  |  | =head2 $class->Methods()
144 |  |  |  |  |
145 |  |  |  |  | This method should be provided by your class. It should provide a list
146 |  |  |  |  | of methods that will be called to try to determine the local time
147 |  |  |  |  | zone.
148 |  |  |  |  |
149 |  |  |  |  | Each of these methods is expected to return a new
150 |  |  |  |  | C<DateTime::TimeZone> object if it determines the time zone.
151 |  |  |  |  |
152 |  |  |  |  | =head2 $class->FromEnv()
153 |  |  |  |  |
154 |  |  |  |  | This method tries to find a valid time zone in an C<%ENV> value. It
155 |  |  |  |  | calls C<< $class->EnvVars() >> to determine which keys to look at.
156 |  |  |  |  |
157 |  |  |  |  | To use this from a subclass, simply return "FromEnv" as one of the
158 |  |  |  |  | items from C<< $class->Methods() >>.
159 |  |  |  |  |
160 |  |  |  |  | =head2 $class->EnvVars()
161 |  |  |  |  |
162 |  |  |  |  | This method should be provided by your subclass. It should return a
163 |  |  |  |  | list of env vars to be checked by C<< $class->FromEnv() >>.
164 |  |  |  |  |
165 |  |  |  |  | =head2 $class->_IsValidName($name)
166 |  |  |  |  |
167 |  |  |  |  | Given a possible time zone name, this returns a boolean indicating
168 |  |  |  |  | whether or not the the name looks valid. It always return false for
169 |  |  |  |  | "local" in order to avoid infinite loops.
170 |  |  |  |  |
171 |  |  |  |  | =head1 EXAMPLE SUBCLASS
172 |  |  |  |  |
173 |  |  |  |  | Here is a simple example subclass:
174 |  |  |  |  |
175 |  |  |  |  | package DateTime::TimeZone::SomeOS;
176 |  |  |  |  |
177 |  |  |  |  | use strict;
178 |  |  |  |  | use warnings;
179 |  |  |  |  |
180 |  |  |  |  | use base 'DateTime::TimeZone::Local';
181 |  |  |  |  |
182 |  |  |  |  |
183 |  |  |  |  | sub Methods { qw( FromEnv FromEther ) }
184 |  |  |  |  |
185 |  |  |  |  | sub EnvVars { qw( TZ ZONE ) }
186 |  |  |  |  |
187 |  |  |  |  | sub FromEther
188 |  |  |  |  | {
189 |  |  |  |  | my $class = shift;
190 |  |  |  |  |
191 |  |  |  |  | ...
192 |  |  |  |  | }
193 |  |  |  |  |
194 |  |  |  |  | =head1 AUTHOR
195 |  |  |  |  |
196 |  |  |  |  | Dave Rolsky, <autarch@urth.org>
197 |  |  |  |  |
198 |  |  |  |  | =head1 COPYRIGHT & LICENSE
199 |  |  |  |  |
200 |  |  |  |  | Copyright (c) 2003-2008 David Rolsky. All rights reserved. This
201 |  |  |  |  | program is free software; you can redistribute it and/or modify it
202 |  |  |  |  | under the same terms as Perl itself.
203 |  |  |  |  |
204 |  |  |  |  | The full text of the license can be found in the LICENSE file included
205 |  |  |  |  | with this module.
206 |  |  |  |  |
207 |  |  |  |  | =cut