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