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