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