Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: ng
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 203 lines (177 sloc) 6.683 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202
use v6;
# A more or less direct port of
# <http://github.com/chneukirchen/rack/blob/master/lib/rack/utils.rb>
# This file is distributed under the license found in licenses/rack/COPYING.

module Web::Utils {
    # Web::Utils contains a grab-bag of useful methods for writing web
    # applications adopted (through Rack) from all kinds of Ruby libraries.

    # Performs URI escaping so that you can construct proper
    # query strings faster.
    sub escape($s) is export {
        # RAKUDO: Need 'H2' in Rakudo's unpack before this works
        # RAKUDO: Also need to turn the string into bytes before letting
        # the substitution loose on it.
        return (~$s).subst(/<-[ a..zA..Z0..9_.\-]>+/,
            { '%' ~ unpack(~$/, "H2" x $/.chars).join('%').uc },
            :global).trans(' ' => '+');
    }

    # Unescapes a URI escaped string.
    sub unescape(Str $s) is export {
        return $s.trans('+' => ' ').subst(/['%'<[0..9a..fA..F]>**2]+/,
            # RAKUDO: pack not implemented yet
# { $/.subst('%', '', :global).pack('H*') },
            { $/.subst('%', '', :global) },
            :global);
    }

    # Parses a query string by breaking it up at the '&'
    # and ';' characters. You can also use this to parse
    # cookies by changing the characters used in the second
    # parameter (which defaults to '&;').
    sub parse_query(Str $qs, $d = '&;') {
        my %params = {};

        # RAKUDO: Need to solve this with eval right now. [perl #63892]
        my $regex = eval("/<[$d]>/");
        for ($qs // '').split($regex) -> $p {
            my ($k, $v) = unescape($p).split('=', 2);

            (%params{$k} //= []).push($v);
        }

        for %params.kv -> $k, $v {
            %params{$k} = $v[0] if $v.elems == 1;
        }

        return %params;
    }

    sub parse_nested_query(Str $qs, $d = '&;') {
        my %params = {};

        # RAKUDO: Need to solve this with eval right now. [perl #63892]
        my $regex = eval("/<[$d]>/");
        for ($qs // '').split($regex) -> $p {
            my ($k, $v) = unescape($p).split('=', 2);

            normalize_params(%params, $k, $v);
        }
        return %params;
    }

    sub normalize_params(%params is rw, $name, $v = undef) {
        $name ~~ / <[ \[ \] ]>* (<-[ \[ \] ]>+) \]* /;
        my $k = ~$0;
        my $after = $name.substr($/.to);

        return unless $k.chars;

        given $after {
            when '' {
                %params{$k} = $v;
            }
            when '[]' {
                %params{$k} //= [];
                die 'Type error' unless %params{$k} ~~ List;
                %params{$k}.push($v);
            }
            when /^ '[][' (<-[ \[ \] ]>+) ']' $/ | /^ '[]'(.+) $/ {
                my $child_key = ~$0;
                %params{$k} //= [];
                die 'Type error' unless %params{$k} ~~ List;
                if %params{$k}[*-1] ~~ Hash
                   && !%params{$k}[*-1].exists($child_key) {
                    normalize_params(%params{$k}[*-1], $child_key, $v);
                }
                else {
                    %params{$k}.push(
                        normalize_params(%params{$k}, $after, $v)
                    );
                }
            }
            default {
                %params{$k} //= {};
                %params{$k} = normalize_params(%params{$k}, $after, $v);
            }
        }

        return %params;
    }

    sub build-query(Hash %params) is export {
        return %params.pairs.map({
            my ($k, $v) = .kv;
            $v ~~ List ?? build-query($v.map: { [$k, $^x] })
                       !! escape($k) ~ '=' ~ escape($v)
        }).join('&');
    }

    # Escape ampersands, brackets and quotes to their HTML/XML entities.
    sub escape-html($string) {
        return (~$string).subst('&', '&amp;' )\
                         .subst('<', '&lt;' )\
                         .subst('>', '&gt;' )\
                         .subst(q['],'&#39;' )\
                         .subst('"', '&quot;');
    }

    sub select-best-encoding($available-encodings, $accept-encoding) {
        # http://www.w3.org/Protocols/rfc2616/rfc2616-sec14.html

        # XXX: This became too complicated for me without further knowledge.
        # Punting for now.
    }

    # The recommended manner in which to implement a contexting application
    # is to define a method #context in which a new Context is instantiated.
    #
    # As a Context is a glorified block, it is highly recommended that you
    # define the contextual block within the application's operational scope.
    class Context is Routine {
        # TODO
    }

    # A case-insensitive Hash that preserves the original case of a
    # header when set.
    class HeaderHash is Hash {
        # TODO
    }

    # Every standard HTTP code mapped to the appropriate message.
    # Stolen from Mongrel.
    my %HTTP_STATUS_CODES =
      100 => 'Continue',
      101 => 'Switching Protocols',
      200 => 'OK',
      201 => 'Created',
      202 => 'Accepted',
      203 => 'Non-Authoritative Information',
      204 => 'No Content',
      205 => 'Reset Content',
      206 => 'Partial Content',
      300 => 'Multiple Choices',
      301 => 'Moved Permanently',
      302 => 'Found',
      303 => 'See Other',
      304 => 'Not Modified',
      305 => 'Use Proxy',
      307 => 'Temporary Redirect',
      400 => 'Bad Request',
      401 => 'Unauthorized',
      402 => 'Payment Required',
      403 => 'Forbidden',
      404 => 'Not Found',
      405 => 'Method Not Allowed',
      406 => 'Not Acceptable',
      407 => 'Proxy Authentication Required',
      408 => 'Request Timeout',
      409 => 'Conflict',
      410 => 'Gone',
      411 => 'Length Required',
      412 => 'Precondition Failed',
      413 => 'Request Entity Too Large',
      414 => 'Request-URI Too Large',
      415 => 'Unsupported Media Type',
      416 => 'Requested Range Not Satisfiable',
      417 => 'Expectation Failed',
      500 => 'Internal Server Error',
      501 => 'Not Implemented',
      502 => 'Bad Gateway',
      503 => 'Service Unavailable',
      504 => 'Gateway Timeout',
      505 => 'HTTP Version Not Supported'
    ;

    # Responses with HTTP status codes that should not have an entity body
    my %STATUS_WITH_NO_ENTITY_BODY;
    # RAKUDO: map within module declaration doesn't work.
    for 100..199, 204, 304 {
        %STATUS_WITH_NO_ENTITY_BODY{$_} = 1;
    }

    # A multipart form data parser, adapted from IOWA.
    #
    # Usually, Web::Request.POST takes care of calling this.

    module Multipart {
        # TODO
    }
}
Something went wrong with that request. Please try again.