Advanced-Config
view release on metacpan or search on metacpan
lib/Advanced/Config/Date.pm view on Meta::CPAN
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";
# "Month Day, HH:MM:SS YYYY" or "Month Day HH:MM:SS YYYY"
# Added because: "$dt = localtime(time())" generates this format.
} elsif ( $in_date =~ m/(${name})[.]?\s+(${dom})[,\s]\s*(\d{1,2}:\d{1,2}(:\d{1,2})?)\s+(\d{4})(\D|$)/ &&
exists $Months{lcx($1)} ) {
my $time;
( $month, $day, $time, $year ) = ( $1, $2, $3, $5 );
$fmt = "Month Day HH:MM[:SS] YYYY";
# As a string of 8 digits.
} elsif ( $in_date =~ m/(^|\D)(\d{8})(\D|$)/ ) {
($year, $month, $day) = parse_8_digit_date ( $2, $date_format_options, 0 );
$fmt = "YYYYMMDD";
# -------------------------------------------------------
# Finally, assume it's using a 2-digit year format ...
# Only if they are allowed ...
# -------------------------------------------------------
} elsif ( $allow_2_digit_years ) {
foreach my $sep ( @seps ) {
next if ( $sep eq ":" ); # Skip, if used it looks like a time of day ...
if ( $in_date =~ m/(^|[^:\d])(\d{1,2})(${sep})(\d{1,2})(${sep})(\d{1,2})([^:\d]|$)/ ) {
($s1, $s2) = ($3, $5);
my $yymmdd = sprintf ("%02d%02d%02d", $2, $4, $6);
($year, $month, $day) = parse_6_digit_date ( $yymmdd, $date_format_options );
$fmt = "YY${s1}MM${s2}DD ???";
# ------------------------------------------------------------------------------------------
} elsif ( $in_date =~ m/(^|\D)(\d{1,2})(${sep})(${name})[.]?(${sep})(\d{1,2})([^:\d]|$)/ &&
exists $Months{lcx($4)} ) {
( $year, $s1, $month, $s2, $day ) = ( $2, $3, $4, $5, $6 );
my $yymmdd = sprintf ("%02d%02d%02d", $year, $Months{lcx($month)}, $day);
my @order;
foreach ( split (/\s*,\s*/, $date_format_options) ) {
push (@order, $_) if ( $_ != 2 ); # If not American format ...
}
($year, $month, $day) = parse_6_digit_date ( $yymmdd, join(",", @order) );
$fmt = "DD${s1}Month${s2}YY or YY${s1}Month${s2}DD";
} elsif ( $in_date =~ m/(^|\s)(${name})(${sep})(\d{1,2})(${sep})(\d{1,2})([^:\d]|$)/ &&
exists $Months{lcx($2)} ) {
( $month, $s1, $day, $s2, $year ) = ( $2, $3, $4, $5, $6 );
$year = make_it_a_4_digit_year ( $year );
$fmt = "Month${s1}DD${s2}YY";
# ------------------------------------------------------------------------------------------
} elsif ( $in_date =~ m/(^|\s)(${name})[.]?(${sep})(${dom})(${sep})(\d{1,2})([^:\d]|$)/ &&
_tst( $sep, $name, $dom, $2, $4, $6 ) &&
exists $Months{lcx($2)} &&
exists $Days{lcx($4)} ) {
( $month, $s1, $day, $s2, $year ) = ( $2, $3, $4, $5, $6 );
$year = make_it_a_4_digit_year ( $year );
$fmt = "Month${s1}Day${s2}YY"; # American format
} elsif ( $in_date =~ m/(^|\s)(${dom})(${sep})(${name})[.]?(${sep})(\d{1,2})([^:\d]|$)/ &&
_tst( $sep, $name, $dom, $2, $4, $6 ) &&
exists $Months{lcx($4)} &&
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 ) &&
lib/Advanced/Config/Date.pm view on Meta::CPAN
Changes the cutoff future date from B<30> years to I<$num_years>.
Set to B<0> to disable years in the future!
This affects all L<Advanced::Config> objects, not just the current one.
=cut
sub adjust_future_cutoff
{
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 ) {
( $year, $month, $day ) = ( $y, $m, $d );
last;
}
}
}
}
DBUG_RETURN ( $year, $month, $day );
}
( run in 0.448 second using v1.01-cache-2.11-cpan-483215c6ad5 )