Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 151 lines (133 sloc) 4.964 kb
d2cb626 @masak beginning of port of rack/utils
authored
1 use v6;
2 # A more or less direct port of
3 # <http://github.com/chneukirchen/rack/blob/master/lib/rack/utils.rb>
4
5 module Web::Utils {
6 # Web::Utils contains a grab-bag of useful methods for writing web
7 # applications adopted (through Rack) from all kinds of Ruby libraries.
8
9 # Performs URI escaping so that you can construct proper
10 # query strings faster.
11 sub escape($s) is export {
12 # RAKUDO: Need 'H2' in Rakudo's unpack before this works
13 # XXX: What does the /n flag do on Ruby regexes?
14 return (~$s).subst(/<-[ a..zA..Z0..9_.-]+>/,
15 { '%' ~ unpack(~$/, "H2" x $/.chars).join('%').uc },
16 :global).trans(' ' => '+');
17 }
18
19 # Unescapes a URI escaped string.
20 sub unescape(Str $s) is export {
21 return $s.trans('+' => ' ').subst(/['%'<[0..9a..fA..F]>**2]+/,
22 { $/.subst('%', '', :global).pack('H*') },
23 :global);
24 }
25
26 # Parses a query string by breaking it up at the '&'
27 # and ';' characters. You can also use this to parse
28 # cookies by changing the characters used in the second
29 # parameter (which defaults to '&;').
30 sub parse_query(Str $qs, $d = '&;') {
31 my %params = {};
32
33 # RAKUDO: Need to solve this with eval right now. [perl #63892]
34 my $regex = eval("/<[$d]>/");
35 for ($qs // '').split($regex) -> $p {
36 my ($k, $v) = unescape($p).split('=', 2);
37
38 given %params {
39 if my $cur = .{$k} {
40 if $cur ~~ List {
41 .{$k}.push($v.values);
42 }
43 else {
44 .{$k} = [$cur, $v];
45 }
46 }
47 else {
48 .{$k} = $v;
49 }
50 }
51 }
52
53 return %params;
54 }
55
56 sub build-query(Hash %params) is export {
57 return %params.pairs.map: {
58 my ($k, $v) = .kv;
59 $v ~~ List ?? build-query($v.map: { [$k, $^x] })
60 !! escape($k) ~ '=' ~ escape($v)
61 }.join('&');
62 }
63
64 # Escape ampersands, brackets and quotes to their HTML/XML entities.
65 sub escape-html($string) {
66 return (~$string).subst('&', '&amp;' )\
67 .subst('<', '&lt;' )\
68 .subst('>', '&gt;' )\
69 .subst(q['],'&#39;' )\
70 .subst('"', '&quot;');
71 }
72
73 sub select-best-encoding($available-encodings, $accept-encoding) {
74 # http://www.w3.org/Protocols/rfc2616/rfc2616-sec14.html
75
76 # XXX: This became too complicated for me without further knowledge.
77 # Punting for now.
78 }
79
80 # The recommended manner in which to implement a contexting application
81 # is to define a method #context in which a new Context is instantiated.
82 #
83 # As a Context is a glorified block, it is highly recommended that you
84 # define the contextual block within the application's operational scope.
85 class Context is Routine {
86 # TODO
87 }
88
89 # A case-insensitive Hash that preserves the original case of a
90 # header when set.
91 class HeaderHash is Hash {
92 # TODO
93 }
94
95 # Every standard HTTP code mapped to the appropriate message.
96 # Stolen from Mongrel.
97 my %HTTP_STATUS_CODES =
98 100 => 'Continue',
99 101 => 'Switching Protocols',
100 200 => 'OK',
101 201 => 'Created',
102 202 => 'Accepted',
103 203 => 'Non-Authoritative Information',
104 204 => 'No Content',
105 205 => 'Reset Content',
106 206 => 'Partial Content',
107 300 => 'Multiple Choices',
108 301 => 'Moved Permanently',
109 302 => 'Found',
110 303 => 'See Other',
111 304 => 'Not Modified',
112 305 => 'Use Proxy',
113 307 => 'Temporary Redirect',
114 400 => 'Bad Request',
115 401 => 'Unauthorized',
116 402 => 'Payment Required',
117 403 => 'Forbidden',
118 404 => 'Not Found',
119 405 => 'Method Not Allowed',
120 406 => 'Not Acceptable',
121 407 => 'Proxy Authentication Required',
122 408 => 'Request Timeout',
123 409 => 'Conflict',
124 410 => 'Gone',
125 411 => 'Length Required',
126 412 => 'Precondition Failed',
127 413 => 'Request Entity Too Large',
128 414 => 'Request-URI Too Large',
129 415 => 'Unsupported Media Type',
130 416 => 'Requested Range Not Satisfiable',
131 417 => 'Expectation Failed',
132 500 => 'Internal Server Error',
133 501 => 'Not Implemented',
134 502 => 'Bad Gateway',
135 503 => 'Service Unavailable',
136 504 => 'Gateway Timeout',
137 505 => 'HTTP Version Not Supported'
138 ;
139
140 # Responses with HTTP status codes that should not have an entity body
141 my %STATUS_WITH_NO_ENTITY_BODY = (100..199, 204, 304).map: { $_ => 1 };
142
143 # A multipart form data parser, adapted from IOWA.
144 #
145 # Usually, Web::Request.POST takes care of calling this.
146
147 module Multipart {
148 # TODO
149 }
150 }
Something went wrong with that request. Please try again.