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

   1 package DateTime::TimeZone::Local::Unix;
   2
   3 use strict;
   4 use warnings;
   5
   6 use base 'DateTime::TimeZone::Local';
   7
   8
   9 sub Methods
  10 {
  11     return qw( FromEnv
  12                FromEtcLocaltime
  13                FromEtcTimezone
  14                FromEtcTIMEZONE
  15                FromEtcSysconfigClock
  16                FromEtcDefaultInit
  17              );
  18 }
  19
  20 sub EnvVars { return 'TZ' }
  21
  22 sub FromEtcLocaltime
  23 {
  24     my $class = shift;
  25
  26     my $lt_file = '/etc/localtime';
  27
  28     return unless -r $lt_file && -s _;
  29
  30     my $real_name;
  31     if ( -l $lt_file )
  32     {
  33         # The _Readlink sub exists so the test suite can mock it.
  34         $real_name = $class->_Readlink( $lt_file );
  35     }
  36
  37     $real_name ||= $class->_FindMatchingZoneinfoFile( $lt_file );
  38
  39     if ( defined $real_name )
  40     {
  41         my ( $vol, $dirs, $file ) = File::Spec->splitpath( $real_name );
  42
  43         my @parts =
  44             grep { defined && length } File::Spec->splitdir( $dirs ), $file;
  45
  46         foreach my $x ( reverse 0..$#parts )
  47         {
  48             my $name =
  49                 ( $x < $#parts ?
  50                   join '/', @parts[$x..$#parts] :
  51                   $parts[$x]
  52                 );
  53
  54             my $tz;
  55             {
  56                 local $@;
  57                 local $SIG{__DIE__};
  58                 $tz = eval { DateTime::TimeZone->new( name => $name ) };
  59             }
  60
  61             return $tz if $tz;
  62         }
  63     }
  64 }
  65
  66 sub _Readlink
  67 {
  68     my $link = $_[1];
  69
  70     require Cwd;
  71     # Using abs_path will resolve multiple levels of link indirection,
  72     # whereas readlink just follows the link to the next target.
  73     return Cwd::abs_path($link);
  74 }
  75
  76 # for systems where /etc/localtime is a copy of a zoneinfo file
  77 sub _FindMatchingZoneinfoFile
  78 {
  79     my $class         = shift;
  80     my $file_to_match = shift;
  81
  82     return unless -d '/usr/share/zoneinfo';
  83
  84     require File::Basename;
  85     require File::Compare;
  86     require File::Find;
  87
  88     my $size = -s $file_to_match;
  89
  90     my $real_name;
  91     local $@;
  92     local $SIG{__DIE__};
  93     local $_;
  94     eval
  95     {
  96         File::Find::find
  97             ( { wanted =>
  98                 sub
  99                 {
 100                     if ( ! defined $real_name
 101                          && -f $_
 102                          && ! -l $_
 103                          && $size == -s _
 104                          # This fixes RT 24026 - apparently such a
 105                          # file exists on FreeBSD and it can cause a
 106                          # false positive
 107                          && File::Basename::basename($_) ne 'posixrules'
 108                          && File::Compare::compare( $_, $file_to_match ) == 0
 109                        )
 110                     {
 111                         $real_name = $_;
 112
 113                         # File::Find has no mechanism for bailing in the
 114                         # middle of a find.
 115                         die { found => 1 };
 116                     }
 117                 },
 118                 no_chdir => 1,
 119               },
 120               '/usr/share/zoneinfo',
 121             );
 122     };
 123
 124     if ($@)
 125     {
 126         return $real_name if ref $@ && $@->{found};
 127         die $@;
 128     }
 129 }
 130
 131 sub FromEtcTimezone
 132 {
 133     my $class = shift;
 134
 135     my $tz_file = '/etc/timezone';
 136
 137     return unless -f $tz_file && -r _;
 138
 139     local *TZ;
 140     open TZ, "<$tz_file"
 141         or die "Cannot read $tz_file: $!";
 142     my $name = join '', <TZ>;
 143     close TZ;
 144
 145     $name =~ s/^\s+|\s+$//g;
 146
 147     return unless $class->_IsValidName($name);
 148
 149     local $@;
 150     local $SIG{__DIE__};
 151     return eval { DateTime::TimeZone->new( name => $name ) };
 152 }
 153
 154 sub FromEtcTIMEZONE
 155 {
 156     my $class = shift;
 157
 158     my $tz_file = '/etc/TIMEZONE';
 159
 160     return unless -f $tz_file && -r _;
 161
 162     local *TZ;
 163     open TZ, "<$tz_file"
 164         or die "Cannot read $tz_file: $!";
 165
 166     my $name;
 167     while ( defined( $name = <TZ> ) )
 168     {
 169         if ( $name =~ /\A\s*TZ\s*=\s*(\S+)/ )
 170         {
 171             $name = $1;
 172             last;
 173         }
 174     }
 175
 176     close TZ;
 177
 178     return unless $class->_IsValidName($name);
 179
 180     local $@;
 181     local $SIG{__DIE__};
 182     return eval { DateTime::TimeZone->new( name => $name ) };
 183 }
 184
 185 # RedHat uses this
 186 sub FromEtcSysconfigClock
 187 {
 188     my $class = shift;
 189
 190     return unless -r "/etc/sysconfig/clock" && -f _;
 191
 192     my $name = $class->_ReadEtcSysconfigClock();
 193
 194     return unless $class->_IsValidName($name);
 195
 196     local $@;
 197     local $SIG{__DIE__};
 198     return eval { DateTime::TimeZone->new( name => $name ) };
 199 }
 200
 201 # this is a sparate function so that it can be overridden in the test
 202 # suite
 203 sub _ReadEtcSysconfigClock
 204 {
 205     my $class = shift;
 206
 207     local *CLOCK;
 208     open CLOCK, '</etc/sysconfig/clock'
 209         or die "Cannot read /etc/sysconfig/clock: $!";
 210
 211     local $_;
 212     while (<CLOCK>)
 213     {
 214         return $1 if /^(?:TIME)?ZONE="([^"]+)"/;
 215     }
 216 }
 217
 218 sub FromEtcDefaultInit
 219 {
 220     my $class = shift;
 221
 222     return unless -r "/etc/default/init" && -f _;
 223
 224     my $name = $class->_ReadEtcDefaultInit();
 225
 226     return unless $class->_IsValidName($name);
 227
 228     local $@;
 229     local $SIG{__DIE__};
 230     return eval { DateTime::TimeZone->new( name => $name ) };
 231 }
 232
 233 # this is a separate function so that it can be overridden in the test
 234 # suite
 235 sub _ReadEtcDefaultInit
 236 {
 237     my $class = shift;
 238
 239     local *INIT;
 240     open INIT, '</etc/default/init'
 241         or die "Cannot read /etc/default/init: $!";
 242
 243     local $_;
 244     while (<INIT>)
 245     {
 246         return $1 if /^TZ=(.+)/;
 247     }
 248 }
 249
 250
 251 1;
 252
 253 __END__
 254
 255 =head1 NAME
 256
 257 DateTime::TimeZone::Local::Unix - Determine the local system's time zone on Unix
 258
 259 =head1 SYNOPSIS
 260
 261   my $tz = DateTime::TimeZone->new( name => 'local' );
 262
 263   my $tz = DateTime::TimeZone::Local->TimeZone();
 264
 265 =head1 DESCRIPTION
 266
 267 This module provides methods for determining the local time zone on a
 268 Unix platform.
 269
 270 =head1 HOW THE TIME ZONE IS DETERMINED
 271
 272 This class tries the following methods of determining the local time
 273 zone:
 274
 275 =over 4
 276
 277 =item * $ENV{TZ}
 278
 279 It checks C<< $ENV{TZ} >> for a valid time zone name.
 280
 281 =item * F</etc/localtime>
 282
 283 If this file is a symlink to an Olson database time zone file (usually
 284 in F</usr/share/zoneinfo>) then it uses the target file's path name to
 285 determine the time zone name. For example, if the path is
 286 F</usr/share/zoneinfo/America/Chicago>, the time zone is
 287 "America/Chicago".
 288
 289 Some systems just copy the relevant file to F</etc/localtime> instead
 290 of making a symlink.  In this case, we look in F</usr/share/zoneinfo>
 291 for a file that has the same size and content as F</etc/localtime> to
 292 determine the local time zone.
 293
 294 =item * F</etc/timezone>
 295
 296 If this file exists, it is read and its contents are used as a time
 297 zone name.
 298
 299 =item * F</etc/TIMEZONE>
 300
 301 If this file exists, it is opened and we look for a line starting like
 302 "TZ = ...". If this is found, it should indicate a time zone name.
 303
 304 =item * F</etc/sysconfig/clock>
 305
 306 If this file exists, it is opened and we look for a line starting like
 307 "TIMEZONE = ..." or "ZONE = ...". If this is found, it should indicate
 308 a time zone name.
 309
 310 =item * F</etc/default/init>
 311
 312 If this file exists, it is opened and we look for a line starting like
 313 "TZ=...". If this is found, it should indicate a time zone name.
 314
 315 =back
 316
 317 =head1 AUTHOR
 318
 319 Dave Rolsky, <autarch@urth.org>
 320
 321 =head1 COPYRIGHT & LICENSE
 322
 323 Copyright (c) 2003-2008 David Rolsky.  All rights reserved.  This
 324 program is free software; you can redistribute it and/or modify it
 325 under the same terms as Perl itself.
 326
 327 The full text of the license can be found in the LICENSE file included
 328 with this module.
 329
 330 =cut