view release on metacpan or  search on metacpan

lib/Date/Manip/TZ.pm  view on Meta::CPAN

   my @zone;
   if (exists $ENV{'DATE_MANIP_DEBUG_ZONES'}) {
      @zone  = split(/\s+/,$ENV{'DATE_MANIP_DEBUG_ZONES'});
   } else {
      @zone  = (keys %{ $$self{'data'}{'Alias'} },
                keys %{ $$self{'data'}{'MyAlias'} });
   }
   @zone     = sort _sortByLength(@zone);
   foreach my $zone (@zone) {
      $zone  =~ s/\057/\\057/g;   # /
      $zone  =~ s/\055/\\055/g;   # -
      $zone  =~ s/\056/\\056/g;   # .
      $zone  =~ s/\050/\\050/g;   # (
      $zone  =~ s/\051/\\051/g;   # )
      $zone  =~ s/\053/\\053/g;   # +
   }

   my $zone  = join('|',@zone);
   $zone     = qr/(?<zone>$zone)/i;

   # Abbreviation

   my @abb;
   if (exists $ENV{'DATE_MANIP_DEBUG_ABBREVS'}) {
      @abb  = split(/\s+/,$ENV{'DATE_MANIP_DEBUG_ABBREVS'});
   } else {
      @abb  = (keys %{ $$self{'data'}{'Abbrev'} },
               keys %{ $$self{'data'}{'MyAbbrev'} });
   }
   @abb     = sort _sortByLength(@abb);
   foreach my $abb (@abb) {
      $abb  =~ s/\055/\\055/g;   # -
      $abb  =~ s/\053/\\053/g;   # +
   }

   my $abb  = join('|',@abb);
   $abb     = qr/(?<abb>$abb)/i;

   # Offset (+HH, +HHMM, +HH:MM, +HH:MM:SS, +HHMMSS)

   my($hr)  = qr/(?:[0-1][0-9]|2[0-3])/;  # 00 - 23
   my($mn)  = qr/(?:[0-5][0-9])/;         # 00 - 59
   my($ss)  = qr/(?:[0-5][0-9])/;         # 00 - 59

   my($off) = qr/ (?<off> [+-] (?: $hr:$mn:$ss |
                                   $hr$mn$ss   |
                                   $hr:?$mn    |
                                   $hr
                               )
                  ) /ix;

   # Assemble everything
   #
   # A timezone can be any of the following in this order:
   #    Offset (ABB)
   #    Offset ABB
   #    ABB
   #    Zone
   #    Offset
   # We put ABB before Zone so CET gets parse as the more common abbreviation
   # than the less common zone name.

   $$self{'data'}{'namerx'}   = qr/(?<tzstring>$zone)/;
   $$self{'data'}{'abbrx'}    = qr/(?<tzstring>$abb)/;
   $$self{'data'}{'zonerx'}   = qr/(?<tzstring>(?:$abb|$zone))/;
   $$self{'data'}{'offrx'}    = qr/(?<tzstring>$off)/;
   $$self{'data'}{'offabbrx'} = qr/(?<tzstring>$off\s+$abb)/;
   $$self{'data'}{'offparrx'} = qr/(?<tzstring>$off\s*\($abb\))/;
   $$self{'data'}{'zrx'}      = qr/(?<tzstring>(?:$off\s*\($abb\)|$off\s+$abb|$abb|$zone|$off))/;

   return $$self{'data'}{$re};
}

# This sorts from longest to shortest element
#
no strict 'vars';
sub _sortByLength {
  return (length $b <=> length $a);
}
use strict 'vars';

########################################################################
# CONFIG VARS
########################################################################

# This sets a config variable. It also performs all side effects from
# setting that variable.
#
sub _config_var_tz {
   my($self,$var,$val) = @_;

   if ($var eq 'tz') {
      my $err = $self->_config_var_setdate("now,$val",0);
      return  if ($err);
      $$self{'data'}{'sections'}{'conf'}{'forcedate'} = 0;
      $val = 1;

   } elsif ($var eq 'setdate') {
      my $err = $self->_config_var_setdate($val,0);
      return  if ($err);
      $$self{'data'}{'sections'}{'conf'}{'forcedate'} = 0;
      $val = 1;

   } elsif ($var eq 'forcedate') {
      my $err = $self->_config_var_setdate($val,1);
      return  if ($err);
      $$self{'data'}{'sections'}{'conf'}{'setdate'} = 0;
      $val = 1;

   } elsif ($var eq 'configfile') {
      $self->_config_file($val);
      return;
   }

   my $base = $$self{'base'};
   $$base{'data'}{'sections'}{'conf'}{$var} = $val;
   return;
}

sub _config_var_setdate {