package H_MD5;
 use constant POW2_32 => 4294967296;

 q$Id: H_MD5.pm,v 1.3 2005/02/28 18:32:42 H-Hash Exp $
	 =~ /,v ([\w.-]+) /,  $VERSION = $1;

############################################################
sub new ($) {
##############################
 my $self = shift;

 eval { require Digest::MD5 };
 $@ ? bless { }, $self : Digest::MD5->new;
}

############################################################
sub reset ($) {
##############################
 undef shift->{_add};
}

############################################################
sub add ($@) {
##############################
 my $self = shift;
 my @data = @_;

 foreach (@data) { $self->{_add} .= $_ }
 $self;
}

############################################################
sub hexdigest ($$) {
##############################
 my $self = shift;
 my $data = $self->{_add};
 $self->reset;

# Step 1 & 2
 my $byte_len = length($data);
 my $bits_len = $byte_len * 8;
 $data .= chr(0x80)
       .  chr(0x00) x ((119 - $byte_len % 64) % 64)    # 119 = 56+64-1
       .  pack("V2", $bits_len, $bits_len / (2**32));  # 1byte = 8bits

# Step 3
 my($a, $b, $c, $d) = (0x67452301, 0xEFCDAB89, 0x98BADCFE, 0x10325476);

# Step 4
 my($aa, $bb, $cc, $dd, @x);
 while ($data =~ s/(.{64})//s) {
	# Little Endian
	 @x = unpack('V16', $1);

	# Save A as AA, B as BB, C as CC, and D as DD.
	 $aa = $a, $bb = $b, $cc = $c, $dd = $d;

	# Round 1
	 _round1(\$a, $b, $c, $d, $x[ 0] + 0xD76AA478,  7);
	 _round1(\$d, $a, $b, $c, $x[ 1] + 0xE8C7B756, 12);
	 _round1(\$c, $d, $a, $b, $x[ 2] + 0x242070DB, 17);
	 _round1(\$b, $c, $d, $a, $x[ 3] + 0xC1BDCEEE, 22);
	 _round1(\$a, $b, $c, $d, $x[ 4] + 0xF57C0FAF,  7);
	 _round1(\$d, $a, $b, $c, $x[ 5] + 0x4787C62A, 12);
	 _round1(\$c, $d, $a, $b, $x[ 6] + 0xA8304613, 17);
	 _round1(\$b, $c, $d, $a, $x[ 7] + 0xFD469501, 22);
	 _round1(\$a, $b, $c, $d, $x[ 8] + 0x698098D8,  7);
	 _round1(\$d, $a, $b, $c, $x[ 9] + 0x8B44F7AF, 12);
	 _round1(\$c, $d, $a, $b, $x[10] + 0xFFFF5BB1, 17);
	 _round1(\$b, $c, $d, $a, $x[11] + 0x895CD7BE, 22);
	 _round1(\$a, $b, $c, $d, $x[12] + 0x6B901122,  7);
	 _round1(\$d, $a, $b, $c, $x[13] + 0xFD987193, 12);
	 _round1(\$c, $d, $a, $b, $x[14] + 0xA679438E, 17);
	 _round1(\$b, $c, $d, $a, $x[15] + 0x49B40821, 22);

	# ROUND 2
	 _round2(\$a, $b, $c, $d, $x[ 1] + 0xF61E2562,  5);
	 _round2(\$d, $a, $b, $c, $x[ 6] + 0xC040B340,  9);
	 _round2(\$c, $d, $a, $b, $x[11] + 0x265E5A51, 14);
	 _round2(\$b, $c, $d, $a, $x[ 0] + 0xE9B6C7AA, 20);
	 _round2(\$a, $b, $c, $d, $x[ 5] + 0xD62F105D,  5);
	 _round2(\$d, $a, $b, $c, $x[10] + 0x02441453,  9);
	 _round2(\$c, $d, $a, $b, $x[15] + 0xD8A1E681, 14);
	 _round2(\$b, $c, $d, $a, $x[ 4] + 0xE7D3FBC8, 20);
	 _round2(\$a, $b, $c, $d, $x[ 9] + 0x21E1CDE6,  5);
	 _round2(\$d, $a, $b, $c, $x[14] + 0xC33707D6,  9);
	 _round2(\$c, $d, $a, $b, $x[ 3] + 0xF4D50D87, 14);
	 _round2(\$b, $c, $d, $a, $x[ 8] + 0x455A14ED, 20);
	 _round2(\$a, $b, $c, $d, $x[13] + 0xA9E3E905,  5);
	 _round2(\$d, $a, $b, $c, $x[ 2] + 0xFCEFA3F8,  9);
	 _round2(\$c, $d, $a, $b, $x[ 7] + 0x676F02D9, 14);
	 _round2(\$b, $c, $d, $a, $x[12] + 0x8D2A4C8A, 20);

	# ROUND 3
	 _round3(\$a, $b, $c, $d, $x[ 5] + 0xFFFA3942,  4);
	 _round3(\$d, $a, $b, $c, $x[ 8] + 0x8771F681, 11);
	 _round3(\$c, $d, $a, $b, $x[11] + 0x6D9D6122, 16);
	 _round3(\$b, $c, $d, $a, $x[14] + 0xFDE5380C, 23);
	 _round3(\$a, $b, $c, $d, $x[ 1] + 0xA4BEEA44,  4);
	 _round3(\$d, $a, $b, $c, $x[ 4] + 0x4BDECFA9, 11);
	 _round3(\$c, $d, $a, $b, $x[ 7] + 0xF6BB4B60, 16);
	 _round3(\$b, $c, $d, $a, $x[10] + 0xBEBFBC70, 23);
	 _round3(\$a, $b, $c, $d, $x[13] + 0x289B7EC6,  4);
	 _round3(\$d, $a, $b, $c, $x[ 0] + 0xEAA127FA, 11);
	 _round3(\$c, $d, $a, $b, $x[ 3] + 0xD4EF3085, 16);
	 _round3(\$b, $c, $d, $a, $x[ 6] + 0x04881D05, 23);
	 _round3(\$a, $b, $c, $d, $x[ 9] + 0xD9D4D039,  4);
	 _round3(\$d, $a, $b, $c, $x[12] + 0xE6DB99E5, 11);
	 _round3(\$c, $d, $a, $b, $x[15] + 0x1FA27CF8, 16);
	 _round3(\$b, $c, $d, $a, $x[ 2] + 0xC4AC5665, 23);

	# ROUND 4
	 _round4(\$a, $b, $c, $d, $x[ 0] + 0xF4292244,  6);
	 _round4(\$d, $a, $b, $c, $x[ 7] + 0x432AFF97, 10);
	 _round4(\$c, $d, $a, $b, $x[14] + 0xAB9423A7, 15);
	 _round4(\$b, $c, $d, $a, $x[ 5] + 0xFC93A039, 21);
	 _round4(\$a, $b, $c, $d, $x[12] + 0x655B59C3,  6);
	 _round4(\$d, $a, $b, $c, $x[ 3] + 0x8F0CCC92, 10);
	 _round4(\$c, $d, $a, $b, $x[10] + 0xFFEFF47D, 15);
	 _round4(\$b, $c, $d, $a, $x[ 1] + 0x85845DD1, 21);
	 _round4(\$a, $b, $c, $d, $x[ 8] + 0x6FA87E4F,  6);
	 _round4(\$d, $a, $b, $c, $x[15] + 0xFE2CE6E0, 10);
	 _round4(\$c, $d, $a, $b, $x[ 6] + 0xA3014314, 15);
	 _round4(\$b, $c, $d, $a, $x[13] + 0x4E0811A1, 21);
	 _round4(\$a, $b, $c, $d, $x[ 4] + 0xF7537E82,  6);
	 _round4(\$d, $a, $b, $c, $x[11] + 0xBD3AF235, 10);
	 _round4(\$c, $d, $a, $b, $x[ 2] + 0x2AD7D2BB, 15);
	 _round4(\$b, $c, $d, $a, $x[ 9] + 0xEB86D391, 21);

	# Then perform the following additions
	 $a = ($a + $aa) % POW2_32;
	 $b = ($b + $bb) % POW2_32;
	 $c = ($c + $cc) % POW2_32;
	 $d = ($d + $dd) % POW2_32;
 }

# Step 5
 unpack('H*', pack('V4', $a, $b, $c, $d));
}

