Sack/Server/HTTP.pm

package Sack::Server::HTTP;

use warnings;
use strict;

my $debug = 1;

use Data::Dump qw(dump);

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