File Coverage

blib/lib/Date/Calc/XS.pm

Criterion	Covered	Total	%
statement	117	122	95.9
branch	71	78	91.0
condition	18	24	75.0
subroutine	7	7	100.0
pod	0	3	0.0
total	213	234	91.0

###############################################################################
##                                                                           ##
##    Copyright (c) 1995 - 2015 by Steffen Beyer.                            ##
##    All rights reserved.                                                   ##
##                                                                           ##
##    This package is free software; you can redistribute it                 ##
##    and/or modify it under the same terms as Perl itself.                  ##
##                                                                           ##
###############################################################################

package Date::Calc::XS;

BEGIN { eval { require bytes; }; }
use strict;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);

use Carp::Clan qw(^Date::);

require Exporter;
require DynaLoader;

@ISA = qw(Exporter DynaLoader);

@EXPORT = qw();

@EXPORT_OK = qw(
    Days_in_Year
    Days_in_Month
    Weeks_in_Year
    leap_year
    check_date
    check_time
    check_business_date
    Day_of_Year
    Date_to_Days
    Day_of_Week
    Week_Number
    Week_of_Year
    Monday_of_Week
    Nth_Weekday_of_Month_Year
    Standard_to_Business
    Business_to_Standard
    Delta_Days
    Delta_DHMS
    Delta_YMD
    Delta_YMDHMS
    N_Delta_YMD
    N_Delta_YMDHMS
    Normalize_DHMS
    Add_Delta_Days
    Add_Delta_DHMS
    Add_Delta_YM
    Add_Delta_YMD
    Add_Delta_YMDHMS
    Add_N_Delta_YMD
    Add_N_Delta_YMDHMS
    System_Clock
    Today
    Now
    Today_and_Now
    This_Year
    Gmtime
    Localtime
    Mktime
    Timezone
    Date_to_Time
    Time_to_Date
    Easter_Sunday
    Decode_Month
    Decode_Day_of_Week
    Decode_Language
    Decode_Date_EU
    Decode_Date_US
    Fixed_Window
    Moving_Window
    Compress
    Uncompress
    check_compressed
    Compressed_to_Text
    Date_to_Text
    Date_to_Text_Long
    English_Ordinal
    Calendar
    Month_to_Text
    Day_of_Week_to_Text
    Day_of_Week_Abbreviation
    Language_to_Text
    Language
    Languages
    Decode_Date_EU2
    Decode_Date_US2
    Parse_Date
    ISO_LC
    ISO_UC
);

%EXPORT_TAGS = (all => [@EXPORT_OK]);

##################################################
##                                              ##
##  "Version()" is available but not exported   ##
##  in order to avoid possible name clashes.    ##
##  Call "Date::Calc::XS::Version()" instead!   ##
##                                              ##
##################################################

$VERSION = '6.4';

bootstrap Date::Calc::XS $VERSION;

sub Decode_Date_EU2
{
    croak "Usage: (\$year,\$month,\$day) = Decode_Date_EU2(\$date[,\$lang]);\n" unless ((@_ == 1) or (@_ == 2));

    my($buffer) = shift;
    my($lang)   = shift || 0;
    my($year,$month,$day,$length);

    $lang = Language() unless (($lang >= 1) and ($lang <= Languages()));
    if ($buffer =~ /^\D*  (\d+)  [^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]*  ([A-Za-z\xC0-\xD6\xD8-\xF6\xF8-\xFF]+)  [^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]*  (\d+)  \D*$/x)
    {
        ($day,$month,$year) = ($1,$2,$3);
        $month = Decode_Month($month,$lang);
        unless ($month > 0)
        {
            return(); # can't decode month!
        }
    }
    elsif ($buffer =~ /^\D*  0*(\d+)  \D*$/x)
    {
        $buffer = $1;
        $length = length($buffer);
        if    ($length == 3)
        {
            $day   = substr($buffer,0,1);
            $month = substr($buffer,1,1);
            $year  = substr($buffer,2,1);
        }
        elsif ($length == 4)
        {
            $day   = substr($buffer,0,1);
            $month = substr($buffer,1,1);
            $year  = substr($buffer,2,2);
        }
        elsif ($length == 5)
        {
            $day   = substr($buffer,0,1);
            $month = substr($buffer,1,2);
            $year  = substr($buffer,3,2);
        }
        elsif ($length == 6)
        {
            $day   = substr($buffer,0,2);
            $month = substr($buffer,2,2);
            $year  = substr($buffer,4,2);
        }
        elsif ($length == 7)
        {
            $day   = substr($buffer,0,1);
            $month = substr($buffer,1,2);
            $year  = substr($buffer,3,4);
        }
        elsif ($length == 8)
        {
            $day   = substr($buffer,0,2);
            $month = substr($buffer,2,2);
            $year  = substr($buffer,4,4);
        }
        else { return(); } # wrong number of digits!
    }
    elsif ($buffer =~ /^\D*  (\d+)  \D+  (\d+)  \D+  (\d+)  \D*$/x)
    {
        ($day,$month,$year) = ($1,$2,$3);
    }
    else { return(); } # no match at all!
    $year = Moving_Window($year);
    if (check_date($year,$month,$day))
    {
        return($year,$month,$day);
    }
    else { return(); } # not a valid date!
}

