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\n" 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);
                                $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 $path";
                } 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
10			sub static {}
11
12			sub request {
13			my ( $client, $callback ) = @_;
14
15			my $request = <$client>;
16
17			warn "WEB << $request\n" 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			$param->{$n} = $v;
26			}
27			warn "WEB << param: ",dump( $param ) if $debug;
28			}
29			if ( my $path = static( $client,$1 ) ) {
30			warn "WEB >> $path" if $debug;
31			} elsif ( $callback->( $client, $method, $param ) ) {
32			warn "WEB callback $path";
33			} else {
34			print $client "HTTP/1.0 500 No method\r\n";
35			}
36			close $client;
37			} else {
38			print $client "HTTP/1.0 501 Not implemented\r\n";
39			}
40			}
41
42			1;