File | /usr/local/lib/perl5/site_perl/5.10.1/DateTime/TimeZone/Local.pm |
Statements Executed | 19 |
Statement Execution Time | 361µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 14µs | 17µs | BEGIN@3 | DateTime::TimeZone::Local::
1 | 1 | 1 | 7µs | 16µs | BEGIN@4 | DateTime::TimeZone::Local::
1 | 1 | 1 | 6µs | 24µs | BEGIN@6 | DateTime::TimeZone::Local::
1 | 1 | 1 | 6µs | 6µs | BEGIN@10 | DateTime::TimeZone::Local::
1 | 1 | 1 | 4µs | 4µs | BEGIN@9 | DateTime::TimeZone::Local::
0 | 0 | 0 | 0s | 0s | FromEnv | DateTime::TimeZone::Local::
0 | 0 | 0 | 0s | 0s | TimeZone | DateTime::TimeZone::Local::
0 | 0 | 0 | 0s | 0s | _IsValidName | DateTime::TimeZone::Local::
0 | 0 | 0 | 0s | 0s | _load_subclass | DateTime::TimeZone::Local::
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 # 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 # 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 # 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 # 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 # 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 |