content-type results from the CPAN

Klonk
view release on metacpan or search on metacpan
            my @chunks = @{$_->[2]};
            my $rest = defined $chunks[-1] ? 0 : (pop @chunks, 1);
            my $re = join '([^/]*+)', map quotemeta, @chunks;
            $re .= '(.*+)' if $rest;
            $re .= "(*:$gen)";
            $mapping{$gen++} = $_->[0];
            $re
        }
        sort { $b->[1] cmp $a->[1] || $a->[0] cmp $b->[0] }
        map [$_, @{$routes{$_}}{'weight', 'chunks'}],
        keys %routes;
    $regex = '(?!)' if $regex eq '';
    #say STDERR ">>> $regex";
    #use re 'debugcolor';
    [
        qr/\A(?|$regex)\z/s,
        \%mapping,
    ]
}

my %text_types = (
    'css'    => 'text/css',
    'csv'    => 'text/csv',
    'html'   => 'text/html',
    'js'     => 'text/javascript',
    'json'   => 'application/json',
    'jsonld' => 'application/ld+json',
    'text'   => 'text/plain',
);

my %bin_types = (
    'bin'  => 'application/octet-stream',
    'jpeg' => 'image/jpeg',
    'png'  => 'image/png',
    'webp' => 'image/webp',
);

fun _postprocess($ret) {
    my $status = 200;
    if ($ret->[0] =~ /\A\d{3}\z/a) {
        $status = shift @$ret;
    }
    my ($itype, $body, $headers) = @$ret;

    for my $spec (
        [\%text_types, 1],
        [\%bin_types, 0],
    ) {
        my ($type_map, $encode_p) = @$spec;
        if (my $type = $type_map->{$itype}) {
            if ($encode_p) {
                utf8::encode $body unless ref $body;
                $type .= '; charset=utf-8';
            }
            my $length = ref $body
                ? -s $body || undef
                : length $body;
            return [
                $status,
                [
                    'content-type' => $type,
                    defined $length
                        ? ('content-length' => $length)
                        : (),
                    map {
                        my $k = $_;
                        my $v = $headers->{$k};
                        map +($k => $_), ref($v) eq 'ARRAY' ? @$v : $v
                    }
                    keys %{$headers // {}}
                ],
                ref $body ? $body : [ $body ]
            ];
        }
    }
    
    die "Unknown content type: $itype";
}

my $booted;
my @init;

fun on_init($fun) {
    croak "Can't call on_init() after boot()" if $booted;
    push @init, $fun;
}

fun dispatch($env) {
    my $kenv = Klonk::Env->new($env);
    my $req_path   = $env->{PATH_INFO};
    my $req_method = $env->{REQUEST_METHOD};

    $dispatch_info //= _routes_prepare;
    local our $REGMARK;
    if (my @captures = $req_path =~ /$dispatch_info->[0]/) {
        my $pattern = $dispatch_info->[1]{$REGMARK};
        my $meta = $routes{$pattern};
        splice @captures, $#{$meta->{chunks}};
        my $resource = $meta->{resource};
        if (my $info = $resource->{$req_method}) {
            my $handler = $info->{handler};
            return _postprocess $handler->($kenv, @captures);
        }

        if ($req_method eq 'HEAD' && (my $info = $resource->{GET})) {
            my $ret = _postprocess $info->{handler}($kenv, @captures);
            return [ 204, $ret->[1], [] ];
        }

        my $allowed_methods = join ', ', sort keys %$resource;
        if ($req_method eq 'OPTIONS') {
            return [ 204, [ 'allow' => $allowed_methods ], [] ];
        }

        return _postprocess [
            405,
            'html',
            "<!doctype html><title>405 Method Not Allowed</title><h1>405 Method Not Allowed</h1>",
            { allow => $allowed_methods }
        ];
    }
( run in 0.498 second using v1.01-cache-2.11-cpan-d7f47b0818f )