package Net::HTTP10;

###########################################################################
# Low-Level HTTP/1.0 Cient
# HTTP-Version 1.0 only, no Transfer-Encoding, no chunking!
# Rolf Rost, 20.3.2011
# Read Binaries (Bytes) from HTTP-Socket with custom-callback()-function
###########################################################################
use strict;
use IO::Socket;
use warnings;
use Carp;

# Controls
my $read_headers = 0;
my $req_done     = 0;

# Constructor #############################################################
sub new{
	my $class    = shift;
	my $sockattr = shift;
	my $headers  = shift;
	my $body     = shift || undef; 

	# Default socket attribute
	my %socks = (
		port => 80,
		host => 'localhost',
		uri  => '/',
	);
	
	%socks = (%socks, %$sockattr) if ref $sockattr eq 'HASH';
	my $self = {};
	$self->{IO} = IO::Socket::INET->new(	
		PeerAddr => $socks{host},
		PeerPort => $socks{port},
		PeerHTTPVersion => '1.0',
		Proto    => 'tcp',
	) or die "No socket at $socks{host}:$socks{port}";

	$self->{socks} = \%socks;
	$self->{headers} = $headers if ref $headers eq 'HASH';

	# Request Method
	$socks{method} = 'GET';
	if($body){
		$socks{method} = 'POST',
		$self->{headers}->{'Content-Length'} = length $body,
		$self->{body} = $body
	}

	return bless $self, $class;
}

# at 2nd: fetch headers ###################################################
sub read_headers{
	die "No Request is done, take first: \$obj->request!" if not $req_done;
	return if $read_headers == 1;
	my $self = shift;
	my $socket = $self->{IO};
	my @h = ('',''); # Helper zum Erkennen der Leerzeile
	my $found = 0;
	while(read($socket, my $buffer, 1)){
		push @h, $buffer;
		# Leerzeile erkennen, Ende der Headers
		if( $h[-4].$h[-3].$h[-2].$h[-1] eq "\r\n\r\n"){
			$found = 1;	
			last;
		}
	}
	die "Can't detect CRLFCRLF" if not $found;
	
	my $header = join "", @h;
	my @headers = split /\n/, $header; 
	my $status = shift @headers; # HTTP/1.1 200 OK
	my ($ver, $code, @mess) = split /\s+/, $status;
	my $mess = join " ", @mess;
	my %ret = (); # hash for Response headers
	foreach my $line(@headers){
		my($k,$v) = split /:\s+/, $line;
		# strip trailing blancs and \r's
		$k = unpack "A*", $k;
		$v = unpack("A*", $v) if $v;
		next if not length($k);
		$ret{$k} = $v;
	}
	$read_headers = 1;
	return ($code, $mess, \%ret);
}

# at first: the request ###################################################
sub request{
	my $self = shift;
	my $socket = $self->{IO};
	print $socket "$self->{socks}->{method} $self->{socks}->{uri} HTTP/1.0\n";
	print $socket "Host: $self->{socks}->{host}\n";
	if(ref $self->{headers} eq 'HASH'){
		foreach my $h(keys %{$self->{headers}}){
			print  $socket "$h: $self->{headers}->{$h}\n";
		}
	}
	print $socket "Connection: Close\n\n";
	print $socket $self->{body} if $self->{body};
	$req_done = 1;
}

# at last: read socket via custom-callback()-function #####################
sub body_callback{
	die "No Request is done, take first: \$obj->request!" if not $req_done;
	my $self = shift;
	$self->read_headers if !$read_headers; # quiet headers
	croak "No Callback-Function given!" if ref $self->{socks}->{callback} ne 'CODE';
	$self->{socks}->{callback}($self->{IO}) if ref $self->{socks}->{callback} eq 'CODE';
}
###########################################################################
1; ########################################################################
###########################################################################

package main;

use strict;
use Data::Dump qw(dump);

binmode STDOUT;

my $sockattr = {
	'host' => 'rolfrost.de',
	'uri' => '/',
	'callback' => \&callbackfunction,
};

# Add headers
my $headers = {
#	'x-action' => 'do_it',
#	'Accept-Encoding' => 'gzip,deflate',
};


my $s = Net::HTTP10->new($sockattr, $headers);

$s->request;
my($code, $mess, $href) = $s->read_headers or die;
printf "Status: %s Mesg: %s \nHeaders: %s\n", $code, $mess, dump $href;
$s->body_callback;

sub callbackfunction{
	my $socket = shift;
	while(read $socket, my $buf, 794){
		print "$buf\n";
	}
}