AnyEvent-REST-Server

 view release on metacpan or  search on metacpan

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

    );
}

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");

    $self->cleanup_restart($id);
}

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

    $self->{connections}{$id}{handle}->rbuf = "";
    $self->read_http_command($id);
}

sub can_handle {
    my ($self, $url) = @_;

    foreach my $url_regex (@{$self->{urls}}) {
        return 1 if ($url =~ m/^$url_regex$/);
    }

    return 0;
}

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

    foreach my $url_regex (@{$self->{urls}}) {
        if ($url =~ m/^$url_regex$/) {
            $self->send($id, &{$self->{callback}{$url_regex}}($url, %+));
        }
    }
}

sub send {
    my ($self, $id, $code, $custom_header, $body) = @_;

    my $HTTP_EOL = "\r\n";

    my $header = {
        'Cache-Control' => 'max-age=0, no-cache, must-revalidate, proxy-revalidate, private',
        'Pragma' => 'no-cache',
        'Content-Type' => 'application/octet-stream',
        %$custom_header,
        'Content-Length' => length($body),
        'Server' => $self->{name},
    };

    my $response = 'HTTP/'.$self->{connections}{$id}{version}.' '.$code.' '.$HTTP_CODE_TEXT->{$code}.$HTTP_EOL;
    $response .= "$_: $header->{$_}$HTTP_EOL" foreach (keys %$header);
    $response .= $HTTP_EOL;
    $response .= $body if $body;

    $self->{connections}{$id}{handle}->push_write($response);
}

sub send_not_found {
    shift->send(shift, 404, {}, '');
}

1;



( run in 2.821 seconds using v1.01-cache-2.11-cpan-ceb78f64989 )