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	dpavlin	210	package Sack::Server::HTTP;
2
3			use warnings;
4			use strict;
5
6			my $debug = 1;
7
8			use Data::Dump qw(dump);
9	dpavlin	251	use URI::Escape;
10	dpavlin	210
11			sub static {}
12
13			sub request {
14			my ( $client, $callback ) = @_;
15
16			my $request = <$client>;
17
18	dpavlin	216	warn "WEB << $request" if $debug;
19	dpavlin	210
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	dpavlin	251	$v = uri_unescape($v);
27	dpavlin	245	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	dpavlin	210	}
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	dpavlin	216	warn "WEB callback $method";
43	dpavlin	210	} 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;