sub Decode_Date_US2
{
    croak "Usage: (\$year,\$month,\$day) = Decode_Date_US2(\$date[,\$lang]);\n" unless ((@_ == 1) or (@_ == 2));

    my($buffer) = shift;
    my($lang)   = shift || 0;
    my($year,$month,$day,$length);

    $lang = Language() unless (($lang >= 1) and ($lang <= Languages()));
    if ($buffer =~ /^[^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]*  ([A-Za-z\xC0-\xD6\xD8-\xF6\xF8-\xFF]+)  [^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]*  0*(\d+)  \D*$/x)
    {
        ($month,$buffer) = ($1,$2);
        $month = Decode_Month($month,$lang);
        unless ($month > 0)
        {
            return(); # can't decode month!
        }
        $length = length($buffer);
        if    ($length == 2)
        {
            $day  = substr($buffer,0,1);
            $year = substr($buffer,1,1);
        }
        elsif ($length == 3)
        {
            $day  = substr($buffer,0,1);
            $year = substr($buffer,1,2);
        }
        elsif ($length == 4)
        {
            $day  = substr($buffer,0,2);
            $year = substr($buffer,2,2);
        }
        elsif ($length == 5)
        {
            $day  = substr($buffer,0,1);
            $year = substr($buffer,1,4);
        }
        elsif ($length == 6)
        {
            $day  = substr($buffer,0,2);
            $year = substr($buffer,2,4);
        }
        else { return(); } # wrong number of digits!
    }
    elsif ($buffer =~ /^[^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]*  ([A-Za-z\xC0-\xD6\xD8-\xF6\xF8-\xFF]+)  [^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]*  (\d+)  \D+  (\d+)  \D*$/x)
    {
        ($month,$day,$year) = ($1,$2,$3);
        $month = Decode_Month($month,$lang);
        unless ($month > 0)
        {
            return(); # can't decode month!
        }
    }
    elsif ($buffer =~ /^\D*  0*(\d+)  \D*$/x)
    {
        $buffer = $1;
        $length = length($buffer);
        if    ($length == 3)
        {
            $month = substr($buffer,0,1);
            $day   = substr($buffer,1,1);
            $year  = substr($buffer,2,1);
        }
        elsif ($length == 4)
        {
            $month = substr($buffer,0,1);
            $day   = substr($buffer,1,1);
            $year  = substr($buffer,2,2);
        }
        elsif ($length == 5)
        {
            $month = substr($buffer,0,1);
            $day   = substr($buffer,1,2);
            $year  = substr($buffer,3,2);
        }
        elsif ($length == 6)
        {
            $month = substr($buffer,0,2);
            $day   = substr($buffer,2,2);
            $year  = substr($buffer,4,2);
        }
        elsif ($length == 7)
        {
            $month = substr($buffer,0,1);
            $day   = substr($buffer,1,2);
            $year  = substr($buffer,3,4);
        }
        elsif ($length == 8)
        {
            $month = substr($buffer,0,2);
            $day   = substr($buffer,2,2);
            $year  = substr($buffer,4,4);
        }
        else { return(); } # wrong number of digits!
    }
    elsif ($buffer =~ /^\D*  (\d+)  \D+  (\d+)  \D+  (\d+)  \D*$/x)
    {
        ($month,$day,$year) = ($1,$2,$3);
    }
    else { return(); } # no match at all!
    $year = Moving_Window($year);
    if (check_date($year,$month,$day))
    {
        return($year,$month,$day);
    }
    else { return(); } # not a valid date!
}

sub Parse_Date
{
    croak "Usage: (\$year,\$month,\$day) = Parse_Date(\$date[,\$lang]);\n" unless ((@_ == 1) or (@_ == 2));

    my($date) = shift;
    my($lang) = shift || 0;
    my($year,$month,$day);

    $lang = Language() unless (($lang >= 1) and ($lang <= Languages()));
    unless ($date =~ /\b([\x41-\x5A\x61-\x7A\xC0-\xD6\xD8-\xF6\xF8-\xFF]{3})\s+([0123]??\d)\b/)
    {
        return();
    }
    $month = $1;
    $day   = $2;
    unless ($date =~ /\b(19\d\d|20\d\d)\b/)
    {
        return();
    }
    $year  = $1;
    $month = Decode_Month($month,$lang);
    unless ($month > 0)
    {
        return();
    }
    unless (check_date($year,$month,$day))
    {
        return();
    }
    return($year,$month,$day);
}

1;

__END__