App-MBUtiny

 view release on metacpan or  search on metacpan

eg/server.cgi  view on Meta::CPAN

=head1 DESCRIPTION

This script provides the App::MBUtiny HTTP storage server methods

NOTE! Check BASE_URI_PREFIX constant first if you want change base URI prefix

=head1 EXAMPLES

=over 4

=item B<PUT /mbuserver/file.tar.gz>

    lwp-request -E -m PUT -c "application/octet-stream" "http://localhost/mbuserver/foo/bar/file.tar.gz" < file.tar.gz

Put file to server in as-is format (upload)

    PUT http://localhost/mbuserver/foo/bar/file.tar.gz
    User-Agent: lwp-request/6.15 libwww-perl/6.15
    Content-Length: 73820
    Content-Type: application/octet-stream

    201 Created
    Connection: close
    Date: Tue, 25 Jun 2019 16:41:42 GMT
    Server: Apache/2.2.25 (Win32) mod_ssl/2.2.25 OpenSSL/0.9.8y mod_perl/2.0.8 Perl/v5.16.3
    Content-Length: 0
    Content-Location: /mbuserver/foo/bar/file.tar.gz

eg/server.cgi  view on Meta::CPAN

    } elsif (-d $file) {
        my $content = get_list($file);
        print $q->header(-type => CONTENT_TYPE, -charset => 'utf-8', -content_length => length($content));
    } else {
        print $q->header(
            -type       => CONTENT_TYPE,
            -charset    => 'utf-8',
            -status     => '404 Not Found',
        );
    }
} elsif ($meth eq 'PUT') { # lwp-request -E -m PUT -c "application/octet-stream" "http://localhost/mbuserver/foo/bar/test.txt" < test.txt
    # Get filename
    my ($volume, $directories, $file) = File::Spec->splitpath( $path );
    my $dir = File::Spec->catfile($root, $directories);
    unless (-d $dir or -l $dir) {
        mkpath( $dir, {verbose => 0} );
    }

    # Uploading
    my $out_file = File::Spec->catfile($dir, $file);
    my $got_size = 0;
    UPLOADBLOCK: {
        my $buffer = "";
        my $io_handle = $q->upload('PUTDATA') or last UPLOADBLOCK;
        open( MBUUPLOAD, '>', $out_file ) or raise("Can't open file %s", $out_file);
        flock(MBUUPLOAD, LOCK_EX) or raise("Can't lock file %s: %s", $out_file, $!);
        binmode(MBUUPLOAD);
        while (my $bytesread = $io_handle->read($buffer, BUFFER_SIZE) ) {
            print MBUUPLOAD $buffer;
            $got_size += $bytesread;
        }
        close MBUUPLOAD;
    }
    raise("Can't upload file %s", $file) unless $got_size && $got_size == -s $out_file;

lib/App/MBUtiny/Collector/Server.pm  view on Meta::CPAN

    # Check DBI connect
    if ($self->dbi->error) { # DBI checking
        $self->error($self->dbi->error);
        $self->status(0);
    }
    $self->{_time} = sprintf("%.4f", $self->tms(1))*1;
    return HTTP_INTERNAL_SERVER_ERROR unless $self->status;

    # Prepare input data
    my $meth = $self->info->{method} || "GET";
    if ($meth =~ /POST|PUT|PATCH/) {
        my $data = $q->param($meth."DATA") // $q->param('XForms:Model');
        Encode::_utf8_on($data);
        if (value($self->info("attrs"), "deserialize")) {
            my $serializer = $self->serializer;
            $self->data($serializer->deserialize($data));
            unless ($serializer->status) {
                $self->error(sprintf("Can't deserialize document: %s", $serializer->error));
                $self->status(0);
                return HTTP_INTERNAL_SERVER_ERROR;
            }

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

    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 {