package DateTime::TimeZone::Local::Unix; use strict; use warnings; use base 'DateTime::TimeZone::Local'; sub Methods { return qw( FromEnv FromEtcLocaltime FromEtcTimezone FromEtcTIMEZONE FromEtcSysconfigClock FromEtcDefaultInit ); } sub EnvVars { return 'TZ' } sub FromEtcLocaltime { my $class = shift; my $lt_file = '/etc/localtime'; return unless -r $lt_file && -s _; my $real_name; if ( -l $lt_file ) { # The _Readlink sub exists so the test suite can mock it. $real_name = $class->_Readlink( $lt_file ); } $real_name ||= $class->_FindMatchingZoneinfoFile( $lt_file ); if ( defined $real_name ) { my ( $vol, $dirs, $file ) = File::Spec->splitpath( $real_name ); my @parts = grep { defined && length } File::Spec->splitdir( $dirs ), $file; foreach my $x ( reverse 0..$#parts ) { my $name = ( $x < $#parts ? join '/', @parts[$x..$#parts] : $parts[$x] ); my $tz; { local $@; $tz = eval { DateTime::TimeZone->new( name => $name ) }; } return $tz if $tz; } } } sub _Readlink { my $link = $_[1]; require Cwd; # Using abs_path will resolve multiple levels of link indirection, # whereas readlink just follows the link to the next target. return Cwd::abs_path($link); } # for systems where /etc/localtime is a copy of a zoneinfo file sub _FindMatchingZoneinfoFile { my $class = shift; my $file_to_match = shift; return unless -d '/usr/share/zoneinfo'; require File::Basename; require File::Compare; require File::Find; my $size = -s $file_to_match; my $real_name; local $@; local $_; eval { local $SIG{__DIE__}; File::Find::find ( { wanted => sub { if ( ! defined $real_name && -f $_ && ! -l $_ && $size == -s _ # This fixes RT 24026 - apparently such a # file exists on FreeBSD and it can cause a # false positive && File::Basename::basename($_) ne 'posixrules' && File::Compare::compare( $_, $file_to_match ) == 0 ) { $real_name = $_; # File::Find has no mechanism for bailing in the # middle of a find. die { found => 1 }; } }, no_chdir => 1, }, '/usr/share/zoneinfo', ); }; if ($@) { return $real_name if ref $@ && $@->{found}; die $@; } } sub FromEtcTimezone { my $class = shift; my $tz_file = '/etc/timezone'; return unless -f $tz_file && -r _; local *TZ; open TZ, "<$tz_file" or die "Cannot read $tz_file: $!"; my $name = join '', ; close TZ; $name =~ s/^\s+|\s+$//g; return unless $class->_IsValidName($name); local $@; return eval { DateTime::TimeZone->new( name => $name ) }; } sub FromEtcTIMEZONE { my $class = shift; my $tz_file = '/etc/TIMEZONE'; return unless -f $tz_file && -r _; local *TZ; open TZ, "<$tz_file" or die "Cannot read $tz_file: $!"; my $name; while ( defined( $name = ) ) { if ( $name =~ /\A\s*TZ\s*=\s*(\S+)/ ) { $name = $1; last; } } close TZ; return unless $class->_IsValidName($name); local $@; return eval { DateTime::TimeZone->new( name => $name ) }; } # RedHat uses this sub FromEtcSysconfigClock { my $class = shift; return unless -r "/etc/sysconfig/clock" && -f _; my $name = $class->_ReadEtcSysconfigClock(); return unless $class->_IsValidName($name); local $@; return eval { DateTime::TimeZone->new( name => $name ) }; } # this is a sparate function so that it can be overridden in the test # suite sub _ReadEtcSysconfigClock { my $class = shift; local *CLOCK; open CLOCK, ') { return $1 if /^(?:TIME)?ZONE="([^"]+)"/; } } sub FromEtcDefaultInit { my $class = shift; return unless -r "/etc/default/init" && -f _; my $name = $class->_ReadEtcDefaultInit(); return unless $class->_IsValidName($name); local $@; return eval { DateTime::TimeZone->new( name => $name ) }; } # this is a separate function so that it can be overridden in the test # suite sub _ReadEtcDefaultInit { my $class = shift; local *INIT; open INIT, ') { return $1 if /^TZ=(.+)/; } } 1; __END__ =head1 NAME DateTime::TimeZone::Local::Unix - Determine the local system's time zone on Unix =head1 SYNOPSIS my $tz = DateTime::TimeZone->new( name => 'local' ); my $tz = DateTime::TimeZone::Local->TimeZone(); =head1 DESCRIPTION This module provides methods for determining the local time zone on a Unix platform. =head1 HOW THE TIME ZONE IS DETERMINED This class tries the following methods of determining the local time zone: =over 4 =item * $ENV{TZ} It checks C<< $ENV{TZ} >> for a valid time zone name. =item * F If this file is a symlink to an Olson database time zone file (usually in F) then it uses the target file's path to determine the time zone name. If reading the symlink fails for some reason, or if this file is not a symlink, it looks for a file that matches this file in F. If it finds one, it uses that file's path to determine the time zone name. =item * F If this file exists, it is read and its contents are used as a time zone name. =item * F If this file exists, it is opened and we look for a line starting like "TZ = ...". If this is found, it should indicate a time zone name. =item * F If this file exists, it is opened and we look for a line starting like "TIMEZONE = ..." or "ZONE = ...". If this is found, it should indicate a time zone name. =item * F If this file exists, it is opened and we look for a line starting like "TZ=...". If this is found, it should indicate a time zone name. =back =head1 AUTHOR Dave Rolsky, =head1 COPYRIGHT & LICENSE Copyright (c) 2003-2008 David Rolsky. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut