App-MBUtiny

 view release on metacpan or  search on metacpan

eg/server.cgi  view on Meta::CPAN

    }

    # 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;

    # Response
    print $q->header(

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

sub response {
    my $self = shift;
    my $q = shift;
    my $rc = $self->code; # RC HTTP code (from yuor methods)
    my $head = $self->head || {}; # HTTP Headers (hashref)
    my $data = $self->data; # The working data
    my $msg = $self->message || HTTP::Status::status_message($rc) || "Unknown code";
    $data = {status => 0, error => $self->error || "Unknown error"} if !$self->status && (is_void($data) || $data eq "");
    return $self->SUPER::response unless $data && ref($data);
    return $self->SUPER::response unless value($self->info("attrs"), "serialize");
    #binmode STDOUT, ":raw:utf8"; # Disabled, by encoding reasons. See SUPER::response (utf8::encode($content))

    # Set debug time
    $data->{'time'} = sprintf("%.4f", sprintf("%.4f", $self->tms(1))*1 - $self->{_time})*1;

    # Set status and response
    $data->{status} = $self->status;
    $data->{error} = $self->error;

    # Headers
    $head->{Server} = sprintf("%s/%s", __PACKAGE__, $VERSION);

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

            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 "";
            });

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

        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;
    });

lib/App/MBUtiny/Util.pm  view on Meta::CPAN

        parse_credentials hide_password
    /;

sub sha1sum {
    my $f = shift;
    my $sha1 = new Digest::SHA1;
    my $sum = '';
    return $sum unless -e $f;
    open( my $sha1_fh, '<', $f) or (carp("Can't open '$f': $!") && return $sum);
    if ($sha1_fh) {
        binmode($sha1_fh);
        $sha1->addfile($sha1_fh);
        $sum = $sha1->hexdigest;
        close($sha1_fh);
    }
    return $sum;
}
sub md5sum {
    my $f = shift;
    my $md5 = new Digest::MD5;
    my $sum = '';
    return $sum unless -e $f;
    open( my $md5_fh, '<', $f) or (carp("Can't open '$f': $!") && return $sum);
    if ($md5_fh) {
        binmode($md5_fh);
        $md5->addfile($md5_fh);
        $sum = $md5->hexdigest;
        close($md5_fh);
    }
    return $sum;
}
sub filesize {
    my $f = shift;
    my $filesize = 0;
    $filesize = (stat $f)[7] if -e $f;