view release on metacpan or  search on metacpan

ProxyStuff.pm  view on Meta::CPAN

			$saw_footer++;
	  } # End elsif
      
		# Handle <A HREF>
		elsif ($add_host2href and $token->[0] eq 'S' and $token->[1] eq 'a' and
					 $token->[2]->{'href'}) {a_href($token, $r, $add_host2href)}

		# Handle <IMG SRC>
		elsif ($add_host2img_src and $token->[0] eq 'S' and $token->[1] eq 'img' and
					 $token->[2]->{'src'}) {img_src($token, $r, $add_host2img_src)}
      
		# Handle <FORM ACTION>
		elsif ($add_host2form_action and $token->[0] eq 'S' and 
					 $token->[1] eq 'form' and $token->[2]->{'action'}) {form_action($token, $r, 
																																					 $add_host2form_action)}
	
		# Handle comments because TokeParser doesn't save the original text for them
		elsif ($token->[0] eq 'C') {print qq(<!-- $token->[-1] -->)}
		
		# Ditto for declarations
		elsif ($token->[0] eq 'D') {print qq(<!$token->[-1]>)}
		
		# Handle text, I think it's different in newer versions of HTML::TokeParser
		elsif ($token->[0] eq 'T') {print qq($token->[1])}

		# Handle everything else
		else { print $token->[-1]}
      
  } # End while
} # End process_text()


# Handler
sub handler {

  my $r = shift;

  # Get configuration
  my $header_file = $r->dir_config('HeaderFile');
  my $footer_file = $r->dir_config('FooterFile');
  my $proxy_prefix = $r->dir_config('ProxyPrefix');
	my $meta_description = qq(<META NAME="description" CONTENT=") . $r->dir_config('MetaDescription') .
                         qq(">\n);
	my $meta_content = qq(<META NAME="content" CONTENT=") . $r->dir_config('MetaContent') . qq(">\n);
  my $body_attributes = $r->dir_config('BodyAttributes');
  my $strip_host = $r->dir_config('StripHost');
  my $add_host2href = $r->dir_config('AddHost2AHref');
  my $add_host2img_src = $r->dir_config('AddHost2ImgSrc');
  my $add_host2form_action = $r->dir_config('AddHost2FormAction');

  # Mangle the url for the file as needed
  my ($null, $base, $uri);
  if ($strip_host) {($null, $base, $uri) = split /\//, $r->uri, 3}
  else {$uri = $r->uri}
  $uri =~ s/^\///; # Remove leading slashes
  my $file_uri = join '/', $proxy_prefix, $uri;
  $file_uri .= q(?) . $r->args if $r->args;
  $r->log->debug("URI: $file_uri");

  # Build the request
  my $req = new HTTP::Request($r->method => $file_uri);

  # Set headers
  $req = set_headers($req, $r->headers_in);

  # Copy POST data, if any
  if ($r->method eq 'POST') {
	my $len = $r->header_in('Content-length');
	my $buf;
	$r->read($buf, $len);
	$req->content($buf);
  } # End if
  
  # Run the request
  my $res = $UA->request($req);

  if ($res->is_redirect) {
		my $location = $res->header('Location');
		my ($host) = ($location =~ m!^([^/]+//[^/]+)/!);
		if ($host eq $proxy_prefix) {
			my $hostname = $r->server->server_hostname;
			$location =~ s!//([^/]+)/!//$hostname/!;
			$res->header('Location' => $location);
		} # End if
  } # End if

  # Handle all other headers
  # $res->scan(sub {$r->header_out(@_);});
  $res->scan(sub {$r->headers_out->add(@_);}); # Use this one to handle multiple headers of same name

  # Handle special headers
  $r->content_type($res->header('Content-type'));
  $r->status($res->code);
  $r->status_line($res->status_line);

  # HEAD request?
  if ($r->header_only) {
      $r->send_http_header;
      return OK;
  } # End if

  # Get the content
  my $content = $res->content_ref;

  # If it's text
  if ($r->content_type =~ /^text/) {

		# Get the header and footer
		my $header_req = new HTTP::Request('GET' => $header_file);
		my $footer_req = new HTTP::Request('GET' => $footer_file);
		$header_req = set_headers($header_req, $r->headers_in);
		$footer_req = set_headers($footer_req, $r->headers_in);
		$header_req->push_header('REAL_URI' => $file_uri); # Somebody might need the real page
		$footer_req->push_header('REAL_URI' => $file_uri); # Ditto
		$header_req->push_header('ORIG_URI' => $r->uri); # Somebody might need the real page
		$footer_req->push_header('ORIG_URI' => $r->uri); # Ditto
		my $header_res = $UA->request($header_req);
		my $footer_res = $UA->request($footer_req);

		# Adjust the content length to include the lenght of the header and footer
		my $length = length($header_res->content) + length($footer_res->content) + length($res->content) +
			length($body_attributes) + length($meta_description) + length($meta_content);
		$r->header_out('Content-length' => $length);
		$r->send_http_header;
		process_text($content, $r, $header_res->content, $footer_res->content, $meta_description, 
								 $meta_content, $body_attributes, $add_host2href, $add_host2img_src, 
								 $add_host2form_action);
  } # End if
  
  else {$r->send_http_header; print $$content}
	
  return OK;

} # End handler()

1;

__END__

=head1 NAME

Apache::ProxyStuff - mod_perl header/footer/proxy module

=head1 SYNOPSIS

  <Location /foo>
   SetHandler      perl-script
   PerlHandler     Apache::ProxyStuff
   PerlSetVar      HeaderFile      http://www.bar.com:81/includes/header.html
   PerlSetVar      FooterFile      http://www.bar.com:81/includes/footer.html
   PerlSetVar      MetaDescription "some description"
   PetlSetVar      MetaContent     "some content""
   PerlSetVar      BodyAttributes  "TOPMARGIN=0 LEFTMARGIN=0 MARGINHEIGHT=0 MARGINWIDTH=0"
   PerlSetVar      ProxyPrefix     http://www.foo.com
  </Location>

=head1 DESCRIPTION

Apache::ProxyStuff is module for adding headers and footers to content proxied from other web servers. Rather than sandwiching the content between the header and footer it "stuffs" the header and footer into their correct places in the content -- hea...

ProxyStuff also allows you to add meta tags to the <HEAD> section, attributes to the <BODY> tag and manipulate links, image refs and form actions as needed.

=head1 PARAMETERS

=over 4

=item * HeaderFile

HeaderFile specifies the URL of an HTML page that will be used as the header for proxied content. It will be added after the first <BODY> tag.