#########################################
## http://www.jmbsoft.com/policies.php ##
#########################################

package HTTP;

use Socket;

$L_CONNECT_TIMEOUT = 'Connection timeout.';
$L_READ_TIMEOUT    = 'Read timeout.';
$L_SEND_TIMEOUT    = 'Send timeout.';
$L_REDIRECTS       = 'Too many redirects.';
$L_INVALID_URL     = 'Invalid URL.';
$L_READ_ERROR      = 'Read error';
$L_RESOLVE         = 'Could not resolve hostname';


$SIG{ALRM}   = sub { die "timeout" };
$CRLF        = "\015\012";
$HIGHRES     = undef;

eval("use Time::HiRes;");

if( !$@ )
{
    $HIGHRES = 1;
}


sub new
{
    my $type   = shift;
    my %params = @_;
    my $self   = {};

    $self->{'URL'}       = $params{'URL'};
    $self->{'RedirOK'}   = $params{'RedirOK'} || undef;
    $self->{'Referrer'}  = $params{'Referrer'} ? "Referer: $params{'Referrer'}$CRLF" : undef;
    $self->{'Proxy'}     = $params{'Proxy'} || undef;
    $self->{'Agent'}     = $params{'Agent'} || 'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)';
    $self->{'Redirects'} = 0;

    bless($self);

    return $self;
}



sub GET
{
    my $self = shift;

    $self->{'Method'} = 'GET';

    if( $self->{'RedirOK'} )
    {
        return $self->GETRedirect();
    }
    else
    {
        return $self->GETNoRedirect();
    }
}



sub HEAD
{
    my $self = shift;

    $self->{'Method'} = 'HEAD';

    return $self->GETNoRedirect();
}


sub GETNoRedirect
{
    my $self = shift;
    

    # Attempt to parse URL into it's pieces
    if( !$self->parseURL() )
    {
        return 0;
    }


    if( $self->{'Proxy'} )
    {
        $self->processProxy();
    }


    # Attempt to connect to the server
    if( !$self->makeConnection() )
    {
        return 0;
    }


    # Send request to the server
    if( !$self->sendRequest() )
    {
        $self->breakConnection();
        return 0;
    }


    # Read data from server
    if( !$self->readData() )
    {
        $self->breakConnection();
        return 0;
    }


    $self->breakConnection();
    $self->parseHeaders();
    $self->calculateValues();


    $MaxCode = $self->{'RedirOK'} ? 400 : 300;

    # Bad status code
    if( $self->{'Code'} >= $MaxCode )
    {
        $self->{'Errstr'} = $self->{'Status'};
        return 0;
    }

    return 1;
}



sub processProxy
{
    my $self = shift;

    $self->{'Proxy'} =~ m/([^:]+):?(\d+)*/;

    $self->{'Host'} = $1;
    $self->{'Port'} = $2 ? $2 : 80;
    $self->{'URI'}  = $self->{'URL'};
}



sub GETRedirect
{
    my $self = shift;

    if( !$self->GETNoRedirect() )
    {
        return 0;
    }


    while( defined $self->{'Location'} )
    {
        $self->{'URL'} = $self->{'Location'};

        $self->clearValues();

        if( !$self->GETNoRedirect() )
        {
            return 0;
        }

        $self->{'Redirects'}++;

        if( $self->{'Redirects'} > 3 )
        {
            $self->{'Errstr'} = $L_REDIRECTS;
            return 0;
        }
    }

    return 1;
}



