1package AnyEvent::HTTPD::HTTPServer;
2use common::sense;
3use Scalar::Util qw/weaken/;
4use Object::Event;
5use AnyEvent::Handle;
6use AnyEvent::Socket;
7
8use AnyEvent::HTTPD::HTTPConnection;
9
10our @ISA = qw/Object::Event/;
11
12=head1 NAME
13
14AnyEvent::HTTPD::HTTPServer - A simple and plain http server
15
16=head1 DESCRIPTION
17
18This class handles incoming TCP connections for HTTP clients.
19It's used by L<AnyEvent::HTTPD> to do it's job.
20
21It has no public interface yet.
22
23=head1 COPYRIGHT & LICENSE
24
25Copyright 2008-2011 Robin Redeker, all rights reserved.
26
27This program is free software; you can redistribute it and/or modify it
28under the same terms as Perl itself.
29
30=cut
31
32sub new {
33   my $this  = shift;
34   my $class = ref($this) || $this;
35   my $self  = {
36      connection_class => "AnyEvent::HTTPD::HTTPConnection",
37      allowed_methods  => [ qw/GET HEAD POST/ ],
38      @_,
39   };
40   bless $self, $class;
41
42   my $rself = $self;
43
44   weaken $self;
45
46   $self->{srv} =
47      tcp_server $self->{host}, $self->{port}, sub {
48         my ($fh, $host, $port) = @_;
49
50         unless ($fh) {
51            $self->event (error => "couldn't accept client: $!");
52            return;
53         }
54
55         $self->accept_connection ($fh, $host, $port);
56      }, sub {
57         my ($fh, $host, $port) = @_;
58         $self->{real_port} = $port;
59         $self->{real_host} = $host;
60         return $self->{backlog};
61      };
62
63   return $self
64}
65
66sub port { $_[0]->{real_port} }
67
68sub host { $_[0]->{real_host} }
69
70sub allowed_methods { $_[0]->{allowed_methods} }
71
72sub accept_connection {
73   my ($self, $fh, $h, $p) = @_;
74
75   my $htc =
76      $self->{connection_class}->new (
77         fh => $fh,
78         request_timeout => $self->{request_timeout},
79         allowed_methods => $self->{allowed_methods},
80         ssl => $self->{ssl},
81         host => $h,
82         port => $p);
83
84   $self->{handles}->{$htc} = $htc;
85
86   weaken $self;
87
88   $htc->reg_cb (disconnect => sub {
89      if (defined $self) {
90         delete $self->{handles}->{$_[0]};
91         $self->event (disconnect => $_[0], $_[1]);
92      }
93   });
94
95   $self->event (connect => $htc);
96}
97
981;
99