hjp
/
simba
1
0
Fork 0
Code Issues 2 Pull Requests Releases Wiki Activity

get passes tests for short regular files.

This commit is contained in:
hjp 2006-10-02 14:33:26 +00:00
parent a52a6869f9
commit 9c8573289b
2 changed files with 87 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

73
lib/Simba/DA.pm
View File

@ -2,9 +2,14 @@ package Simba::DA;
use strict;
use warnings;
use Encode;
use Encode qw(decode encode from_to);
use File::Find;
use File::stat;
use Readonly;
use Digest::SHA1;
use List::Util qw(min);
Readonly my $BUFSIZE => 128 * 1024;
sub new {
my ($class) = @_;
@ -134,6 +139,13 @@ sub quote {
return encode('utf-8', $s);
}
sub unquote {
my ($s) = @_;
$s = decode('utf-8', $s);
$s =~ s{&#(\d+);}{chr($1)}eg;
return $s;
}
my @typestr = (
#0 1 2 3 4 5 6 7
'?', 'p', 'c', '?', 'd', '?', 'b', '?',
@ -148,6 +160,65 @@ sub typestr {
sub get {
my ($self, $cmd, $path) = @_;
# sanity checks on $path here?
my $fn = encode($self->{charset}, unquote($path));
# sanity checks on $path here?
my $st = lstat($fn);
if (!$st) {
print "fail $path ($!)\n";
return;
}
if (typestr($st->mode) eq 'f') {
my $fh;
unless (open($fh, '<:raw', $fn)) {
print "fail $path ($!)\n";
return;
}
print "data $path ", metastr($fn, $st), "\n";
my $size = $st->size;
my $err;
my $sha1 = Digest::SHA1->new;
while ($size > 0) {
my $buffer;
my $rc = read($fh, $buffer, min($size, $BUFSIZE));
if (!defined($rc)) {
# I/O error
$err = $!;
print "\0" for (1 .. $size);
last;
} elsif ($rc == 0) {
# premature EOF.
$err = "file shrunk by $size bytes";
print "\0" for (1 .. $size);
last;
}
print $buffer;
$size -= length($buffer);
$sha1->add($buffer);
}
print "\n";
if ($err) {
print "fail ($err)\n";
} else {
print "chk sha1 ", $sha1->hexdigest, "\n";
}
} elsif (typestr($st->mode) eq 'l') {
my $target = readlink($fn);
if (length($target) == $st->size) {
print "data $path ", metastr($fn, $st), "\n";
print "$target\n";
print "chk sha1 ", sha1_hex($target), "\n";
} else {
print "fail ($!)\n";
}
} else {
print "nodata $path ", metastr($fn, $st), "\n";
}
}
sub metastr {

25
t/00_da.t
View File

@ -17,33 +17,38 @@ cmp_ok($list, '=~', qr{t/root .* t=d }, 'root is a directory');
cmp_ok($list, '=~', qr{t/root/test.txt .* t=f s=14 }, 'text file found');
cmp_ok($list, '=~', qr{t/root/test.bin .* t=f s=1024 }, 'binary file found');
my $content;
open($fh, '>', \$content);
my $result;
open($fh, '>', \$result);
select $fh;
$da->get('get', 't/root/test.txt');
my ($header, $trailer);
($header, $content, $trailer)
= $content =~ /\A ([^\n]*) \n (.*) \n ([^\n]*) \n \Z/xs;
ok($result, 'get returned something');
my ($header, $content, $trailer);
if ($result =~ /\A ([^\n]*) \n (.*) \n ([^\n]*) \n \z/xs) {
($header, $content, $trailer) = ($1, $2, $3);
}
ok($header, 'header found');
cmp_ok($header, '=~', qr{t/root/test.txt .* t=f s=14 }, 'text file found');
ok($content, 'content found');
cmp_ok($header, '==', 14, 'text file is 14 bytes long');
cmp_ok(length($content), '==', 14, 'text file is 14 bytes long');
ok($trailer, 'trailer found');
is($trailer, 'chk sha1 e3b9312f5f7afbe0bfff5c49ab5e9a160b2b04f4', 'trailer contains correct checksum');
$content="";
$da->get('get', 't/root/test.txt');
open($fh, '>', \$result);
select $fh;
$da->get('get', 't/root/test.bin');
($header, $content, $trailer)
= $content =~ /\A ([^\n]*) \n (.*) \n ([^\n]*) \n \Z/xs;
= $result =~ /\A ([^\n]*) \n (.*) \n ([^\n]*) \n \z/xs;
ok($header, 'header found');
cmp_ok($header, '=~', qr{t/root/test.bin .* t=f s=1024 }, 'binary file found');
ok($content, 'content found');
cmp_ok($header, '==', 1024, 'binary file is 1024 bytes long');
cmp_ok(length($content), '==', 1024, 'binary file is 1024 bytes long');
ok($trailer, 'trailer found');
is($trailer, 'chk sha1 97253f25fc3945cd6293e3dfad2a322041b14164', 'trailer contains correct checksum');