sub parseURL
{
    my $self = shift;

    if( $self->{'URL'} =~ m|http://([^:/]+):?(\d+)*(/?.*)|i )
    {
        $self->{'Host'} = $1;
        $self->{'Port'} = $2 ? $2 : 80;
        $self->{'URI'}  = $3 ? $3 : '/';

        return 1;
    }
    else
    {
        $self->{'Errstr'} = $L_INVALID_URL;
        return 0;
    }
}



sub parseHeaders()
{
    my $self = shift;

    $self->{'Headers'} =~ s/\r//g;

    $self->{'Code'} = substr($self->{'Headers'}, 9, 3);

    $self->{'Headers'} =~ m|^HTTP/\d\.\d (.*)$|m;    
    $self->{'Status'}  = $1;

    if( $self->{'Headers'} =~ m|^Location:\s+(.*)$|mi )
    {
        chomp($self->{'Location'} = $1);
    }
}



sub sendRequest
{
    my $self = shift;
    $self->generateRequest();

    eval 
    {
        alarm(10);   
        my $result = send($self->{'Sock'}, $self->{'GetString'}, undef);

        if( !$result )
        {
            $self->{'Errstr'} = "$!";
        }

        alarm(0);
    };


    if( $@ )
    {
        $self->{'Errstr'} = $L_SEND_TIMEOUT;
        return 0;
    }
    elsif( $self->{'Errstr'} )
    {
        return 0;
    }

    return 1;
}



sub readData
{
    my $self = shift;

    eval 
    {
        alarm(30);

        my $line   = undef;
        my $bytes  = undef;
        my $buffer = undef;
        my $start  = now();
        my $sock   = $self->{'Sock'};
        my $hdone  = 0;


        while( $line = <$sock> )
        {
            $bytes = length($line);
            $self->{'HeaderBytes'} += $bytes;
            $self->{'TotalBytes'}  += $bytes;

            if( $line =~ /^$CRLF*$/ )
            {
                last;
            }

            $self->{'Headers'} .= $line;
        }

      
        while( $bytes = read($sock, $buffer, 16384) )
        {
            if( $bytes == undef )
            {
                $self->{'Errstr'} = "$L_READ_ERROR: $!";
                last;
            }

            $self->{'TotalBytes'} += $bytes;
            $self->{'BodyBytes'}  += $bytes;
            $self->{'Data'}       .= $buffer;
        }
        my $end = now();

        $self->{'ReadTime'} = $end-$start;
        $self->{'ReadTime'} = 0.25 if( $self->{'ReadTime'} == 0 );

        alarm(0);
    };


    if( $@ )
    {
        if( $@ =~ /timeout/ )
        {
            $self->{'Errstr'} = $L_READ_TIMEOUT;
            return 0;
        }
        else
        {
            $self->{'Errstr'} = "$@";
            return 0;
        }
    }
    elsif( $self->{'Errstr'} )
    {
        return 0;
    }

    return 1;
}



sub makeConnection
{
    my $self  = shift;
    my $iaddr = undef;

    eval
    {
        alarm(15);

        socket(SOCK, AF_INET, SOCK_STREAM, getprotobyname('tcp'));
        $self->{'Sock'} = SOCK;

        $iaddr = inet_aton($self->{'Host'});

        if( !$iaddr )
        {
            $self->{'Errstr'} = "$L_RESOLVE: $self->{'Host'}";
            return;
        }

        alarm(0);
    };


    if( $@ )
    {
        if( $@ =~ /timeout/ )
        {
            $self->{'Errstr'} = "$L_RESOLVE: $self->{'Host'}";
            return 0;
        }
        else
        {
            $self->{'Errstr'} = "$@";
            return 0;
        }
    }
    elsif( $self->{'Errstr'} )
    {
        return 0;
    }


    eval
    {
        alarm(15);
        my $paddr = sockaddr_in($self->{'Port'}, $iaddr);

        if( !$self->{'Errstr'} )
        {
            my $start  = now();
            my $result = connect($self->{'Sock'}, $paddr);
            my $end    = now();

            if( !$result )
            {
                $self->{'Errstr'} = "$!";
            }
            else
            {
                $self->{'ConnectTime'} = $end-$start;
                $self->{'ConnectTime'} = 0.25 if( $self->{'ConnectTime'} == 0 )
            }
        }
        alarm(0);
    };


    if( $@ )
    {
        if( $@ =~ /timeout/ )
        {
            $self->{'Errstr'} = $L_CONNECT_TIMEOUT;
            return 0;
        }
        else
        {
            $self->{'Errstr'} = "$@";
            return 0;
        }
    }
    elsif( $self->{'Errstr'} )
    {
        return 0;
    }

    return 1;
}



sub breakConnection
{
    my $self = shift;

    shutdown($self->{'Sock'}, 0);
    close($self->{'Sock'});
}



sub generateRequest
{
    my $self   = shift;

    $self->{'GetString'} = "$self->{'Method'} $self->{'URI'} HTTP/1.0$CRLF" .
                           "Host: $self->{'Host'}$CRLF" .
                           "User-Agent: $self->{'Agent'}$CRLF" .
                           "$self->{'Referrer'}" .
                           "Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/vnd.ms-excel, application/msword, application/x-shockwave-flash, */*$CRLF" .
                           "Accept-Language: en-us$CRLF" . 
                           "Connection: Close$CRLF$CRLF";
}



sub calculateValues()
{
    my $self = shift;

    $self->{'Throughput'} = sprintf("%.1f", ($self->{'TotalBytes'}/1024)/$self->{'ReadTime'});
    
    if( $self->{'BodyBytes'} >= 1048576 )
    {
        $self->{'BodySize'} = sprintf("%.1f MB", $self->{'BodyBytes'}/1048576);
    }
    elsif( $self->{'BodyBytes'} >= 1024 )
    {
        $self->{'BodySize'} = sprintf("%.1f KB", $self->{'BodyBytes'}/1024);
    }
    else
    {
        $self->{'BodySize'} = "$self->{'BodyBytes'} Bytes";
    }
}



sub clearValues
{
    my $self = shift;

    $self->{'Headers'}     = undef;
    $self->{'Data'}        = undef;
    $self->{'Location'}    = undef;
    $self->{'Code'}        = undef;
    $self->{'Status'}      = undef;
    $self->{'Host'}        = undef;
    $self->{'Port'}        = undef;
    $self->{'URI'}         = undef;
    $self->{'Sock'}        = undef;
    $self->{'Errstr'}      = undef;
    $self->{'TotalBytes'}  = 0;
    $self->{'ReadTime'}    = 0;
    $self->{'ConnectTime'} = 0;
    $self->{'HeaderBytes'} = 0;
    $self->{'BodyBytes'}   = 0;
    $self->{'Throughput'}  = 0;
}



sub now
{
    if( $HIGHRES )
    {
        return Time::HiRes::time();
    }
    else
    {
        return time();
    }
}


1;