1#!perl -w 2 3use Test::More tests => 12; 4 5{ 6 package LenDigest; 7 require Digest::base; 8 use vars qw(@ISA); 9 @ISA = qw(Digest::base); 10 11 sub new { 12 my $class = shift; 13 my $str = ""; 14 bless \$str, $class; 15 } 16 17 sub add { 18 my $self = shift; 19 $$self .= join("", @_); 20 return $self; 21 } 22 23 sub digest { 24 my $self = shift; 25 my $len = length($$self); 26 my $first = ($len > 0) ? substr($$self, 0, 1) : "X"; 27 $$self = ""; 28 return sprintf "$first%04d", $len; 29 } 30} 31 32my $ctx = LenDigest->new; 33is($ctx->digest, "X0000"); 34 35my $EBCDIC = ord('A') == 193; 36 37if ($EBCDIC) { 38 is($ctx->hexdigest, "e7f0f0f0f0"); 39 is($ctx->b64digest, "5/Dw8PA"); 40} else { 41 is($ctx->hexdigest, "5830303030"); 42 is($ctx->b64digest, "WDAwMDA"); 43} 44 45$ctx->add("foo"); 46is($ctx->digest, "f0003"); 47 48$ctx->add("foo"); 49is($ctx->hexdigest, $EBCDIC ? "86f0f0f0f3" : "6630303033"); 50 51$ctx->add("foo"); 52is($ctx->b64digest, $EBCDIC ? "hvDw8PM" : "ZjAwMDM"); 53 54open(F, ">xxtest$$") || die; 55binmode(F); 56print F "abc" x 100, "\n"; 57close(F) || die; 58 59open(F, "xxtest$$") || die; 60$ctx->addfile(*F); 61close(F); 62unlink("xxtest$$") || warn; 63 64is($ctx->digest, "a0301"); 65 66eval { 67 $ctx->add_bits("1010"); 68}; 69like($@, '/^Number of bits must be multiple of 8/'); 70 71$ctx->add_bits($EBCDIC ? "11100100" : "01010101"); 72is($ctx->digest, "U0001"); 73 74eval { 75 $ctx->add_bits("abc", 12); 76}; 77like($@, '/^Number of bits must be multiple of 8/'); 78 79$ctx->add_bits("abc", 16); 80is($ctx->digest, "a0002"); 81 82$ctx->add_bits("abc", 32); 83is($ctx->digest, "a0003"); 84