view release on metacpan or  search on metacpan

lib/Apache2/Proxy.pm  view on Meta::CPAN

    # rflush() flushes the headers to the client
    # thanks to gozer's mod_perl for speed presentation
    $r->rflush();

    $r->print( $res->content );

    return Apache2::Const::OK;
}

sub threeohone {
    my ( $class, $r, $res ) = @_;

    my $content_type = $res->content_type;
    $r->content_type($content_type) if $content_type;

    # translate the headers from the remote response to the proxy response
    my $translated = $class->set_response_headers( $r, $res );

    # do not change this line
    return Apache2::Const::HTTP_MOVED_PERMANENTLY;
}

# 302, 303, 307
sub redirect {
    my ( $class, $r, $res ) = @_;

    # translate the headers from the remote response to the proxy response
    my $translated = $class->set_response_headers( $r, $res );

    # do not change this line
    return Apache2::Const::REDIRECT;
}

sub threeohfour {
    my ( $class, $r, $res ) = @_;

    # set the status line
    $r->status( $res->code );

    # translate the headers from the remote response to the proxy response
    my $translated = $class->set_response_headers( $r, $res );

    # do not change this line
    return Apache2::Const::OK;
}

# the big dog
sub twohundred {
    my ( $class, $r, $response, $subref ) = @_;

    my $url = $r->pnotes('url');

    if ( $response->is_html ) {

        #$Cache->add_known_html( $url => $response->content_type );

    }
    else {

        #$Cache->add_known_not_html( $url => $response->content_type );
    }

    $r->log->debug( "$$ 200 for $url, length "
          . length( $response->decoded_content )
          . " bytes" )
      if DEBUG;

    my $response_content_ref = \$response->decoded_content;

    # set the status line
    $r->status_line( $response->status_line );
    $r->log->debug( "$$ status line is " . $response->status_line )
      if DEBUG;

    # set the response headers
    my $set_ok =
      $class->set_twohundred_response_headers( $r, $response,
        $response_content_ref );

    if (VERBOSE_DEBUG) {
        $r->log->debug( "$$ Response content: " . $$response_content_ref );
    }

    # rflush() flushes the headers to the client
    # thanks to gozer's mod_perl for speed presentation
    $r->rflush();

    my $bytes_sent = $r->print($$response_content_ref);
    $r->log->debug("$$ bytes sent: $bytes_sent") if DEBUG;

    return Apache2::Const::DONE;
}

sub get {
    my ( $class, $args_ref ) = @_;
    unless ( $args_ref->{url} ) {
        warn("$$ no url passed, returning");
        return;
    }
    my $url  = $args_ref->{url};
    my $host = $args_ref->{host} || $args_ref->{headers}->{Host} || 'localhost';
    my $port = $args_ref->{port} || 80;

    $url = URI->new($url) or die("Unable to parse url '$url'.");

    my $headers = $args_ref->{headers} || \%Headers;

    # convert headers to array-ref if a hash-ref is passed
    $headers = [%$headers] if ( ref $headers eq 'HASH' );

    my $http = Net::HTTP->new(
        Host     => $url->host,
        PeerAddr => $host,
        PeerPort => $port
    ) || die $@;

    # set keep alive
    $http->keep_alive(1);

    # reinforce the point (Net::HTTP adds PeerPort to host during