view release on metacpan or  search on metacpan

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

   }

   foreach my $day ( 1..31 ) {
      $Days{$day} = $day;
   }

   # ---------------------------------------------------------
   # Merge in the Date::Manip::Lang::<language> values ...

   foreach my $mon ( keys %{$month_ref} ) {
      $Months{$mon} = $month_ref->{$mon};
      $Months{lc (uc (lc ($mon)))} = $Months{$mon};   # Bug fix, but usually same.
   }

   foreach my $day ( keys %{$day_ref} ) {
      $Days{$day} = $day_ref->{$day};
      $Days{lc (uc (lc ($day)))} = $Days{$day};       # Bug fix, but usually same.
   }

   # ---------------------------------------------------------
   # Merge in the Date::Language::<language> values ...

   $cnt = 1;
   foreach my $mon ( @{$MoY_ref} ) {
      $Months{lc ($mon)} = $cnt;
      $Months{lc (uc (lc ($mon)))} = $cnt;    # Bug fix, but usually same.
      ++$cnt;
   }

   $cnt = 1;
   foreach my $mon ( @{$MoYs_ref} ) {
      $Months{lc ($mon)} = $cnt;
      $Months{lc (uc (lc ($mon)))} = $cnt;    # Bug fix, but usually same.
      ++$cnt;
   }

   foreach my $day ( 1..31 ) {
      if ( $Dsuf_ref && defined $Dsuf_ref->[$day] ) {
         my $key = $Dsuf_ref->[$day];
         $Days{lc ($key)} = $day;
         $Days{lc (uc (lc ($key)))} = $day;   # Bug fix, but usually same.
      }
   }

   # ---------------------------------------------------------
   # Report the results ...

   DBUG_PRINT ( "LANGUAGE", "%s\n%s\n%s",
                join (", ", sort { $Months{$a} <=> $Months{$b} || $a cmp $b } keys %Months),
                join (", ", sort { my ($x,$y) = ($a,$b); $x=~s/\D+//g; $y=~s/\D+//g; $x=0 if ($x eq ""); $y=0 if ($y eq ""); ($x<=>$y || $a cmp $b) } keys %Days),
                join (", ", %last_language_edit_flags) );

   DBUG_RETURN ( $lang );
}


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

=item $date = parse_date ( $date_str, $order[, $allow_dl[, $enable_2_digit_years]] );

Passed a date in some unknown format, it does it's best to parse it and return
the date in S<YYYY-MM-DD> format if it's a valid date.  It returns B<undef> if
it can't find a valid date within I<$date_str>.

The date can be surrounded by other information in the string that will be
ignored.  So it will strip out just the date info in something like:

=over 4

Tues B<January 3rd, 2017> at 6:00 PM.

=back

There are too many valid date formats to list them all, especially when other
languages are added to the mix.  But if you have one it doesn't support, open
a CPAN ticket and I'll see if I can quickly add it.

I<$order> tells the order to use for interpreting dates that are all digits.
It's forwarded to all internal calls to L<parse_6_digit_date> and
L<parse_8_digit_date>.  So see those methods POD for more info on its meaning.

I<$allow_dl> is non-zero and L<Date::Language> is installed use it's method
B<str2time ()> to attempt the conversion only if nothing else worked.

If I<$enable_2_digit_years> is set to zero, it will not recognize any 2-digit
year date formats as valid.  Set to a non-zero value to enable them.

=cut

# Check out Date::Parse for date examples to use to test this function out.

sub lcx
{
   my $str = shift;

   unless ( utf8::is_utf8 ($str) ) {
      utf8::encode ($str);
      utf8::decode ($str);
   }

   return (lc ($str));
}

sub _tst
{
   my $s  = shift;
   my $nm = shift;
   my $dm = shift;
   DBUG_PRINT ("TST", "Matched Pattern (%s) Sep: %s Name: %s  Dom: %s", join (",",@_), $s, $nm, $dm);
   return (1);
}

# DEPRECIATED VERSION ...
sub parse_date_old
{
   DBUG_ENTER_FUNC ( @_ );
   my $in_date = shift;         # A potential date in an unknown format ...
   my $date_format_options      = shift;     # A comma separated list of ids ...
   my $use_date_language_module = shift || 0;
   my $allow_2_digit_years      = shift || 0;

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

	 }
	 $hyd_total -= $days;

DBUG_PRINT("MONTHLY", "Target: %d, Current: %d, Year: %d/%02d", $target_hyd, $hyd_total, $year, $_);
      }
   }

   DBUG_RETURN ($date_str);
}

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

=item $doy = calc_day_of_year ( $date_str[, $remainder_flag] );

Takes a date string in B<YYYY-MM-DD> format and returns the number of days since
the begining of the year.  With January 1st being day B<1>.

If the remainder_flag is set to a no-zero value, it returns the number of days
left in the year.  With December 31st being B<0>.

If the given date is invalid it will return B<undef>.

=cut

sub calc_day_of_year
{
   DBUG_ENTER_FUNC ( @_ );
   my $date_str       = shift;
   my $remainder_flag = shift || 0;

   # Validate the input date.
   my ($year, $month, $day) = _validate_date_str ($date_str);
   unless (defined $year) {
      return DBUG_RETURN ( undef );
   }

   my $leap = _is_leap_year ($year);
   local $days_in_months[2] = $leap ? 29 : 28;

   my $doy = 0;
   for (my $m = 0; $m < $month; ++$m) {
      $doy += $days_in_months[$m];
   }
   $doy += $day;

   if ($remainder_flag) {
      my $total_days_in_year = $leap ? 366 : 365;
      $doy = $total_days_in_year - $doy;
   }

   DBUG_RETURN ($doy);
}

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

=item $date_str = adjust_date_str ( $date_str, $years, $months );

Takes a date string in B<YYYY-MM-DD> format and adjusts it by the given number
of months and years.  It returns the new date in B<YYYY-MM-Dd> format.

It does its best to preserve the day of month, but if it would exceed the number
of days in a month, it will truncate to the end of month.  Not round to the next
month.

Returns I<undef> if passed bad arguments.

=cut

sub adjust_date_str
{
   DBUG_ENTER_FUNC ( @_ );
   my $date_str   = shift;
   my $adj_years  = shift || 0;
   my $adj_months = shift || 0;

   # Validate the input date.
   my ($year, $month, $day) = _validate_date_str ($date_str);
   unless (defined $year &&
	   $adj_years =~ m/^[-]?\d+$/ && $adj_months =~ m/^[-]?\d+$/) {
      return DBUG_RETURN ( undef );
   }

   # Adjust by month ...
   if ( $adj_months >= 0 ) {
      foreach (1..${adj_months}) {
         if ( $month == 12 ) {
            $month = 1;
	    ++$adj_years;
	 } else {
            ++$month;
	 }
      }
   } else {
      foreach (1..-${adj_months}) {
         if ( $month == 1 ) {
            $month = 12;
	    --$adj_years;
	 } else {
            --$month;
	 }
      }
   }

   # Adjust the years ...
   $year += $adj_years;

   # Build the returned date ...
   my $leap = _is_leap_year ($year);
   local $days_in_months[2] = $leap ? 29 : 28;
   my $d = $days_in_months[$month];

   $date_str = sprintf ("%04d-%02d-%02d", $year, $month,
                                          ($day <= $d) ? $day : $d);

   DBUG_RETURN ($date_str);
}

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

=back