Sack/Server/HTTP.pm

package Sack::Server::HTTP;

use warnings;
use strict;

my $debug = 1;

use Data::Dump qw(dump);
use URI::Escape;

sub static {}

sub request {
        my ( $client, $callback ) = @_;

        my $request = <$client>;

        warn "WEB << $request" if $debug;

        if ($request =~ m{^GET (/.*) HTTP/1.[01]}) {
                my $method = $1;
                my $param;
                if ( $method =~ s{\?(.+)}{} ) {
                        foreach my $p ( split(/[&;]/, $1) ) {
                                my ($n,$v) = split(/=/, $p, 2);
                                $v = uri_unescape($v);
                                if ( defined $param->{$n} ) {
                                        if ( ref $param->{$n} eq 'ARRAY' ) {
                                                push @{ $param->{$n} }, $v;
                                        } else {
                                                $param->{$n} = [ $param->{$n}, $v ];
                                        }
                                } else {
                                        $param->{$n} = $v;
                                }
                        }
                        warn "WEB << param: ",dump( $param ) if $debug;
                }
                if ( my $path = static( $client,$1 ) ) {
                        warn "WEB >> $path" if $debug;
                } elsif ( $callback->( $client, $method, $param ) ) {
                        warn "WEB callback $method";
                } else {
                        print $client "HTTP/1.0 500 No method\r\n";
                }
                close $client;
        } else {
                print $client "HTTP/1.0 501 Not implemented\r\n";
        }
}

1;
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;