Advanced-Config
view release on metacpan or search on metacpan
lib/Advanced/Config/Date.pm view on Meta::CPAN
Since both modules sometimes give extra information that can be useful in
parsing a date..
=head1 FOUR-DIGIT VS TWO-DIGIT YEARS IN A DATE
This module will accept both 4-digit and 2-digit years in the dates it parses.
But two-digit years are inherently ambiguous if you aren't given the expected
format up front. So 2-digit years generate more unreliability in the parsing
of any dates by this module.
So when used by the L<Advanced::Config> module, that module gives you the
ability to turn two-digit years on or off. This is done via the B<Get Option>
"B<date_enable_yy>" which defaults to 0, B<not> allowing two-digit years.
To help resolve ambiguity with numeric dates, there is an option "B<date_format>"
that tells the L<Advanced::Config> how to parse these dates. See the order
argument for I<parse_6_digit_date()> and I<parse_8_digit_date()> for how this
is done.
Finally if you use "B<date_dl_conversion>" and module L<Date::Language> is
installed, it will enhance parse_date() with that module's str2time() parser.
So if this option was used, it doesn't make much sense to disable 2-digit years.
Since we can't turn off 2-digit year support for str2time().
See L<Advanced::Config::Options> for more options telling how that module
controls how L<Advanced::Config> uses this module for parsing dates.
Those options have no effect if you are calling these methods directly.
=head1 FUNCTIONS
=over 4
=cut
package Advanced::Config::Date;
use strict;
use warnings;
use File::Spec;
use File::Glob qw (bsd_glob);
use vars qw( @ISA @EXPORT @EXPORT_OK $VERSION );
use Exporter;
use Fred::Fish::DBUG 2.09 qw / on_if_set ADVANCED_CONFIG_FISH /;
$VERSION = "1.14";
@ISA = qw( Exporter );
@EXPORT = qw( get_languages
swap_language
parse_date
adjust_future_cutoff
make_it_a_4_digit_year
parse_8_digit_date
parse_6_digit_date
init_special_date_arrays
_date_language_installed
_date_manip_installed
_validate_date_str
is_leap_year
calc_hundred_year_date
calc_day_of_week
convert_hyd_to_date_str
calc_day_of_year
adjust_date_str
);
@EXPORT_OK = qw( );
my $global_cutoff_date = 30; # Defaults to 30 years in the future ...
# Thesee haahes tell which language modules are available ...
my %date_language_installed_languages;
my %date_manip_installed_languages;
# ========================================================================
# Detects if the optional Date::Language module is available ...
# If it's not installed, you'll be unable to swap languages using it!
BEGIN
{
eval {
local $SIG{__DIE__} = "";
require Date::Language;
# Find out where it's installed
my $loc = $INC{"Date/Language.pm"};
$loc =~ s/[.]pm$//;
my $search = File::Spec->catfile ($loc, "*.pm");
# Get's the list of languages supported.
foreach my $f ( bsd_glob ($search) ) {
my $module = (File::Spec->splitdir( $f ))[-1];
$module =~ s/[.]pm$//;
my %data = ( Language => $module,
Module => "Date::Language::${module}" );
$date_language_installed_languages{lc($module)} = \%data;
}
};
}
# ========================================================================
# Detects if the optional Date::Manip module is available ...
# If it's not installed, you'll be unable to swap languages using it!
BEGIN
{
eval {
local $SIG{__DIE__} = "";
require Date::Manip::Lang::index;
Date::Manip::Lang::index->import ();
foreach my $k ( sort keys %Date::Manip::Lang::index::Lang ) {
my $mod = $Date::Manip::Lang::index::Lang{$k};
my $lang = ( $k eq $mod ) ? ucfirst ($mod) : $mod;
my $module = "Date::Manip::Lang::${mod}";
my %data = ( Language => $lang, # A guess that's wrong sometimes
Module => $module );
$date_manip_installed_languages{lc ($k)} = \%data;
}
};
# -------------------------------------------------------------
# Proves sometimes the module name is different from the
# real language name.
# -------------------------------------------------------------
# foreach my $k ( sort keys %date_manip_installed_languages ) {
# printf STDERR ("Key (%s) Language (%s)\n", $k, $date_manip_installed_languages{$k}->{Language});
# }
}
# ========================================================================
# Hashes used to help validate/parse dates with ...
# Always keep the keys in lower case.
# Using the values from Date::Language::English for initialization ...
# Hard coded here in case Date::Language wasn't installed ...
# These hashes get rebuilt each time swap_language() is
# successfully called!
# ========================================================================
# Used by parse_date ();
my %last_language_edit_flags;
# Variants for the month names & days of month ...
# We hard code the initialization in case neither
# language module is installed locally.
my %Months;
my %Days;
BEGIN {
# Variants for the month names ...
%Months = (
# The USA Months spelled out ...
# Built from the @Date::Language::English::MoY array ...
"january" => 1, "february" => 2, "march" => 3,
"april" => 4, "may" => 5, "june" => 6,
"july" => 7, "august" => 8, "september" => 9,
"october" => 10, "november" => 11, "december" => 12,
# The USA Months using 3 char abreviations ("may" not repeated!)
# Built from the @Date::Language::English::MoYs array ...
"jan" => 1, "feb" => 2, "mar" => 3, "apr" => 4,
"jun" => 6, "jul" => 7, "aug" => 8,
"sep" => 9, "oct" => 10, "nov" => 11, "dec" => 12,
# Months as a numeric value. If all digits, leading zeros will
# be removed before it's used as a key.
"1" => 1, "2" => 2, "3" => 3, "4" => 4, "5" => 5, "6" => 6,
"7" => 7, "8" => 8, "9" => 9, "10" => 10, "11" => 11, "12" => 12
);
# variants for days of the month ...
%Days = (
"1" => 1, "2" => 2, "3" => 3, "4" => 4, "5" => 5,
"6" => 6, "7" => 7, "8" => 8, "9" => 9, "10" => 10,
"11" => 11, "12" => 12, "13" => 13, "14" => 14, "15" => 15,
"16" => 16, "17" => 17, "18" => 18, "19" => 19, "20" => 20,
"21" => 21, "22" => 22, "23" => 23, "24" => 24, "25" => 25,
"26" => 26, "27" => 27, "28" => 28, "29" => 29, "30" => 30,
"31" => 31,
# Built from the optional @Date::Language::English::Dsuf array ...
"1st" => 1, "2nd" => 2, "3rd" => 3, "4th" => 4, "5th" => 5,
"6th" => 6, "7th" => 7, "8th" => 8, "9th" => 9, "10th" => 10,
"11th" => 11, "12th" => 12, "13th" => 13, "14th" => 14, "15th" => 15,
"16th" => 16, "17th" => 17, "18th" => 18, "19th" => 19, "20th" => 20,
"21st" => 21, "22nd" => 22, "23rd" => 23, "24th" => 24, "25th" => 25,
"26th" => 26, "27th" => 27, "28th" => 28, "29th" => 29, "30th" => 30,
"31st" => 31,
# From Date::Manip::Lang::english::Language->{nth} arrays ...
lib/Advanced/Config/Date.pm view on Meta::CPAN
exists $Days{lcx($2)} ) {
( $day, $s1, $month, $s2, $year ) = ( $2, $3, $4, $5, $6 );
$year = make_it_a_4_digit_year ( $year );
$fmt = "Day${s1}Month${s2}YY"; # European format
} elsif ( $in_date =~ m/(^|\D)(\d{1,2})(${sep})(${name})[.]?(${sep})(${dom})(\s|$)/ &&
_tst( $sep, $name, $dom, $2, $4, $6 ) &&
exists $Months{lcx($4)} &&
exists $Days{lcx($6)} ) {
( $year, $s1, $month, $s2, $day ) = ( $2, $3, $4, $5, $6 );
$year = make_it_a_4_digit_year ( $year );
$fmt = "YY${s1}Month${s2}Day"; # ISO format
}
last if ( defined $year );
}
if ( defined $year ) {
; # No more formatting tests needed ...
# "Month Day, YY" or "Month Day YY"
} elsif ( $in_date =~ m/(${name})[.\s]\s*(${dom})[,\s]\s*(\d{2})(\D|$)/ &&
_tst( "\\s", $name, $dom, $1, $2, $3 ) &&
exists $Months{lcx($1)} ) {
( $month, $day ) = ( $1, $2 );
$year = make_it_a_4_digit_year ( $3 );
$fmt = "Month Day, YY";
# As a string of 6 digits.
} elsif ( $in_date =~ m/(^|\D)(\d{6})(\D|$)/ ) {
($year, $month, $day) = parse_6_digit_date ( $2, $date_format_options );
$fmt = "YYMMDD";
}
} # End if its a 2-digit year ...
# --------------------------------------------------------------------
# If my parsing didn't work try using Date::Language if it's installed.
# Keep after my checks so that things are consistent when this module
# isn't installed. (No way to disable 2-digit year format here.)
# --------------------------------------------------------------------
if ( $use_date_language_module && ! defined $year ) {
unless ( _date_language_installed () ) {
DBUG_PRINT ("INFO", "Using Date::Language::str2time was requested, but it's not installed!");
} else {
DBUG_PRINT ("INFO", "Using Date::Language::str2time to attempt the parse!");
eval {
my $dl = Date::Language->new ( $last_language_edit_flags{language} );
my $t = $dl->str2time ( $in_date );
if ( defined $t ) {
($year, $month, $day) = (localtime ($t))[5,4,3];
$year += 1900;
$month += 1;
}
};
}
}
# --------------------------------------------------------------------
# We're done with parsing things. Now let's validate the results!
# --------------------------------------------------------------------
if ( ! defined $year ) {
DBUG_PRINT ("ERROR", "No such date format is supported: %s", $in_date);
# Else we're using a known date format ...
} else {
DBUG_PRINT ("FORMAT", "%s ==> %s ==> (Y:%s, M:%s, D:%s, Sep:%s)",
$fmt, $in_date, $year, $month, $day, $s1);
# It's not a valid date if the separaters are different ...
# Shouldn't be possible any more unless it's spaces.
# (Hence we die if it happens)
if ( $s1 ne $s2 ) {
unless ( $s1 =~ m/^\s*$/ && $s2 =~ m/^\s*$/ ) {
die ("BUG: Separators are different ($s1 vs $s2)\n");
}
}
# Now let's validate the results ...
# Trim leading/trailing spaces ...
$day = $1 if ( $day =~ m/^\s*(.*)\s*$/ );
return DBUG_RETURN ( _check_if_good_date ($in_date, $year, $month, $day) );
}
DBUG_RETURN ( undef ); # Invalid date ...
}
sub parse_date
{
DBUG_ENTER_FUNC ( @_ );
my $in_date = shift; # A potential date in an unknown format ...
my $date_format_options = shift; # A comma separated list of fmt ids ...
my $use_date_language_module = shift || 0;
my $allow_2_digit_years = shift || 0;
$in_date = lcx ($in_date); # Make sure always in lower case ...
my ($month, $month_digits) = _find_month_in_string ( $in_date );
my ($dom, $dom_digits) = _find_day_of_month_in_string ( $in_date, $month_digits,
$month_digits ? undef : $month );
my $out_str;
if ( $month_digits && $dom_digits ) {
$out_str = _month_num_day_num ( $in_date, $month, $dom, $allow_2_digit_years, $date_format_options );
} elsif ( $month_digits ) {
$out_str = _month_num_day_str ( $in_date, $month, $dom, $allow_2_digit_years );
} elsif ( $dom_digits ) {
$out_str = _month_str_day_num ( $in_date, $month, $dom, $allow_2_digit_years, $date_format_options );
} else {
$out_str = _month_str_day_str ( $in_date, $month, $dom, $allow_2_digit_years );
}
# --------------------------------------------------------------------
# If my parsing didn't work try using Date::Language if it's installed.
# Keep after my checks so that things are consistent when this module
# isn't installed. (No way to disable 2-digit year format here.)
# --------------------------------------------------------------------
if ( $use_date_language_module && (! $out_str) &&
_date_language_installed () ) {
DBUG_PRINT ("INFO", "Using Date::Language::str2time to attempt parsing!");
eval {
my $dl = Date::Language->new ( $last_language_edit_flags{language} );
my $t = $dl->str2time ( $in_date );
if ( defined $t ) {
my ($year, $month, $day) = (localtime ($t))[5,4,3];
$year += 1900;
$month += 1;
$out_str = _check_if_good_date ($in_date, $year, $month, $day);
}
};
}
DBUG_RETURN ($out_str); # undef or the date in YYYY-MM-DD format.
}
lib/Advanced/Config/Date.pm view on Meta::CPAN
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 ) {
( $year, $month, $day ) = ( $y, $m, $d );
last;
}
}
}
}
DBUG_RETURN ( $year, $month, $day );
}
# ==============================================================
=item (\@months, \@weekdays) = init_special_date_arrays ( $lang[, $mode[, $wok[, $wide]]] );
Prefers getting the date names from I<Date::Manip::Lang::${lang}> for the
I<Advanced::Config> special date variables. But if the language isn't supported
by that module it tries I<Date::Language::${lang}> instead. This is because
the 1st module is more consistent.
If the I<$lang> doesn't exist, then it returns the arrays for the last valid
language.
If I<$wok> is set to a non-zero value, it will print warnings to your screen if
there were issues in changing the language used.
I<$mode> tells how to return the various arrays:
1 - Abbreviated month/weekday names in the requested language.
2 - Full month/weekday names in the requested language.
Any other value and it will return the numeric values. (default)
For @months, indexes are 0..11, with 0 representing January.
For @weekdays, indexes are 0..6, with 0 representing Sunday.
Languages like 'Greek' that rely on I<Wide Chars> require the I<$wide> flag set to
true. Otherwise that language is disabled.
=cut
sub init_special_date_arrays
{
DBUG_ENTER_FUNC ( @_ );
my $lang = shift;
my $mode = shift || 0; # Default to numeric arrays ...
my $warn_ok = shift || 0;
my $allow_wide = shift || 0;
lib/Advanced/Config/Date.pm view on Meta::CPAN
if ( $manip_ref ) {
my ( $u1, $u2, $u3 ); # Unused placeholders.
($u1, $u2, $u3, $MoY_ref, $MoYs_ref, $Dsuf_ref, $DoW_ref, $DoWs_ref) =
_swap_manip_language_common ($manip_ref, $warn_ok, $allow_wide );
$lang = $manip_ref->{Language};
if ( $u1 ) {
$lang_ref = undef; # Skip lang_ref lookup if successsful ...
} else {
$lang_ref = $date_language_installed_languages{lc($lang)};
}
}
if ( $lang_ref ) {
($MoY_ref, $MoYs_ref, $Dsuf_ref, $DoW_ref, $DoWs_ref) =
_swap_lang_common ( $lang_ref, $warn_ok, $allow_wide );
$lang = $lang_ref->{Language};
}
# If the new language was valid, update the global variables ...
if ( $MoY_ref ) {
$prev_array_lang = $lang;
@gMoY = @{$MoY_ref};
@gMoYs = map { uc($_) } @{$MoYs_ref};
@gDoW = @{$DoW_ref};
@gDoWs = map { uc($_) } @{$DoWs_ref};
@gDsuf = @{$Dsuf_ref};
DBUG_PRINT ( "LANGUAGE", "%s\n%s\n%s\n%s\n%s",
join (", ", @gMoY), join (", ", @gMoYs),
join (", ", @gDoW), join (", ", @gDoWs),
join (", ", @gDsuf)
);
}
# Numeric handled earlier ...
if ( $mode == 1 ) {
@months = @gMoYs; # Abrevited month names ...
@week_days = @gDoWs; # Abrevited week names ...
} elsif ( $mode == 2 ) {
@months = @gMoY; # Full month names ...
@week_days = @gDoW; # Full week names ...
}
DBUG_RETURN ( \@months, \@week_days );
}
# ==============================================================
sub _is_leap_year
{
my $year = shift;
my $leap = ($year % 4 == 0) && ($year % 100 != 0 || $year % 400 == 0);
return ($leap ? 1 : 0);
}
# ==============================================================
# Validate the input date.
sub _validate_date_str
{
DBUG_ENTER_FUNC ( @_ );
my $date_str = shift;
my ($year, $mon, $day);
if ( defined $date_str && $date_str =~ m/^(\d+)-(\d+)-(\d+)$/ ) {
($year, $mon, $day) = ($1, $2, $3);
my $leap = _is_leap_year ($year);
local $days_in_months[2] = $leap ? 29 : 28;
unless ( 1 <= $mon && $mon <= 12 &&
1 <= $day && $day <= $days_in_months[$mon] ) {
return DBUG_RETURN ( undef, undef, undef );
}
} else {
return DBUG_RETURN ( undef, undef, undef );
}
DBUG_RETURN ( $year, $mon, $day );
}
# ==============================================================
=item $bool = is_leap_year ( $year );
Returns B<1> if I<$year> is a Leap Year, else B<0> if it isn't.
=cut
sub is_leap_year
{
DBUG_ENTER_FUNC ( @_ );
DBUG_RETURN ( _is_leap_year (@_) );
}
# ==============================================================
=item $hyd = calc_hundred_year_date ( $date_str );
Takes a date string in B<YYYY-MM-DD> format and returns the number of days since
B<1899-12-31>. (Which is HYD B<0>.) It should be compatible with DB2's data
type of the same name. Something like this function is needed if you wish to be
able to do date math.
For example:
1 : 2026-01-01 - 2025-12-30 = 2 days.
2 : 2025-12-31 + 10 = 2026-01-10.
2 : 2025-12-31 - 2 = 2025-12-29.
If the given date string is invalid it will return B<undef>.
=cut
sub calc_hundred_year_date
{
DBUG_ENTER_FUNC ( @_ );
my $date_str = shift;
# Validate the input date.
my ($end_year, $month, $day) = _validate_date_str ($date_str);
unless (defined $end_year) {
return DBUG_RETURN ( undef );
}
my $hyd = 0;
my $start_year = 1899;
if ( $end_year > $start_year ) {
for (my $year = $start_year + 1; $year < $end_year; ++$year) {
my $leap = _is_leap_year ($year);
$hyd += $leap ? 366 : 365;
}
$hyd += calc_day_of_year ($date_str, 0);
} else { # $hyd <= 0 ...
for (my $year = $start_year; $year > $end_year; --$year) {
my $leap = _is_leap_year ($year);
$hyd -= $leap ? 366 : 365;
}
$hyd -= calc_day_of_year ($date_str, 1);
}
DBUG_RETURN ($hyd);
}
# ==============================================================
=item $dow = calc_day_of_week ( $date_str );
Takes a date string in B<YYYY-MM-DD> format and returns the day of the week it
falls on. It returns a value between B<0> and B<6> for Sunday to Saturday.
If the given date is invalid it will return B<undef>.
=item $dow = calc_day_of_week ( $hyd );
It takes an integer as a Hundred Year Date and returns the day of the week it
falls on. It returns a value between B<0> and B<6> for Sunday to Saturday.
If the given hyd is not an integer it will return B<undef>.
=cut
sub calc_day_of_week
{
DBUG_ENTER_FUNC ( @_ );
my $date_str = shift; # or a HYD ...
my $hyd;
if ( defined $date_str && $date_str =~ m/^[-]?\d+$/ ) {
$hyd = $date_str;
} else {
$hyd = calc_hundred_year_date ( $date_str );
}
unless (defined $hyd) {
return DBUG_RETURN ( undef );
}
my $start_dow = 0; # $hyd 0, 1899-12-31, falls on a Sunday.
lib/Advanced/Config/Date.pm view on Meta::CPAN
} else { # $target_hyd <= 0.
for ($year = $start_year; 1==1; --$year) {
$leap = _is_leap_year ($year);
$days = $leap ? 366 : 365;
if ( ($hyd_total - $days) <= $target_hyd ) {
last;
}
$hyd_total -= $days;
}
local $days_in_months[2] = $leap ? 29 : 28;
for (reverse 1..12) {
$days = $days_in_months[$_];
if ( ($hyd_total - $days) <= $target_hyd ) {
my $diff = $target_hyd - $hyd_total;
my $ans = $diff + $days;
DBUG_PRINT("-FINAL-", "Target: %d, Current: %d, Diff: %d, Year: %d/%02d, Day: %02d", $target_hyd, $hyd_total, $diff, $year, $_, $ans);
if ($ans) {
$date_str = sprintf ("%04d-%02d-%02d", $year, $_, $ans);
} elsif ( $_ == 1 ) {
$ans = $days_in_months[12];
$date_str = sprintf ("%04d-%02d-%02d", $year - 1, 12, $ans);
} else {
$ans = $days_in_months[$_ - 1];
$date_str = sprintf ("%04d-%02d-%02d", $year, $_ - 1, $ans);
}
last;
}
$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
=head1 SOME EXAMPLE DATES
Here are some sample date strings in B<English> that this module can parse.
All for Christmas 2017. This is not a complete list of available date formats
supported. But should hopefully give you a starting point of what is possible.
Remember that if a date string contains extra info around the date part of it,
that extra information is thrown away.
S<12/25/2017>, B<S<Mon Dec 25th 2017 at 09:00>>, S<Mon 2017/12/25>, B<S<2017-12-25>>,
S<Monday December 25th, 2017 at 09:00>, B<S<12.25.2017>>, S<25-DEC-2017>,
B<S<25-DECEMBER-2017>>, S<20171225>, B<S<12252017>>,
S<Mon dec. 25th 00:00:00 2017>, B<S<2017 12 25 mon>>.
Most of the above examples will also work with 2-digit years as well.
And just to remind you that other languages are supported if L<Date::Language>
( run in 0.760 second using v1.01-cache-2.11-cpan-39bf76dae61 )