File Coverage

blib/lib/DTL/Fast/Utils.pm

Criterion	Covered	Total	%
statement	39	117	33.3
branch	51	124	41.1
condition	2	55	3.6
subroutine	7	7	100.0
pod	0	3	0.0
total	99	306	32.3

package DTL::Fast::Utils;
use strict; use utf8; use warnings FATAL => 'all';
use parent 'Exporter';

require Date::Format;
require URI::Escape::XS;

our $VERSION = '1.00';

our @EXPORT_OK;

# @todo what with timezones?
push @EXPORT_OK, 'time2str';
sub time2str
{
    my $format = shift;
    my $time = shift;

    #  TIME_FORMAT, DATE_FORMAT, DATETIME_FORMAT, SHORT_DATE_FORMAT or SHORT_DATETIME_FORMAT

    return Date::Format::time2str($format, $time );
}

push @EXPORT_OK, 'time2str_php';
# the code below has been taken from Dotiac::DTL and should be re-written on C
# would be nice to implement module with this functionality (take from PHP source)
#locale stuff
our @datemonths=qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec );
our @datemonthl=qw( January February March April May Juni Juli August September October November December );
our @datemontha=qw( Jan. Feb. March April May Juni Juli Aug. Sep. Oct. Nov. Dec. );
our @weekdays=qw/Sun Mon Tue Wed Thu Fri Sat/;
our @weekdayl=qw/Sunday Monday Tuesday Wednesday Thursday Friday Saturday/;
our @timeampm=qw/a.m. p.m. AM PM/;
our @timespotnames=qw/midnight noon/;
our @datesuffixes=qw/th st nd rd/; #qw/Default day1 day2 day3 day4 day5...
sub time2str_php
{
    my $format = shift // "";
    my $time = shift // 0;

    my @t = localtime($time);
    my @s = split //, $format;

    my $res;

    while(my $s = shift @s )
    {
        if ($s eq '\\') {
            $res.=shift(@s);
        }
        elsif ($s eq "a") {
            if ($t[2] > 12 or ($t[2] == 12 and $t[1] > 0)) {
                $res.=$timeampm[0];
            }
            else {
                $res.=$timeampm[1];
            }
        }
        elsif ($s eq "A") {
            if ($t[2] > 12 or ($t[2] == 12 and $t[1] > 0)) {
                $res.=$timeampm[2];
            }
            else {
                $res.=$timeampm[3];
            }
        }
        elsif ($s eq "b") {
            $res.=lc($datemonths[$t[4]]);
        }
        elsif ($s eq "d") {
            $res.=sprintf("%02d",$t[3]);
        }
        elsif ($s eq "D") {
            $res.=$weekdays[$t[6]];
        }
        elsif ($s eq "f") {
            my $h=$t[2];
            $h=$h%12;
            $h=12 unless $h;
            $res.=$h;
            $res.=sprintf(":%02d",$t[1]) if ($t[1]);
        }
        elsif ($s eq "F") {
            $res.=$datemonthl[$t[4]];
        }
        elsif ($s eq "g") {
            my $h=$t[2];
            $h=$h%12;
            $h=12 unless $h;
            $res.=$h;
        }
        elsif ($s eq "G") {
            $res.=$t[2];
        }
        elsif ($s eq "h") {
            my $h=$t[2];
            $h=$h%12;
            $h=12 unless $h;
            $res.=sprintf("%02d",$h);
        }
        elsif ($s eq "H") {
            $res.=sprintf("%02d",$t[2]);
        }
        elsif ($s eq "i") {
            $res.=sprintf("%02d",$t[1]);
        }
        elsif ($s eq "j") {
            $res.=$t[3];
        }
        elsif ($s eq "l") {
            $res.=$weekdayl[$t[6]];
        }
        elsif ($s eq "L") {
            my $d=$t[5]+1900;
            $res.=(((not $d%4 and $d%100) or not $d%400)?"1":"0");
        }
        elsif ($s eq "m") {
            $res.=sprintf("%02d",$t[4]+1);
        }
        elsif ($s eq "M") {
            $res.=$datemonths[$t[4]];
        }
        elsif ($s eq "n") {
            $res.=$t[4]+1;
        }
        elsif ($s eq "N") {
            $res.=$datemontha[$t[4]];
        }
        elsif ($s eq "O") {
            my @tt=localtime(0);
            $tt[2]+=1 if $t[8];
            $res.=sprintf("%+05d",$tt[2]*100+$tt[1]);
        }
        elsif ($s eq "P") {
            if ($t[2] == 12 and $t[1] == 0) {
                $res.=$timespotnames[1];
            }
            elsif ($t[2] == 0 and $t[1] == 0) {
                $res.=$timespotnames[0];
            }
            else {
                my $h=$t[2];
                $h=$h%12;
                $h=12 unless $h;
                $res.=$h;
                $res.=sprintf(":%02d",$t[1]) if ($t[1]);
                if ($t[2] > 12 or ($t[2] == 12 and $t[1] > 0)) {
                    $res.=" ".$timeampm[0];
                }
                else {
                    $res.=" ".$timeampm[1];
                }
            }

        }
        elsif ($s eq "r") {
            $res.=$weekdays[$t[6]];
            $res.=", ";
            $res.=$t[4]+1;
            $res.=" ".$datemonths[$t[4]]." ".($t[5]+1900);
            $res.=sprintf(" %02d:%02d:%02d",$t[2],$t[1],$t[0]);
            my @tt=localtime(0);
            $tt[2]+=1 if $t[8];
            $res.=sprintf(" %+05d",$tt[2]*100+$tt[1]);
        }
        elsif ($s eq "s") {
            $res.=sprintf("%02d",$t[0]);
        }
        elsif ($s eq "S") {
            if ($datesuffixes[$t[3]]) {
                $res.=$datesuffixes[$t[3]];
            }
            else {
                $res.=$datesuffixes[0]
            }
        }
        elsif ($s eq "t") {
            if ($t[4] == 1 or $t[4]==3 or $t[4] == 5 or $t[4] == 7 or $t[4] == 8 or $t[4] == 10 or $t[4] == 12) {
                $res.="31";
            }
            elsif ($t[4] == 2) {
                my $d=$t[5]+1900;
                if ((not $d%4 and $d%100) or not $d%400) {
                    $res.="29";
                }
                else {
                    $res.="28";
                }
            }
            else {
                $res.="30";
            }
        }
        elsif ($s eq "T") {
            require POSIX;
            $res.=POSIX::strftime("%Z", @t);
        }
        elsif ($s eq "t") {
            $res.=$t[6];
        }
        elsif ($s eq "W") {
            require POSIX;
            $res.=POSIX::strftime("%W", @t);
        }
        elsif ($s eq "y") {
            $res.=sprintf("%02d",($t[5]%100));
        }
        elsif ($s eq "Y") {
            $res.=sprintf("%04d",$t[5]+1900);
        }
        elsif ($s eq "z") {
            $res.=$t[7];
        }
        elsif ($s eq "Z") {
            my @tt=localtime(0);
            $tt[2]+=1 if $t[8];
            $res.=$tt[2]*3600+$t[1]*60+$t[0];
        }
        elsif ($s eq "\n") {
            $res.="n";
        }
        elsif ($s eq "\t") {
            $res.="t";
        }
        elsif ($s eq "\f") {
            $res.="f";
        }
        elsif ($s eq "\b") {
            $res.="b";
        }
        elsif ($s eq "\r") {
            $res.="r";
        }
        else {
            $res.=$s;
        }
    }
    return $res;
}
### end of Dotiac::DTL code

#Shortcuts below not working on mswin and perl =< 18.2
push @EXPORT_OK, 'uri_escape';
*DTL::Fast::Utils::uri_escape = \&URI::Escape::XS::uri_escape;

push @EXPORT_OK, 'uri_unescape';
*DTL::Fast::Utils::uri_unescape = \&URI::Escape::XS::uri_unescape;

push @EXPORT_OK, 'escape';
*DTL::Fast::Utils::escape = \&URI::Escape::XS::encodeURIComponent;

push @EXPORT_OK, 'unescape';
*DTL::Fast::Utils::unescape = \&URI::Escape::XS::decodeURIComponent;

push @EXPORT_OK, 'as_bool';
sub as_bool
{
    my $value = shift;
    my $value_type = ref $value;

    if( $value_type )
    {
        if ( $value_type eq 'SCALAR' )
        {
            $value = $$value;
        }
        elsif( $value_type eq 'HASH' )
        {
            $value = scalar keys(%$value);
        }
        elsif( $value_type eq 'ARRAY' )
        {
            $value = scalar @$value;
        }
        elsif( UNIVERSAL::can( $value, 'as_bool' ) )
        {
            $value = $value->as_bool();
        }
    }

    return $value;
}


1;