view release on metacpan or  search on metacpan

lib/App/MBUtiny/Storage/HTTP.pm  view on Meta::CPAN

}

1;

package App::MBUtiny::Storage::HTTP::Client;

use vars qw/ $VERSION /;
$VERSION = '1.00';

use Fcntl qw/ :flock /;
use File::Basename;
use CTK::ConfGenUtil;
use CTK::Util qw/ trim /;

use base qw/ WWW::MLite::Client /;

use constant {
        CONTENT_TYPE    => "application/octet-stream",
    };

sub new {
    my $class = shift;
    my %params = @_;
    $params{ua_opts}        ||= { agent => "MBUtiny/$VERSION" };
    $params{content_type}   ||= CONTENT_TYPE;
    $params{no_check_redirect} //= 1;
    return $class->SUPER::new(%params);
}
sub check {
    my $self = shift;
    $self->request("HEAD");
    return $self->status;
}
sub filelist {
    my $self = shift;
    my %args = @_;
    my $string_ret = $self->request(GET => $self->_merge_path_query($args{path}, $args{host})) || "";
    my @array_ret  = map {$_ = trim($_)} split /\s*\n+\s*/, $string_ret;
    return wantarray ? @array_ret : $string_ret;
}
sub upload {
    my $self = shift;
    my %args = @_;
    my $file = $args{file} || ''; # File for uploading! /path/to/file.tar.gz
    my $name = $args{name} || basename($file); # File name! file.tar.gz
    my $path = $args{path} ? sprintf("%s/%s", $args{path}, $name) : $name; # Path for request: /foo/bar
    $self->request(PUT => $self->_merge_path_query($path), sub {
        my $req = shift; # HTTP::Request object
        $req->header('Content-Type', CONTENT_TYPE);
        if (-e $file and -f $file) {
            my $size = (-s $file) || 0;
            return 0 unless $size;
            #my $sizef = $size;
            my $fh;
            $req->content(sub {
                unless ($fh) {
                    open($fh, "<", $file) or do {
                        $self->error(sprintf("Can't open file %s to read: %s", $file, $!));
                        return "";
                    };
                    binmode($fh);
                }
                my $buf = "";
                if (my $n = read($fh, $buf, 1024)) {
                    #$sizef -= $n;
                    #printf STDERR ">>> sizef=%d; n=%d\n", $sizef, $n;
                    return $buf;
                }
                close($fh);
                return "";
            });
            return $size;
        }
        return 0;
    });
    return $self->status;
}
sub fileinfo {
    my $self = shift;
    my %args = @_;
    my $name = $args{name}; # File name! file.tar.gz
    unless ($name) {
        $self->error("The file name (name attribute) not specified!");
        return ();
    }
    my $path = $args{path} ? sprintf("%s/%s", $args{path}, $name) : $name; # Path for request: /foo/bar
    $self->request(HEAD => $self->_merge_path_query($path));
    return () unless $self->status;
    my %ret = ();
    my $res = $self->res;
    if ($res) {
        $ret{code}          = $res->code || 0;
        $ret{message}       = $res->message || '';
        $ret{size}          = $res->content_length || 0;
        $ret{content_type}  = $res->content_type || '';
    }
    return %ret;
}
sub download {
    my $self = shift;
    my %args = @_;
    my $file = $args{file} || ''; # File for downloading! /path/to/file.tar.gz
    my $name = $args{name} || basename($file); # File name! file.tar.gz
    my $path = $args{path} ? sprintf("%s/%s", $args{path}, $name) : $name; # Path for request: /foo/bar

    my $fh;
    my $expected_length;
    my $bytes_received = 0;
    $self->request(GET => $self->_merge_path_query($path), undef, sub {
        my($chunk, $res) = @_;
        #$bytes_received += length($chunk);
        unless (defined $expected_length) {
            $expected_length = $res->content_length || 0;
            open($fh, ">", $file) or do {
                $self->error(sprintf("Can't open file %s to write: %s", $file, $!));
                return;
            };
            flock($fh, LOCK_EX) or do {
                $self->error(stprintf("Can't lock file %s: %s", $file, $!));
                return;
            };
            binmode($fh);
        }
        if ($expected_length && $fh) {
            #printf STDERR "%d%% - ", 100 * $bytes_received / $expected_length;
            print $fh $chunk;
        }

        #print STDERR "$bytes_received bytes received\n";
        # XXX Should really do something with the chunk itself
        # print $chunk;
    });
    close($fh) if $fh;
    return $self->status;
}
sub remove {
    my $self = shift;
    my %args = @_;
    my $name = $args{name}; # File name! file.tar.gz
    unless ($name) {
        $self->error("The file name (name attribute) not specified!");
        return $self->status(0);
    }
    my $path = $args{path} ? sprintf("%s/%s", $args{path}, $name) : $name; # Path for request: /foo/bar
    $self->request(DELETE => $self->_merge_path_query($path));
    return $self->status;
}

sub _merge_path_query {
    my $self = shift;
    my $path = shift;
    my $host = shift;
    my $uri = $self->{uri}->clone;
    my $path_orig = $uri->path;
    $uri->path(sprintf("%s/%s", $path_orig, $path)) if $path;
    $uri->query_form(host => $host) if $host;
    return $uri->path_query;
}

1;

__END__