view release on metacpan or  search on metacpan

Gateway.pm  view on Meta::CPAN

	    # Increment index for next time round.
	    $mux_site->{START_INDEX} = $idx < $last ? ++$idx : 0;
	}
	else {
	    $self->{SITE} = $site[$i];
	    $self->try_URI($i < $#site || $allow_last_site_abort);
	}

	# We can exit if the last attempt succeeded or if the client
	# is no longer talking to us.
	return if(!HTTP::Status::is_error($r->status)
		  || $r->connection->aborted);
    }
}

# Set up the user agent for this particular request.
sub _init_ua($) {
    my $self = shift;
    my $r = $self->{REQUEST};
    my $ua = $self->{UA};
    $ua->from($r->server->server_admin);
    $ua->agent($r->header_in('User-Agent'));
    $ua->timeout($self->location_config->{TIMEOUT});
    return 1;			# succeeded
}

# Set $self->{GW_PATH} to the portion of the path relative to
# GatewayRoot.  This is also the path which is appended to the URIs of
# the upstream servers.
sub _init_path($) {
    my $self = shift;
    my $r = $self->{REQUEST};

    # epath = $gw_root . $gw_path
    my $gw_root = $self->location_config->{ROOT};
    my ($gw_path) = $r->parsed_uri->path =~ /^\Q$gw_root\E(.*)/;

    unless(defined $gw_path) {	# error
	$r->log_error($r->uri . ' does not begin with ' . $gw_root);
	$r->status(HTTP::Status::RC_INTERNAL_SERVER_ERROR);
	return;
    }

    $self->{GW_PATH} = $gw_path; # succeeded
    return 1;
}

sub _init_request($) {
    my $self = shift;
    $self->_init_config_file	or return;
    $self->_init_ua		or return;
    $self->_init_path		or return;
    return 1;			# succeeded
}

=item $gw->site_list

Get the list of sites to try for this request.  Can be overridden to
customize the list of sites to try.

By default, this method looks through the LocationMatch sections in
the GatewayConfig file in order and returns the sites in the first
section matched.

=cut

sub site_list($) {
    my $self = shift;
    my $location_conf = $self->location_config;
    my $gw_path = $self->{GW_PATH};
    foreach my $entry (@{$location_conf->{LOCATION}}) {
	if($gw_path =~ /$entry->{PATTERN}/) {
	    return @{$entry->{SITE}};
	}
    }
    return;
}

=item $gw->send_request( [$r] )

Send the Apache request to the upstream server.  Optionally sets it
first.

=cut

sub send_request($;$) {
    my $self = shift;
    if (@_) { $self->{REQUEST} = shift }
    $self->_init_request or return;
    $self->try_sites(0, $self->site_list);
    return 1;			# succeeded
}

sub handler {
    if(! defined $gw) {
	$gw = new Apache::Gateway;
    }

    $gw->send_request(shift);

    return 0;
}

1;

__END__

=back

=head1 CAVEATS

C<Apache::Gateway> is a big, complicated module that loads many other
modules.  As such, it pushes C<mod_perl> to its limits, especially
when used with DSO/APXS.

The current version of C<LWP> (5.35) only supports If-Modified-Since
for file and ftp URLs.  Thus, gatewaying to ftp servers will actually
be better than gatewaying to http servers for cached responses.

=head1 BUGS