| 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 | DateTime::TimeZone::Local::BEGIN@3 |
| 1 | 1 | 1 | 7µs | 16µs | DateTime::TimeZone::Local::BEGIN@4 |
| 1 | 1 | 1 | 6µs | 24µs | DateTime::TimeZone::Local::BEGIN@6 |
| 1 | 1 | 1 | 6µs | 6µs | DateTime::TimeZone::Local::BEGIN@10 |
| 1 | 1 | 1 | 4µs | 4µs | DateTime::TimeZone::Local::BEGIN@9 |
| 0 | 0 | 0 | 0s | 0s | DateTime::TimeZone::Local::FromEnv |
| 0 | 0 | 0 | 0s | 0s | DateTime::TimeZone::Local::TimeZone |
| 0 | 0 | 0 | 0s | 0s | DateTime::TimeZone::Local::_IsValidName |
| 0 | 0 | 0 | 0s | 0s | DateTime::TimeZone::Local::_load_subclass |
| 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 |