Unnamed

#!/usr/bin/perl -w
sub hook_xmlresponse {
	  use HTTP::Negotiate qw(choose);
	  use HTTP::Headers;
	  my ($self, $input) = @_;
	  my $cwd = '/home/benjamin/www/benjaminhawkeslewis.com/www/xhtml-dev';
	  # If the client has not explicitly mentioned application/xhtml+xml,
	  # insert a q of 0.
	  my $accept = $self->client->headers_in()->header("accept");	    
	  $self->log(LOGDEBUG, " Accept header: " . $accept);
	  unless ($accept =~ /.*application\/xhtml\+xml.*/) {
          $self->client->headers_in()->header("accept",$accept . ",application\/xhtml+xml;q=0");
	      my $modified_accept = $self->client->headers_in()->header("accept");	    
	      $self->log(LOGDEBUG, " Changed Accept header to reject application/xhtml+xml: " . $modified_accept);			  
	  }
		
	  my $header_str = $self->client->headers_in()->to_string_ref;
	  $header_str = $$header_str;
	  $self->log(LOGDEBUG, " Header string:" . $header_str);
	  $header_str =~ s/^GET.*?\r\n//;
	  my @request_headers;
	  $self->log(LOGDEBUG, " Header string for parsing:" . $header_str);
  	  sub parse_header_string { 
		  # Following code borrowed from HTTP::Message
		  my $str = @_;
	  	  my @hdr;
	      while (1) {
	 	      if ($str =~ s/^([^\s:]+)[ \t]*: ?(.*)\n?//) {
		      push(@hdr, $1, $2);
		      $hdr[-1] =~ s/\r\z//;
			  } elsif (@hdr && $str =~ s/^([ \t].*)\n?//) {
				  $hdr[-1] .= "\n$1";
				  $hdr[-1] =~ s/\r\z//;
			  } else {
				  $str =~ s/^\r?\n//;
				  last;
			  }
		  }
		  return HTTP::Headers->new(@hdr);
      }
	 
	  my $request_headers = parse_header_string($header_str);
	  my $parsed_accept = $request_headers->header("Accept");
	  $self->log(LOGDEBUG, " Testing variants against Accept header: " . $parsed_accept);

	  #      ID			QS		Content-Type	Encoding	Char-Set	Lang	Size
	  my $variants =
	       [[1,	1.0,	'application/xhtml+xml',	undef,	'utf-8',	'en',	undef],
	       	[2,	0.9,	'text/html',	undef,	'utf-8',	'en',	undef],
	       ];
	  my $best_variant = choose($variants, $request_headers);
	  my $out;
	  
	  $self->log(LOGDEBUG, " Best variant: " . $best_variant);
	  if ($best_variant == 2) {
	  	  $self->log(LOGDEBUG, " Serving text/html.");
		  my $html4_stylesheet = $cwd . '/xsl/xhtml1.1-to-html4.01-strict.xsl';
		  $out = $input->transform(XSLT($html4_stylesheet));
	  	  return OK, $out;
	  } else {
	  	  $self->log(LOGDEBUG, " Serving application/xhtml+xml.");
          $out = $input;
	      $self->client->headers_out()->mime_type("application/xhtml+xml");
		  $self->client->headers_out()->header("Content-Type", "application/html+xml");
		  #$self->client->send_http_headers;
	 	  return OK, $out;
      }
	  # TODO Handle doesn't want any variant
}

# RESULTS:

192.168.0.4:3577 L6 Connection from 192.168.0.4:3577
192.168.0.4:3577 L6 uri_to_file uri_translation translate: /www/xhtml/
192.168.0.4:3577 L7 uri_to_file uri_translation Translated / to /home/benjamin/www/benjaminhawkeslewis.com/www/xhtml-dev/public/index.xml (request uri: /www/xhtml/, path info: )
192.168.0.4:3577 L7 serve_xml xmlresponse  Accept header: text/html, application/xml;q=0.9, application/xhtml+xml, image/png, image/jpeg, image/gif, image/x-xbitmap, */*;q=0.1
192.168.0.4:3577 L7 serve_xml xmlresponse  Header string:GET /www/xhtml/ HTTP/1.1
User-Agent: Opera/9.01 (Windows NT 5.1; U; en)
Host: 192.168.0.2:8000
Accept: text/html, application/xml;q=0.9, application/xhtml+xml, image/png, image/jpeg, image/gif, image/x-xbitmap, */*;q=0.1
Accept-Language: en-GB,en;q=0.9
Accept-Charset: iso-8859-1, utf-8, utf-16, *;q=0.1
Accept-Encoding: deflate, gzip, x-gzip, identity, *;q=0
Pragma: no-cache
Cache-Control: no-cache
Connection: Keep-Alive, TE
TE: deflate, gzip, chunked, identity, trailers


192.168.0.4:3577 L7 serve_xml xmlresponse  Header string for parsing:User-Agent: Opera/9.01 (Windows NT 5.1; U; en)
Host: 192.168.0.2:8000
Accept: text/html, application/xml;q=0.9, application/xhtml+xml, image/png, image/jpeg, image/gif, image/x-xbitmap, */*;q=0.1
Accept-Language: en-GB,en;q=0.9
Accept-Charset: iso-8859-1, utf-8, utf-16, *;q=0.1
Accept-Encoding: deflate, gzip, x-gzip, identity, *;q=0
Pragma: no-cache
Cache-Control: no-cache
Connection: Keep-Alive, TE
TE: deflate, gzip, chunked, identity, trailers


Use of uninitialized value in concatenation (.) or string at /home/benjamin/www/benjaminhawkeslewis.com/www/xhtml-dev/plugins/serve_xml line 44.
192.168.0.4:3577 L7 serve_xml xmlresponse  Testing variants against Accept header:
192.168.0.4:3577 L7 serve_xml xmlresponse  Best variant: 1
192.168.0.4:3577 L7 serve_xml xmlresponse  Serving application/xhtml+xml.
192.168.0.4:3577 L7 Response sent