view release on metacpan or  search on metacpan

ProxyStuff.pm  view on Meta::CPAN

package Apache::ProxyStuff;

use strict;
use vars qw(@ISA $VERSION);
use Apache::Constants qw(:common);
use Apache::Log;
use Apache::Table;
use HTML::TokeParser;
use LWP::UserAgent;
use Data::Dumper;

@ISA = qw(LWP::UserAgent);
$VERSION = '0.10';

my $UA = __PACKAGE__->new;
$UA->agent(join "/", __PACKAGE__, $VERSION);

# Override Methods
sub redirect_ok {return 0}

# Helper Subs
sub set_headers {
  my ($req, %headers) = @_;
  foreach my $header (keys %headers) {
		next if $header eq 'Connection'; # Don't want to pass Keep-Alive
		$req->push_header($header => $headers{$header});
  } # End foreach

  # Set REMOTE_ADDR, REMOTE_HOST, REMOTE_USER
  $req->push_header('REMOTE_ADDR' => $ENV{'REMOTE_ADDR'});
  $req->push_header('REMOTE_HOST' => $ENV{'REMOTE_HOST'} || $ENV{'REMOTE_ADDR'});
  $req->push_header('REMOTE_USER' => $ENV{'REMOTE_USER'});
  return $req;
} # End set_headers

sub open_head {
	my ($token, $r, $meta_description, $meta_content) = @_;

	# Print tag
	print qq($token->[-1]\n);

  # Print meta tags
	print $meta_description;
	print $meta_content;
} # End open_head()

sub open_body {
  my ($token, $r, $header, $body_attributes) = @_;
  
  # Print body tag
  print q(<BODY);
  
  # Replace existing body attributes with new ones if necessary
  if ($body_attributes) {
		foreach my $pair (split /\s+/, $body_attributes) {
			my ($attr, $value) = split /=/, $pair;
			$token->[2]->{lc $attr} = $value; # Keys are lowercase
		} # End foreach
  } # End if

  # Print attributes
  my $atts = join(' ', map({"$_=$token->[2]->{$_}"} keys %{$token->[2]}));
  print qq( $atts) if $atts;
  
  # Close body tag
  print qq(>);

  # Send the header
  print $header;
} # End open_body()