File Coverage

blib/lib/FU/Util.pm

Criterion	Covered	Total	%
statement	82	86	95.3
branch	22	28	78.5
condition	8	10	80.0
subroutine	15	16	93.7
pod	6	9	66.6
total	133	149	89.2

package FU::Util 1.4;

use v5.36;
use FU::XS;
use Carp 'confess';
use Exporter 'import';
use Encode ();
use POSIX ();
use experimental 'builtin';

our @EXPORT_OK = qw/
    to_bool
    json_format json_parse
    has_control check_control utf8_decode
    uri_escape uri_unescape
    query_decode query_encode
    httpdate_format httpdate_parse
    gzip_lib gzip_compress brotli_compress
    fdpass_send fdpass_recv
/;


# Internal utility function
sub has_control :prototype($) ($s) { defined $s && $s =~ /[\x00-\x08\x0b\x0c\x0e-\x1f\x7f]/ }
sub check_control :prototype($) ($s) { confess 'Invalid control character' if has_control $s; }

# Deprecated, call Encode::decode() directly.
sub utf8_decode :prototype($) {
    return if !defined $_[0];
    eval {
        $_[0] = Encode::decode('UTF-8', $_[0], Encode::FB_CROAK);
        1
    } || confess($@ =~ s/ at .+\n$//r);
    $_[0]
}

sub uri_escape :prototype($) ($s) {
    utf8::encode($s);
    $s =~ s/([^A-Za-z0-9._~-])/sprintf '%%%02x', ord $1/eg;
    $s;
}

sub uri_unescape :prototype($) ($s) {
    return if !defined $s;
    utf8::encode($s);
    $s =~ tr/+/ /;
    $s =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
    utf8_decode $s;
}

sub query_decode :prototype($) ($s) {
    my %o;
    for (split /&/, $s//'') {
        next if !length;
        my($k,$v) = map uri_unescape($_), split /=/, $_, 2;
        $v //= builtin::true;
        if (ref $o{$k}) { push $o{$k}->@*, $v }
        elsif (exists $o{$k}) { $o{$k} = [ $o{$k}, $v ] }
        else { $o{$k} = $v }
    }
    \%o
}

sub query_encode :prototype($) ($o) {
    return join '&', map {
        my($k, $v) = ($_, $o->{$_});
        $k = uri_escape $k;
        map {
            my $x = $_;
            $x = $x->TO_QUERY() if builtin::blessed($x) && $x->can('TO_QUERY');
            my $bool = to_bool($x);
            !defined $x || !($bool//1) ? ()
            : $bool ? $k
            : $k.'='.uri_escape($x)
        } ref $v eq 'ARRAY' ? @$v : ($v);
    } sort keys %$o;
}


my @httpmonths = qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/;
my %httpmonths = map +($httpmonths[$_], $_), 0..11;
my @httpdays = qw/Sun Mon Tue Wed Thu Fri Sat/;
my $httpdays = '(?:'.join('|', @httpdays).')';

sub httpdate_format :prototype($) ($time) {
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = gmtime $time;
    sprintf '%s, %02d %s %d %02d:%02d:%02d GMT',
        $httpdays[$wday], $mday, $httpmonths[$mon], $year+1900, $hour, $min, $sec;
}

sub httpdate_parse :prototype($) ($str) {
    return if $str !~ /^\s*$httpdays, ([0-9]{2}) ([A-Z][a-z]{2}) ([0-9]{4}) ([0-9]{2}):([0-9]{2}):([0-9]{2}) GMT\s*$/;
    my ($mday, $mon, $year, $hour, $min, $sec) = ($1, $httpmonths{$2}, $3, $4, $5, $6);
    return if !defined $mon;
    # mktime() interprets the broken down time as our local timezone,
    # which is utter garbage. But we can work around that by subtracting the
    # time offset between localtime and gmtime around the given date. Might be
    # off for a few hours around DST changes, but ugh.
    my $mktime = POSIX::mktime($sec, $min, $hour, $mday, $mon, $year-1900);
    $mktime + (POSIX::mktime(localtime $mktime) - POSIX::mktime(gmtime $mktime));
}


1;
__END__