| Line | |
|---|
| 1 | #!perl -w
|
|---|
| 2 |
|
|---|
| 3 | use Test qw(plan ok);
|
|---|
| 4 | plan tests => 5;
|
|---|
| 5 |
|
|---|
| 6 | {
|
|---|
| 7 | package Digest::Foo;
|
|---|
| 8 | require Digest::base;
|
|---|
| 9 | use vars qw(@ISA $VERSION);
|
|---|
| 10 | @ISA = qw(Digest::base);
|
|---|
| 11 |
|
|---|
| 12 | sub new {
|
|---|
| 13 | my $class = shift;
|
|---|
| 14 | my $str = "";
|
|---|
| 15 | bless \$str, $class;
|
|---|
| 16 | }
|
|---|
| 17 |
|
|---|
| 18 | sub add {
|
|---|
| 19 | my $self = shift;
|
|---|
| 20 | $$self .= join("", @_);
|
|---|
| 21 | return $self;
|
|---|
| 22 | }
|
|---|
| 23 |
|
|---|
| 24 | sub digest {
|
|---|
| 25 | my $self = shift;
|
|---|
| 26 | return sprintf "%04d", length($$self);
|
|---|
| 27 | }
|
|---|
| 28 | }
|
|---|
| 29 |
|
|---|
| 30 | use Digest::file qw(digest_file digest_file_hex digest_file_base64);
|
|---|
| 31 |
|
|---|
| 32 | my $file = "test-$$";
|
|---|
| 33 | die if -f $file;
|
|---|
| 34 | open(F, ">$file") || die "Can't create '$file': $!";
|
|---|
| 35 | binmode(F);
|
|---|
| 36 | print F "foo\0\n";
|
|---|
| 37 | close(F) || die "Can't write '$file': $!";
|
|---|
| 38 |
|
|---|
| 39 | ok(digest_file($file, "Foo"), "0005");
|
|---|
| 40 | ok(digest_file_hex($file, "Foo"), "30303035");
|
|---|
| 41 | ok(digest_file_base64($file, "Foo"), "MDAwNQ");
|
|---|
| 42 |
|
|---|
| 43 | unlink($file) || warn "Can't unlink '$file': $!";
|
|---|
| 44 |
|
|---|
| 45 | ok(eval { digest_file("not-there.txt", "Foo") }, undef);
|
|---|
| 46 | ok($@);
|
|---|
Note:
See
TracBrowser
for help on using the repository browser.