Repository List / Contenido / koi8 / core / lib / Contenido / File / Scheme / HTTP.pm @ r3

package Contenido::File::Scheme::HTTP;

use strict;
use warnings;

use Contenido::Globals;
use Contenido::File;
use IO::Scalar;
use Data::Dumper;
use HTTP::Request;
use HTTP::Headers;
use LWP::UserAgent;
use File::Temp;

my  %LWP_ARGS = (timeout => 5);

sub fetch {
    my $path      = shift || return;

    my $fh = File::Temp->new(
        TEMPLATE => 'tempXXXXX',
        DIR => $keeper->state()->{tmp_dir},
        SUFFIX => '.dat'
    );

    my $ua = LWP::UserAgent->new(%LWP_ARGS);

    my $res = $ua->get(
        $path,
        ':read_size_hint' => 10 * 1024,
        ':content_cb'     => sub {
            $fh->write(shift());
        },
    );

    seek $fh, 0, 0;

    return $res->is_success() ? $fh : undef;
}

sub store {
    my $path = shift || return;
    my $fh = shift || return;
    my $dt = shift;

    local $/ = undef;

    my $content = <$fh>;

    my $ua = LWP::UserAgent->new(%LWP_ARGS);
    my $req = HTTP::Request->new(PUT => $path);
    $req->content_length(length $content);
    $req->content($content);
    $req->header(Date => $dt->strftime('%a %b %d %H:%M:%S %Y')) if $dt and ref $dt eq "DateTime";

    my $res = $ua->request($req);
#    my $res = $ua->request($req, sub { my $buffer; read $fh, $buffer, 10000; return $buffer });

    unless ($res->is_success()) {
        warn $req->headers()->as_string()."\nreturned NOT OK result: ".$res->message()."(".$res->code.") result is: ".$res->as_string."\n";
        return;
    }

    1;
}

sub remove {
    my $path = shift;

    my $ua = LWP::UserAgent->new(%LWP_ARGS);
    my $req = HTTP::Request->new(DELETE => $path);
    my $res = $ua->request($req);

    unless ($res->is_success()) {
        warn $req->headers()->as_string()."\nreturned NOT OK result: ".$res->message()."(".$res->code.") result is: ".$res->as_string."\n";
        return;
    }

    1;
}

sub size {
    my $path = shift;

    my $ua = LWP::UserAgent->new(%LWP_ARGS);
    my $req = HTTP::Request->new(HEAD => $path);
    my $res = $ua->request($req);

    return unless $res->is_success();
    return $res->content_length();
}

sub listing {
    my $path = shift;

    return unless Contenido::File::scheme($path) eq "http";

    my $files = {};
    my $buffer = "";
    my $ua = LWP::UserAgent->new(%LWP_ARGS);

    $ua->get($path,
             ":content_cb" => sub {
                 $buffer .= shift;

                 while ($buffer =~ s/^(.*?)(?:\r?\n)+//) {
                     next unless my $line = $1;
                     $line =~ s/^[ \t]+//;
                     $line =~ s/[ \t]+$//;
                     if ($line =~ /^<.+?>(.+?)<.+?>.+?(\d+)$/) {
                         $files->{$1} = $2;
                     }
                 }
             },
             ":read_size_hint" => 102400,
         );

    return $files;
}

sub get_fh {
    my $path = shift;
	my $fh;

    return unless Contenido::File::scheme($path) eq "http";

    my $ua = LWP::UserAgent->new(%LWP_ARGS);

    my $response = $ua->get($path);

	if ($response->is_success()) {
        $fh = IO::Scalar->new(\($response->content()));
	} else {
		warn  $response->status_line();
	}

	return $fh;
}

1;