The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use warnings;
sub POE::Component::Server::SimpleHTTP::DEBUG () { 1 }
use POE qw(Component::Client::HTTP Component::Server::SimpleHTTP);
use POE::Component::Server::SimpleHTTP::Response;

# Stolen from POE::Wheel. This is static data, shared by all
my $current_id = 0;
my %active_identifiers;

sub _allocate_identifier {
  while (1) {
    last unless exists $active_identifiers{ ++$current_id };
  }
  return $active_identifiers{$current_id} = $current_id;
}

sub _free_identifier {
  my $id = shift;
  delete $active_identifiers{$id};
}

my $agent = 'proxy' . $$;
my $httpd = 'HTTPD' . $$;

POE::Component::Client::HTTP->spawn(
  Alias => $agent,
  Streaming => 4096,
);

POE::Component::Server::SimpleHTTP->new(
  KEEPALIVE     =>      1,
  ALIAS         =>      $httpd,
  PORT          =>      11111,
  PROXYMODE	 => 	 1,
  HANDLERS	 =>	 [
	{
          DIR           =>      '.*',
          SESSION       =>      'controller',
          EVENT         =>      'got_request',
	},
  ],
);

POE::Session->create(
   package_states => [
	main => [qw(_start got_request _got_stream _response)],
   ],
);

$poe_kernel->run();
exit 0;

sub _start {
  $poe_kernel->alias_set( 'controller' );
  return;
}

sub got_request {
  my($kernel,$heap,$request,$response,$dirmatch) = @_[KERNEL,HEAP,ARG0..ARG2];
  my $httpd = $_[SENDER]->get_heap();
  use Data::Dumper;
  $Data::Dumper::Indent=1;
  print Dumper( $response );
  # Check for errors
  if ( ! defined $request ) {
     $kernel->post( $httpd, 'DONE', $response );
     return;
  }

  $request->header('Connection', 'Keep-Alive');
  $request->remove_header('Accept-Encoding');

  # Let's see if it is a CONNECT request
  warn $request->as_string;
  warn $request->method, "\n";

  if ( $request->method eq 'CONNECT' ) {
     my $uri = $request->uri;
  #   warn $uri->authority, "\n";
     warn $uri->as_string, "\n";
  }

  $response->stream(
     session     => 'controller',
     event       => '_got_stream',
     dont_flush  => 1
  );

  my $id = _allocate_identifier();
  $kernel->post( 
    $agent, 
    'request',
    '_response',
    $request, 
    "$id",
  );

  $heap->{_requests}->{ $id } = $response;
  return;
}

sub _response {
  my ($kernel,$heap,$request_packet,$response_packet) = @_[KERNEL,HEAP,ARG0,ARG1];
  my $id = $request_packet->[1];
  my $resp = $heap->{_requests}->{ $id };
  
  my $response = _rebless( $resp, $response_packet->[0] );
  my $chunk    = $response_packet->[1];

  warn $response->headers_as_string, "\n";

  if ( $chunk ) {
    $response->content( $chunk );
    $kernel->post( $httpd, 'STREAM', $response );
  }
  else {
    $kernel->post( $httpd, 'DONE', $response );
  }

  return;
}

sub _got_stream {
  my ($kernel,$heap,$response) = @_[KERNEL,HEAP,ARG0];
  return;
}

sub _rebless {
  my ($orig,$new) = @_;
  $new->{$_} = $orig->{$_} for grep { exists $orig->{$_} }
    qw(_WHEEL connection STREAM_SESSION STREAM DONT_FLUSH IS_STREAMING);
  bless $new, 'POE::Component::Server::SimpleHTTP::Response';
  return $new;
}