view release on metacpan or  search on metacpan

lib/AnyEvent/REST/Server.pm  view on Meta::CPAN

    507 => 'Insufficient Storage',
    509 => 'Bandwidth Limit Exceeded',
    510 => 'Not Extended',
    511 => 'Network Authentication Required',
};

sub new {
    my $invocant = shift;
    my $class = ref($invocant) || $invocant;

    my $self = { @_ };
    bless $self, $class;

    return $self;
}

sub register {
    my $self = shift;
    my $regs = { @_ };

    while (my ($url_regex, $callback) = each %$regs) {
        push @{$self->{urls}}, $url_regex;
        $self->{callback}{$url_regex} = $callback;
    }
}

sub start {
    my $self = shift;

    $log->debug("Setting up AnyEvent::REST::Server on $self->{host}:$self->{port}.");

    $self->{tcp_server} = tcp_server(
        $self->{host},
        $self->{port},
        sub {
            my ($fh, $host, $port) = @_;
            my $id = "$host:$port";

            $log->debug("$id connected.");

            $self->{connections}{$id}{handle} = AnyEvent::Handle->new(
                fh => $fh,
                poll => 'r',
                on_error => sub {
                    my ($handle, $fatal, $message) = @_;
                    $handle->destroy;
                    delete $self->{connections}{$id};
                    $log->debug("$id disconnected.");
                },
            );

            $self->read_http_command($id);
        }
    );
}

sub read_http_command {
    my ($self, $id) = @_;

    $self->{connections}{$id}{handle}->push_read(
        regex => qr<(GET|POST|PUT|DELETE)\s+([^ ]+)\s+HTTP/(\d.\d)\r?\n>,
        sub {
            my ($handle, $data) = @_;
            $self->{connections}{$id}{command} = $1;
            $self->{connections}{$id}{location} = $2;
            $self->{connections}{$id}{version} = $3;

            if ($self->{connections}{$id}{location} =~ /(.*)\/$/) {
                $self->{connections}{$id}{location} = $1;
            }

            if ($self->can_handle("$self->{connections}{$id}{command} $self->{connections}{$id}{location}")) {
                $self->read_http_header($id);
            }
            else {
                $self->send_not_found($id);
            }
        }
    );
}

sub read_http_header {
    my ($self, $id) = @_;

    $self->{connections}{$id}{handle}->push_read(
        line => qr<\r?\n\r?\n>,
        sub {
            my ($handle, $line) = @_;
            my @header_lines = split(/\r?\n/, $line);

            foreach (@header_lines) {
                my ($key, $value) = split ':';
                $self->{connections}{$id}{header}{$key} = $value;
            }

            $self->read_http_body($id);
        }
    );
}

sub read_http_body {
    my ($self, $id) = @_;

    my $content_length = $self->{connections}{$id}{header}{'Content-Length'};

    if (defined $content_length && int($content_length)) {
        $self->{connections}{$id}{handle}->push_read(
            chunk => int($content_length),
            sub {
                my ($handle, $body) = @_;
                $self->{connections}{$id}{body} = $body;

            }
        );
    }

    my $command = $self->{connections}{$id}{command};
    my $location = $self->{connections}{$id}{location};
    $log->debug("$id HTTP $command $location");
    $self->request($id, "$command $location");