File Coverage

blib/lib/Tie/Handle/HTTP.pm

Criterion	Covered	Total	%
statement	75	90	83.3
branch	14	26	53.8
condition	1	3	33.3
subroutine	13	15	86.6
pod	1	1	100.0
total	104	135	77.0

package Tie::Handle::HTTP;

use strict;
use warnings;

use LWP::UserAgent;
use HTTP::Request;
use HTTP::Status;
use Errno qw(EIO EINVAL);
use Symbol;

use vars qw($VERSION);
$VERSION = '0.02';

sub DEBUGGING () { 0 }

sub new {
    my $class = shift;
    my $uri = shift;

    my $symbol = Symbol::gensym;

    tie( *$symbol, __PACKAGE__, $uri );

    return $symbol;
}

sub TIEHANDLE {
    my $class = shift;
    my $uri = shift;

    # Add configurable options for UserAgent
    my $ua = LWP::UserAgent->new( keep_alive => 5 );
    my $req = HTTP::Request->new( HEAD => $uri );
    my $res = $ua->request( $req );

    return unless $res->is_success;

    my $self = bless {}, (ref $class || $class);

    $self->{length} = $res->header( 'Content-Length' );
    $self->{pos} = 0;
    $self->{ua} = $ua;
    $self->{uri} = $uri;
    $self->{eof} = 0;

    warn "URI: $uri reports length of $self->{length} bytes.\n" if DEBUGGING;

    return $self;
}

sub READ {
    my $self = shift;
    my $buf = \$_[0]; shift;
    my ($len, $offset) = @_;

    defined( $$buf ) or $$buf = '';
    defined( $offset ) or $offset = 0;

    my $pos = $self->{pos};
    my $uri = $self->{uri};

    # Implement this area of functionality
    return unless ($len > 0);

    # Implement this area of functionality
    return unless ($offset >= 0);

    return 0 if ($self->EOF);

    my $start = $pos;
    my $end = $pos + $len - 1;

    warn "Requesting $start to $end bytes of $uri\n" if DEBUGGING;

    my $req = HTTP::Request->new(GET => $uri, [
        Range => "bytes=$start-$end",
    ], );

    my $res = $self->{ua}->request( $req );

    if ($res->is_error) {
        if ($res->code eq RC_REQUEST_RANGE_NOT_SATISFIABLE) {
            $self->{eof} = 1;
            return 0;
        }

        $! = EIO;
        return;
    }

    my $length = length( $res->content );

    $self->{pos} = $pos + $length;

    # Find out if read(2) clears to the end of the string or not
    substr( $$buf, $offset, $length ) = $res->content;

    return $length;
}

sub EOF {
    my $self = shift;

    return 1 if $self->{eof};

    return unless $self->{length};

    return $self->{pos} >= $self->{length};
}

sub GETC {
    my $self = shift;

    $self->READ( my $buf, 1 );
    return $buf;
}

sub TELL {
    my $self = shift;

    return $self->{pos};
}

sub SEEK {
    my $self = shift;
    my ($offset, $whence) = @_;

    if ($whence == 1) {
        $offset += $self->{pos};
    }
    elsif ($whence == 2) {
        my $len = $self->{length};
        if (defined( $len )) {
            $offset += $len;
        }
        else {
            $! = EINVAL;
            return 0;
        }
    }

    $self->{pos} = $offset;
    $self->{eof} = 0;
    return 1;
}

1;
__END__