1 | | | | | package DateTime::TimeZone::Local; |
2 | | | | | $DateTime::TimeZone::Local::VERSION = '1.75'; |
3 | | | | | use strict; |
4 | | | | | use warnings; |
5 | | | | | |
6 | | | | | use Class::Load qw( is_class_loaded load_class try_load_class ); |
7 | | | | | use DateTime::TimeZone; |
8 | | | | | use File::Spec; |
9 | | | | | |
10 | | | | | sub TimeZone { |
11 | | | | | my $class = shift; |
12 | | | | | |
13 | | | | | my $subclass = $class->_load_subclass(); |
14 | | | | | |
15 | 1 | 14µs | | | for my $meth ( $subclass->Methods() ) { |
16 | 1 | 32µs | | | my $tz = $subclass->$meth(); |
17 | | | | | |
18 | | | | | return $tz if $tz; |
19 | | | | | } |
20 | | | | | |
21 | | | | | die "Cannot determine local time zone\n"; |
22 | | | | | } |
23 | | | | | |
24 | | | | | { |
25 | | | | | # Stolen from File::Spec. My theory is that other folks can write |
26 | | | | | # the non-existent modules if they feel a need, and release them |
27 | | | | | # to CPAN separately. |
28 | | | | | my %subclass = ( |
29 | | | | | MSWin32 => 'Win32', |
30 | | | | | VMS => 'VMS', |
31 | | | | | MacOS => 'Mac', |
32 | | | | | os2 => 'OS2', |
33 | | | | | epoc => 'Epoc', |
34 | | | | | NetWare => 'Win32', |
35 | | | | | symbian => 'Win32', |
36 | | | | | dos => 'OS2', |
37 | | | | | android => 'Android', |
38 | | | | | cygwin => 'Unix', |
39 | | | | | ); |
40 | | | | | |
41 | | | | | sub _load_subclass { |
42 | | | | | my $class = shift; |
43 | | | | | |
44 | | | | | my $os_name = $subclass{$^O} || $^O; |
45 | | | | | my $subclass = $class . '::' . $os_name; |
46 | | | | | |
47 | | | | | return $subclass if is_class_loaded($subclass); |
48 | | | | | |
49 | | | | | return $subclass if try_load_class($subclass); |
50 | | | | | |
51 | | | | | $subclass = $class . '::Unix'; |
52 | | | | | |
53 | | | | | load_class($subclass); |
54 | | | | | |
55 | | | | | return $subclass; |
56 | | | | | } |
57 | | | | | } |
58 | | | | | |
59 | | | | | sub FromEnv { |
60 | | | | | my $class = shift; |
61 | | | | | |
62 | 1 | 18µs | | | foreach my $var ( $class->EnvVars() ) { |
63 | | | | | if ( $class->_IsValidName( $ENV{$var} ) ) { |
64 | | | | | my $tz; |
65 | | | | | { |
66 | | | | | local $@; |
67 | | | | | local $SIG{__DIE__}; |
68 | | | | | $tz = eval { DateTime::TimeZone->new( name => $ENV{$var} ) }; |
69 | | | | | } |
70 | | | | | return $tz if $tz; |
71 | | | | | } |
72 | | | | | } |
73 | | | | | |
74 | | | | | return; |
75 | | | | | } |
76 | | | | | |
77 | | | | | sub _IsValidName { |
78 | | | | | shift; |
79 | | | | | |
80 | | | | | return 0 unless defined $_[0]; |
81 | | | | | return 0 if $_[0] eq 'local'; |
82 | | | | | |
83 | | | | | return $_[0] =~ m{^[\w/\-\+]+$}; |
84 | | | | | } |
85 | | | | | |
86 | | | | | 1; |
87 | | | | | |
88 | | | | | # ABSTRACT: Determine the local system's time zone |
89 | | | | | |
90 | | | | | __END__ |
91 | | | | | |
92 | | | | | =pod |
93 | | | | | |
94 | | | | | =encoding UTF-8 |
95 | | | | | |
96 | | | | | =head1 NAME |
97 | | | | | |
98 | | | | | DateTime::TimeZone::Local - Determine the local system's time zone |
99 | | | | | |
100 | | | | | =head1 VERSION |
101 | | | | | |
102 | | | | | version 1.75 |
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 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) 2014 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 |