##############################
sub _round1 (\$$$$$$) {
 my $ra = shift;
 my($b, $c, $d, $xt, $s) = @_;
 my $f = ($b & $c) | (~$b & $d);

 $$ra = _round($b, $$ra + $xt + $f, $s);
}

##############################
sub _round2 (\$$$$$$) {
 my $ra = shift;
 my($b, $c, $d, $xt, $s) = @_;
 my $g = ($b & $d) | ($c & ~$d);

 $$ra = _round($b, $$ra + $xt + $g, $s);
}

##############################
sub _round3 (\$$$$$$) {
 my $ra = shift;
 my($b, $c, $d, $xt, $s) = @_;
 my $h = $b ^ $c ^ $d;

 $$ra = _round($b, $$ra + $xt + $h, $s);
}

##############################
sub _round4 (\$$$$$$) {
 my $ra = shift;
 my($b, $c, $d, $xt, $s) = @_;
 my $i = $c ^ ($b | ~$d);

 $$ra = _round($b, $$ra + $xt + $i, $s);
}

##############################
sub _round ($$$) {
 my $b =  shift;
 my $r = (shift) % POW2_32;
 my $s =  shift;

 ( $b + ($r << $s | $r >> (32 - $s)) ) % POW2_32;
}

#*********************************************************************

=head1 NAME

H_MD5 - MD5 ダイジェスト計算のための Perl インタフェース

=head1 SYNOPSIS

   use H_MD5;
   $md5 = H_MD5->new->add('abc')->hexdigest;

=head1 DESCRIPTION

Perl で MD5 を計算します。Digest::MD5 がインストールされていればこれを
利用し、なければ自前の関数を利用します。

=head1 METHODS

=item new()

新しいオブジェクトを作成します。

=item add($data)

MD を作る文字列を追加します。reset() が呼び出されるまで、文字列は追加
できます。

=item reset()

オブジェクトにセットされた文字列をリセットします。

=item hexdigest()

MD を 16 進数で返します。内部で reset() が自動的に呼び出されます。

=head1 SEE ALSO

   Digest::MD5
   RFC 1321 (The MD5 Message-Digest Algorithm)

=head1 AUTHOR

Copyright (C) 1999-2005;  H-Hash

連絡は http://www.studyinghttp.net/help#Mail まで。

=cut

1;