view release on metacpan or  search on metacpan

lib/Advanced/Config/Date.pm  view on Meta::CPAN

   DBUG_ENTER_FUNC ( @_ );
   my $years = shift;

   if ( defined $years && $years =~ m/^\d+$/ ) {
      $global_cutoff_date = shift;
   }

   DBUG_VOID_RETURN ();
}


# ==============================================================

=item $year = make_it_a_4_digit_year ( $two_digit_year );

Used whenever this module needs to convert a two-digit year into a four-digit
year.

When it converts YY into YYYY, it will assume 20YY unless the
resulting date is more than B<30> years in the future.  Then it's 19YY.

If you don't like this rule, use B<adjust_future_cutoff> to change
this limit!

=cut

sub make_it_a_4_digit_year
{
   DBUG_ENTER_FUNC ( @_ );
   my $year = shift || 0;    # Passed as a 2-digit year ...

   $year += 2000;   # Convert it to a 4-digit year ...

   # Get the current 4-digit year ...
   my $this_yr = (localtime (time()))[5];
   $this_yr += 1900;

   if ( $this_yr < $year && ($year - $this_yr) >= $global_cutoff_date ) {
      $year -= 100;   # Make it last century instead.
   }

   DBUG_RETURN ( $year );
}


# ==============================================================

=item ($year, $month, $day) = parse_8_digit_date ( $date_str, $order[, $skip] );

Looks for a valid date in an 8 digit string.  It checks each of the formats below
in the order specified by I<$order> until it hits something that looks like a
valid date.

   (1) YYYYMMDD - ISO
   (2) MMDDYYYY - American
   (3) DDMMYYYY - European

The I<$order> argument helps deal with ambiguities in the date.  Its a comma
separated list of numbers specifying to order to try out.  Ex: 3,2,1 means
try out the European date format 1st, then the American date format 2nd, and
finally the ISO format 3rd.  You could also just say I<$order> is B<3> and
only accept European dates.

It assumes its using the correct format when the date looks valid.  It does this
by validating the B<MM> is between 1 and 12 and that the B<DD> is between 1 and
31.  (Using the correct max for that month).  And then assumes the year is
always valid.

If I<$skip> is a non-zero value it will skip over the B<ISO> format if it's
listed in I<$order>.

Returns 3 B<undef>'s if nothing looks good.

=cut

sub parse_8_digit_date
{
   DBUG_ENTER_FUNC ( @_ );
   my $date_str = shift;
   my $order    = shift;
   my $skip_iso = shift || 0;

   my @order = split (/\s*,\s*/, $order);
   my @lbls = ( "", "YYYYMMDD - ISO", "MMDDYYYY - American", "DDMMYYYY - European" );

   my ( $year, $month, $day );
   foreach my $id ( @order ) {
      next  unless ( defined $id && $id =~ m/^[123]$/ );

      my ( $y, $m, $d ) = ( 0, 0, 0 );

      if ( $id == 1 && (! $skip_iso) &&    # YYYYMMDD - ISO
           $date_str =~ m/^(\d{4})(\d{2})(\d{2})$/ ) {
         ( $y, $m, $d ) = ( $1, $2, $3 );
      }
      if ( $id == 2 &&                     # MMDDYYYY - American
           $date_str =~ m/^(\d{2})(\d{2})(\d{4})$/ ) {
         ( $m, $d, $y ) = ( $1, $2, $3 );
      }
      if ( $id == 3 &&                     # DDMMYYYY - European
           $date_str =~ m/^(\d{2})(\d{2})(\d{4})$/ ) {
         ( $d, $m, $y ) = ( $1, $2, $3 );
      }

      if ( 1 <= $m && $m <= 12 && 1 <= $d && $d <= 31 ) {
         DBUG_PRINT ("INFO", "Validating if using %s format.", $lbls[$id]);
          my $max = $days_in_months[$m];
          if ( $m == 2 ) {
             my $leap = _is_leap_year ($y);
             ++$max  if ( $leap );
          }

          if ( $d <= $max ) {
             ( $year, $month, $day ) = ( $y, $m, $d );
             last;
          }
      }
   }

   DBUG_RETURN ( $year, $month, $day );
}


# ==============================================================

=item ($year, $month, $day) = parse_6_digit_date ( $date_str, $order );

Looks for a valid date in an 6 digit string.  It checks each of the formats below
in the order specified by I<$order> until it hits something that looks like a
valid date.

   (1) YYMMDD - ISO
   (2) MMDDYY - American
   (3) DDMMYY - European

The I<$order> argument helps deal with ambiguities in the date.  Its a comma
separated list of numbers specifying to order to try out.  Ex: 2,3,1 means
try out the American date format 1st, then the European date format 2nd, and
finally the ISO format 3rd.  You could also just say I<$order> is B<2> and
only accept European dates.

So if you use the wrong order, more than likely you'll get the wrong date!

It assumes its using the correct format when the date looks valid.  It does this
by validating the B<MM> is between 1 and 12 and that the B<DD> is between 1 and
31.  (Using the correct max for that month).  And then assumes the year is
always valid.

Returns 3 B<undef>'s if nothing looks good.

It always returns the year as a 4-digit year!

=cut

sub parse_6_digit_date
{
   DBUG_ENTER_FUNC ( @_ );
   my $date_str = shift;
   my $order    = shift;

   my @order = split (/\s*,\s*/, $order);
   my @lbls = ( "", "YYMMDD - ISO", "MMDDYY - American", "DDMMYY - European" );

   my ( $year, $month, $day );
   if ( $date_str =~ m/^(\d{2})(\d{2})(\d{2})$/ ) {
      my @part = ( $1, $2, $3 );
      foreach my $id ( @order ) {
         next  unless ( defined $id && $id =~ m/^[123]$/ );

         my ( $y, $m, $d ) = ( 0, 0, 0 );

         if ( $id == 1 &&    # YYMMDD - ISO
              1 <= $part[1] && $part[1] <= 12 &&
              1 <= $part[2] && $part[2] <= 31 )  {
            ( $m, $d, $y ) = ( $part[1], $part[2], $part[0] );
         }
         if ( $id == 2 &&    # MMDDYY - American
              1 <= $part[0] && $part[0] <= 12 &&
              1 <= $part[1] && $part[1] <= 31 ) {
            ( $m, $d, $y ) = ( $part[0], $part[1], $part[2] );
         }
         if ( $id == 3 &&    # DDMMYY - European
              1 <= $part[1] && $part[1] <= 12 &&
              1 <= $part[0] && $part[0] <= 31 ) {
            ( $m, $d, $y ) = ( $part[1], $part[0], $part[2] );
         }

         # Now validate the day of month ...
         if ( $m > 0 ) {
            DBUG_PRINT ("INFO", "Validating if using %s format.", $lbls[$id]);
            $y = make_it_a_4_digit_year ( $y );

            my $max = $days_in_months[$m];
            if ( $m == 2 ) {
               my $leap = _is_leap_year ($y);
               ++$max  if ( $leap );
            }

            if ( $d <= $max ) {