#!/usr/bin/perl -w

use strict;
use IO::Socket::INET;
$|++;
my $url = "http://ftp.blizzard.com/pub/war3/maps/(4)iceforge.zip";
my $DEBUG = 1;
my $CRLF = "\015\012\015\012";
my ( $code, $type, $length, $sock, $data_buffer, $location ) = init_download( $url );
open my $fh, '>c:/tmp.zip' or die $!;
binmode $fh;
print $fh $data_buffer;
download( $fh, $sock, $filename, length($data_buffer), $length );  

sub download {
    my ( $fh, $sock, $filename, $got_so_far, $length ) = @_;
    my $buffer;
    print "Got: $got_so_far\n" if $DEBUG;
    #
    #  This will hang on a read() works with sysread()
    #
    while ( ($got_so_far < $length) and sysread( $sock, $buffer, 8192 ) ){
        print $fh $buffer; 
        $got_so_far += length $buffer;
        print "Got: $got_so_far\n" if $DEBUG;
        #write_lockfile( $filename, $got_so_far );
    }
    close $fh;
    $sock->close;
    print "Wanted: $length\nGot $got_so_far\n";
    unless ( $length == $got_so_far ) {
        die "Expected $length bytes but only got $got_so_far" ;
    } 
}

sub init_download {
    my ( $url ) = @_;
    ui_network_error( "Invalid URL $url\n" ) unless $url =~ m!^http://([^/:\@]+)(?::(\d+))?(/\S*)?$!;
	my $host = $1;
	my $port = $2 || 80;
	my $path = $3;
	$path = "/" unless defined $path;
    my $sock = IO::Socket::INET->new( PeerAddr => $host, Proto => 'tcp', PeerPort => $port )
      or ui_network_error( 'Could not connect socket', $url );
    $sock->autoflush;
    print $sock "GET $url HTTP/1.0
Host: localhost
Accept: */*
Connection: Keep-Alive
User-Agent: Mozilla/4.0 (compatible; MSIE 4.5; Windows 98; )
$CRLF";
    my ($header, $content, $buffer);
    while (sysread( $sock, $buffer, 8192 )){
        $content .= $buffer;
        if ( (my $index = (index $content, $CRLF)) > 0 ) {
            $header  = substr $content, 0, $index;      
            $content = substr $content, $index+ 4;
          last;
        }
    }
    $header =~ s/\015\012/\n/g;
    # unfold the header
    $header =~ s/\n\s+/ /g;
    my ($length) = $header =~ m/^Content-Length:\s*(\d+)/im;
    my ($type)   = $header =~ m/^Content-Type:\s*([^\r\n]+)/im;
    my ($loc)    = $header =~ m/^Location:\s*([^\r\n]+)/im;
    my ($code)   = $header =~ m!^HTTP/\d\.\d[^\d]+(\d+)!i;
    print "$header\n----\nWant: $length\n";
  return ( $code, $type, $length, $sock, $content, $loc )
}

sub ui_network_error{ die shift }