view release on metacpan or  search on metacpan

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

   my $dom_str   = shift;
   my $allow_2_digit_years = shift;

   my ($year, $s1, $month, $s2, $day );

   if ( $in_date =~ m/(^|[^:\d])(${month_num})(\D)(${dom_str})(.*?\D)(\d{4})($|\D)/     ||
        $in_date =~ m/(^|[^:\d])(${month_num})(\D.*?\D)(${dom_str})(.*?\D)(\d{4})($|\D)/ ) {
      ($month, $s1, $day, $s2, $year ) = ( $2, $3, $4, $5, $6 );  # American format ...

   } elsif ($in_date =~ m/(^|\D)(${dom_str})(.*?\D)(${month_num})(\D)(\d{4})($|\D)/     ||
            $in_date =~ m/(^|\D)(${dom_str})(.*?\D)(${month_num})(\D.*?\D)(\d{4})($|\D)/ ) {
      ($day, $s1, $month, $s2, $year ) = ( $2, $3, $4, $5, $6 );  # European format ...

   } elsif ( $in_date =~ m/(^|\D)(\d{4})(\D)(${month_num})(\D)(${dom_str})($|\D)/       ||
             $in_date =~ m/(^|\D)(\d{4})(\D)(${month_num})(\D.*?\D)(${dom_str})($|\D)/       ||
             $in_date =~ m/(^|\D)(\d{4})(\D.*?\D)(${month_num})(\D)(${dom_str})($|\D)/       ||
             $in_date =~ m/(^|\D)(\d{4})(\D.*?\D)(${month_num})(\D.*?\D)(${dom_str})($|\D)/ ) {
      ($year, $s1, $month, $s2, $day ) = ( $2, $3, $4, $5, $6 );  # ISO format ...
   }

   if ( $allow_2_digit_years && ! defined $year ) {
      if ( $in_date =~ m/(^|\D)(${month_num})([^:\d])(${dom_str})(.*?[^:\d])(\d{2})($|[^:\d])/   ||
           $in_date =~ m/(^|\D)(${month_num})([^:\d].*?[^:\d])(${dom_str})(.*?[^:\d])(\d{2})($|[^:\d])/ ) {
         ($month, $s1, $day, $s2, $year ) = ( $2, $3, $4, $5, $6 );  # American format ...

      } elsif ($in_date =~ m/(^|\D)(${dom_str})(.*?[^:\d])(${month_num})([^:\d])(\d{2})($|[^:\d])/  ||
               $in_date =~ m/(^|\D)(${dom_str})(.*?[^:\d])(${month_num})([^:\d].*?[^:\d])(\d{2})($|[^:\d])/ ) {
         ($day, $s1, $month, $s2, $year ) = ( $2, $3, $4, $5, $6 );  # European format ...

      } elsif ( $in_date =~ m/(^|[^:\d])(\d{2})([^:\d])(${month_num})([^:\d])(${dom_str})($|\D)/  ||
                $in_date =~ m/(^|[^:\d])(\d{2})([^:\d])(${month_num})([^:\d].*?[^:\d])(${dom_str})($|\D)/  ||
                $in_date =~ m/(^|[^:\d])(\d{2})([^:\d].*?[^:\d])(${month_num})([^:\d])(${dom_str})($|\D)/  ||
                $in_date =~ m/(^|[^:\d])(\d{2})([^:\d].*?[^:\d])(${month_num})([^:\d].*?[^:\d])(${dom_str})($|\D)/ ) {
         ($year, $s1, $month, $s2, $day ) = ( $2, $3, $4, $5, $6 );  # ISO format ...
      }

      $year = make_it_a_4_digit_year ( $year )  if (defined $year);
   }   # End if allowing 2-digit years ...

   if ( defined $year ) {
      return DBUG_RETURN ( _check_if_good_date ($in_date, $year, $month, $day) );
   }

   DBUG_RETURN ( undef );
}

# --------------------------------------------------------------
# A very ambiguous format ... and much, much messier!

sub _month_num_day_num
{
   DBUG_ENTER_FUNC ( @_ );
   my $in_date   = shift;
   my $month_num = shift;
   my $dom_num   = shift;
   my $allow_2_digit_years = shift;
   my $date_format_options = shift;

   my ($year, $s1, $month, $s2, $day );

   # Unknown format, use hint to decide ...
   if ( $in_date =~ m/(^|\D)(\d{8})($|\D)/ ) {
      ( $year, $month, $day ) = parse_8_digit_date ( $2, $date_format_options, 0 );
      $s1 = $s2 = "";

   # American or European Format, use hint to decide ...
   } elsif ( $in_date =~ m/(^|\D)(\d{1,2})(\D+)(\d{1,2})(\D+)(\d{4})(\D|$)/ ) {
      ( $s1, $s2 ) = ( $3, $5 );
      my $date = sprintf ("%02d%02d%04d", $2, $4, $6);
      ( $year, $month, $day ) = parse_8_digit_date ( $date, $date_format_options, 1 );

   # ISO Format ...
   } elsif ( $in_date =~ m/(^|\D)(\d{4})(\D+)(${month_num})(\D+)(${dom_num})(\D|$)/ ) {
      ( $year, $s1, $month, $s2, $day ) = ( $2, $3, $4, $5, $6 );
   }


   if ( $allow_2_digit_years && ! defined $year ) {
      # Unknown format, use hint to decide ...
      if ( $in_date =~ m/(^|\D)(\d{6})($|\D)/ ) {
         ( $year, $month, $day ) = parse_6_digit_date ( $2, $date_format_options );
         $s1 = $s2 = "";

      # Unknown format, use hint to decide ...
      } elsif ( $in_date =~ m/(^|[^:\d])(\d{1,2})([^:\d]+)(\d{1,2})([^:\d]+)(\d{1,2})([^:\d]|$)/ ) {
         ( $s1, $s2 ) = ( $3, $5 );
         my $date = sprintf ("%02d%02d%02d", $2, $4, $6);
         ( $year, $month, $day ) = parse_6_digit_date ( $date, $date_format_options );
      }
   }   # End if allowing 2-digit years ...

   if ( defined $year ) {
      return DBUG_RETURN ( _check_if_good_date ($in_date, $year, $month, $day) );
   }

   DBUG_RETURN ( undef );
}


# --------------------------------------------------------------
# Always returns date in ISO format if it's good!
# Or undef if a bad date!

sub _check_if_good_date
{
   DBUG_ENTER_FUNC ( @_ );
   my $in_str = shift;
   my $year   = shift;
   my $month  = shift;
   my $day    = shift;

   # Strip off any leading zeros so we can use the hashes for validation ...
   $month =~ s/^0+//;
   $day   =~ s/^0+//;

   # Standardize it ... (with digits only!)
   $month = $Months{lcx($month)};
   $day   = $Days{lcx($day)};

   # Helpfull when dealing with foreign languages.
   my $err_msg;
   if ( defined $month && defined $day ) {
      ;      # Good date!
   } elsif ( defined $month ) {
      $err_msg = "Just the day of month is bad.";
   } elsif ( defined $day ) {
      $err_msg = "Just the month is bad.";
   } else {
      $err_msg = "Both the month and day are bad.";
   }

   unless ( $err_msg ) {
      if ( 1 <= $day && $day <= $days_in_months[$month] ) {
         ;  # It's a good date ...
      } elsif ( $month == 2 && $day == 29 ) {
         my $leap = _is_leap_year ($year);
         $year = undef  unless ( $leap );
      } else {
         $year = undef;
      }
      unless ( defined $year ) {
         $err_msg = "The day of month is out of range.";
      }
   }