1 |
package Sack::Server::HTTP; |
2 |
|
3 |
use warnings; |
4 |
use strict; |
5 |
|
6 |
my $debug = 1; |
7 |
|
8 |
use Data::Dump qw(dump); |
9 |
use URI::Escape; |
10 |
|
11 |
sub static {} |
12 |
|
13 |
sub request { |
14 |
my ( $client, $callback ) = @_; |
15 |
|
16 |
my $request = <$client>; |
17 |
|
18 |
warn "WEB << $request" if $debug; |
19 |
|
20 |
if ($request =~ m{^GET (/.*) HTTP/1.[01]}) { |
21 |
my $method = $1; |
22 |
my $param; |
23 |
if ( $method =~ s{\?(.+)}{} ) { |
24 |
foreach my $p ( split(/[&;]/, $1) ) { |
25 |
my ($n,$v) = split(/=/, $p, 2); |
26 |
$v = uri_unescape($v); |
27 |
if ( defined $param->{$n} ) { |
28 |
if ( ref $param->{$n} eq 'ARRAY' ) { |
29 |
push @{ $param->{$n} }, $v; |
30 |
} else { |
31 |
$param->{$n} = [ $param->{$n}, $v ]; |
32 |
} |
33 |
} else { |
34 |
$param->{$n} = $v; |
35 |
} |
36 |
} |
37 |
warn "WEB << param: ",dump( $param ) if $debug; |
38 |
} |
39 |
if ( my $path = static( $client,$1 ) ) { |
40 |
warn "WEB >> $path" if $debug; |
41 |
} elsif ( $callback->( $client, $method, $param ) ) { |
42 |
warn "WEB callback $method"; |
43 |
} else { |
44 |
print $client "HTTP/1.0 500 No method\r\n"; |
45 |
} |
46 |
close $client; |
47 |
} else { |
48 |
print $client "HTTP/1.0 501 Not implemented\r\n"; |
49 |
} |
50 |
} |
51 |
|
52 |
1; |