local-lib5/lib/perl5/DateTime/TimeZone/Local.pm

   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