Advanced-Config
view release on metacpan or search on metacpan
lib/Advanced/Config/Date.pm view on Meta::CPAN
=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;
# The Month name pattern, ... [a-zA-Z] doesn't work for other languages.
my $name = "[^-\$\\s\\d.,|\\[\\]\\\\/{}()]";
# The Day of Month pattern ... (when not all digits are expected)
my $dom = "\\d{0,2}${name}*";
# Remove the requesed character from the month pattern ...
$name =~ s/\\s//g if ( $last_language_edit_flags{month_spaces} );
$name =~ s/[.]//g if ( $last_language_edit_flags{month_period} );
$name =~ s/-//g if ( $last_language_edit_flags{month_hyphin} );
$name .= '+'; # Terminate the name pattern.
# Remove the requesed character from the day of month pattern ...
$dom =~ s/\\s//g if ( $last_language_edit_flags{dsuf_spaces} );
$dom =~ s/[.]//g if ( $last_language_edit_flags{dsuf_period} );
$dom =~ s/-//g if ( $last_language_edit_flags{dsuf_hyphin} );
my ( $year, $month, $day );
my ( $s1, $s2 ) = ( "", "" );
my $fmt = "n/a";
# The 7 separators to cycle through to parse things correctly ...
my @seps = ( "-", "/", "[.]", ",", "\\s+", '\\\\', ":" );
# -------------------------------------------------------
# Let's start with the 4-digit year formats ...
# -------------------------------------------------------
foreach my $sep ( @seps ) {
if ( $in_date =~ m/(^|\D)(\d{4})(${sep})(\d{1,2})(${sep})(\d{1,2})(\D|$)/ ) {
( $year, $s1, $month, $s2, $day ) = ( $2, $3, $4, $5, $6 );
$fmt = "YYYY${s1}MM${s2}DD"; # ISO format
} elsif ( $in_date =~ m/(^|\D)(\d{1,2})(${sep})(\d{1,2})(${sep})(\d{4})(\D|$)/ ) {
( $month, $s1, $day, $s2, $year ) = ( $2, $3, $4, $5, $6 );
( $year, $month, $day ) = parse_8_digit_date ( sprintf ("%02d%02d%04d", $month, $day, $year),
$date_format_options, 1 );
$fmt = "MM${s1}DD${s2}YYYY"; # European or American format (ambiguous?)
# ------------------------------------------------------------------------------------------
} elsif ( $in_date =~ m/(^|\D)(\d{1,2})(${sep})(${name})[.]?(${sep})(\d{4})(\D|$)/ &&
exists $Months{lcx($4)} ) {
( $day, $s1, $month, $s2, $year ) = ( $2, $3, $4, $5, $6 );
$fmt = "DD${s1}Month${s2}YYYY";
} elsif ( $in_date =~ m/(^|\D)(\d{4})(${sep})(${name})[.]?(${sep})(\d{1,2})(\D|$)/ &&
exists $Months{lcx($4)} ) {
( $year, $s1, $month, $s2, $day ) = ( $2, $3, $4, $5, $6 );
$fmt = "YYYY${s1}Month${s2}DD";
} elsif ( $in_date =~ m/(^|\s)(${name})(${sep})(\d{1,2})(${sep})(\d{4})(\D|$)/ &&
exists $Months{lcx($2)} ) {
( $month, $s1, $day, $s2, $year ) = ( $2, $3, $4, $5, $6 );
$fmt = "Month${s1}DD${s2}YYYY";
# ------------------------------------------------------------------------------------------
} elsif ( $in_date =~ m/(^|\s)(${dom})(${sep})(${name})[.]?(${sep})(\d{4})(\D|$)/ &&
exists $Months{lcx($4)} &&
exists $Days{lcx($2)} ) {
( $day, $s1, $month, $s2, $year ) = ( $2, $3, $4, $5, $6 );
$fmt = "Day${s1}Month${s2}YYYY"; # European format
} elsif ( $in_date =~ m/(^|\D)(\d{4})(${sep})(${name})[.]?(${sep})(${dom})(\s|$)/ &&
exists $Months{lcx($4)} &&
exists $Days{lcx($6)} ) {
( $year, $s1, $month, $s2, $day ) = ( $2, $3, $4, $5, $6 );
$fmt = "YYYY${s1}Month${s2}Day"; # ISO format
} elsif ( $in_date =~ m/(^|\s)(${name})(${sep})(${dom})(${sep})(\d{4})(\D|$)/ &&
exists $Months{lcx($2)} &&
exists $Days{lcx($4)} ) {
( $month, $s1, $day, $s2, $year ) = ( $2, $3, $4, $5, $6 );
$fmt = "Month${s1}Day${s2}YYYY"; # American format
}
last if ( defined $year );
}
if ( defined $year ) {
; # No more formatting tests needed ...
# "Month Day, YYYY" or "Month Day YYYY"
} elsif ( $in_date =~ m/(${name})[.\s]\s*(${dom})[,\s]\s*(\d{4})(\D|$)/ &&
exists $Months{lcx($1)} ) {
( $month, $day, $year ) = ( $1, $2, $3 );
$fmt = "Month Day, YYYY";
lib/Advanced/Config/Date.pm view on Meta::CPAN
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.
my $dow = ($hyd + $start_dow) % 7;
DBUG_RETURN ($dow);
}
# ==============================================================
=item $date_str = convert_hyd_to_date_str ( $hyd );
It takes an integer as a Hundred Year Date and converts it into a date string
in the format of B<YYYY-MM-DD> and returns it.
If the given hyd is not an integer it will return B<undef>.
=cut
sub convert_hyd_to_date_str
{
DBUG_ENTER_FUNC ( @_ );
my $target_hyd = shift;
unless ( defined $target_hyd && $target_hyd =~ m/^[-]?\d+$/ ) {
return DBUG_RETURN ( undef );
}
my $date_str;
my $start_year = 1899; # HYD of 0 is 1899-12-31
my $hyd_total = 0;
my $days = 0;
my ($leap, $year);
if ( $target_hyd > 0 ) {
for ($year = $start_year + 1; 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 (1..12) {
$days = $days_in_months[$_];
if ( ($hyd_total + $days) >= $target_hyd ) {
my $diff = $target_hyd - $hyd_total;
$date_str = sprintf ("%04d-%02d-%02d", $year, $_, $diff);
last;
}
$hyd_total += $days;
}
} 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 );
lib/Advanced/Config/Date.pm view on Meta::CPAN
=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>
is installed, here's a date in Spanish that would be legal after
S<swap_language("Spanish")> was called.
=over 4
B<S<Lun Diciembre 25to 2017 18:05>>.
=back
=head1 COPYRIGHT
Copyright (c) 2018 - 2026 Curtis Leach. All rights reserved.
This program is free software. You can redistribute it and/or modify it under
the same terms as Perl itself.
=head1 SEE ALSO
L<Advanced::Config> - The main user of this module. It defines the Config object.
L<Advanced::Config::Options> - Handles the configuration of the Config module.
L<Advanced::Config::Reader> - Handles the parsing of the config file.
L<Advanced::Config::Examples> - Provides some sample config files and commentary.
L<Date::Language> - Provides foreign language support.
L<Date::Manip> - Provides additional foreign language support.
=cut
# ==============================================================
#required if module is included w/ require command;
1;
( run in 0.746 second using v1.01-cache-2.11-cpan-39bf76dae61 )