### encode = UTF-8 #############################################################
#
#  SHA1 の使い方
#
#    use MyDigest;
#    my $sha1 = MyDigest::newSHA1();
#    while ( (my $data = <DATA>) ) {
#        $sha1->add($data);
#    }
#    print "SHA1: ". $sha1->hexstr();
#
#    # $sha1->add('more data');  だめ！ hexstr() 後にまた add() を呼ぶと die する．
#
#
###############################################################################
package MyDigest;

use strict;

sub newSHA1
{
	return SHA1->new();
}

1;

###############################################################################
package SHA1;
# 今さら SHA-1
# 2008/01/02 新規作成
#    coaraさんはDigestパッケージを持ってないので作ったです．
#    SHA-512は64bitの整数を扱う必要があるんだけど，perl5.0では面倒くさすぎる！
#    Math::BigInt は無限多倍長だし
# 2009/10/12
#    ちょこっと use integer について整理
#    作ったまま放置するのももったいないので，一応公開


use strict;
use integer;

#======================================
# ctor
#======================================
sub new
{
	return bless {
		# 入力
		'message' => '',
		'pointer' => 0,
		'msglen'  => 0,
		'closed'  => 0,
		
		# ハッシュ結果 (初期値で初期化しておく)
		'H' => [
			0x67452301,
			0xEFCDAB89,
			0x98BADCFE,
			0x10325476,
			0xC3D2E1F0
		],
	}, $_[0];
}

#======================================
# add
#======================================
sub add
{
	my $self = shift;

	die __PACKAGE__.' is closed.' if $self->{'closed'};

	$self->{'message'} .= $_[0];
	$self->{'msglen'} += length($_[0]);
	
	while ($self->_lastLen() >= 64) {
		$self->_hashBlock( $self->_shift() );
	}
}

#======================================
# hexstr
#======================================
sub hexstr
{
	my ($self) = @_;
	
	$self->_close();
	
	return sprintf('%08x' x 5, @{$self->{'H'}});
}

#--------------------------------------
sub _lastLen
{
	my ($self) = @_;
	
	return length($self->{'message'}) - $self->{'pointer'};
}

#--------------------------------------
sub _shift
{
	my ($self) = @_;
	
	my $p = $self->{'pointer'};
	my $len = _min($self->_lastLen(), 64);
	
	$self->{'pointer'} += $len;
	return substr($self->{'message'}, $p, $len);
}


#--------------------------------------
# close
#--------------------------------------
sub _close
{
	my ($self) = @_;

	return if $self->{'closed'};
	$self->{'closed'} = 1;

	#-----
	# 最後のブロックは 1 つの 0x80 と 0個以上の 0x00 と
	# 64bit(8バイト) のメッセージ長で終わる．
	# つまり最低 9 バイトが付加される事になる．
	#-----
	
	my $lastBlock = $self->_shift();
	
	# とりあえず 0x80 だけパディング
	$lastBlock .= "\x80";
	
	# 8バイトを足すと 64 を越えてしまう場合，0x00 だけパディングして hash
	if (64 < length($lastBlock) + 8) {
		my $zeros = 64 - length($lastBlock);
		$lastBlock .= ("\0" x $zeros);
		$self->_hashBlock($lastBlock);
		
		$lastBlock = '';
	}
	
	# 56バイトまでは 0x00 で埋めて，最後にメッセージ長(ビット単位)を付加．
	# ※ ただし64bitのメッセージ長には未対応としよう．
	#    実際には，60バイトまで 0x00 で埋めちゃおう
	$lastBlock .= pack('x'. (60 - length($lastBlock)). 'N', $self->{'msglen'} * 8);
	$self->_hashBlock($lastBlock);
}

#---------------------------------------
# 1つの `W' ブロックをハッシュ
#---------------------------------------
sub _hashBlock
{
	my ($self, $M) = @_;
	
	my $Href = $self->{'H'};
	
	my @W = unpack('N*', $M);  # @W は 0..15 まで(16要素)あるはず

	for (my $t = 16; $t <= 79; $t++) {
		$W[$t] = S(1,
				$W[$t - 3] ^ $W[$t - 8] ^ $W[$t - 14] ^ $W[$t - 16]);
	}
	
	my ($A, $B, $C, $D, $E) = @$Href;
	
	for (my $t = 0; $t <= 79; $t++) {
		my $TEMP = S(5, $A) + f($t, $B, $C, $D) + $E + $W[$t] + K($t);
		$E = $D;
		$D = $C;
		$C = S(30, $B);
		$B = $A;
		$A = $TEMP & 0xffff_ffff;
	}
	
	@$Href = (
			($Href->[0] + $A) & 0xffff_ffff,
			($Href->[1] + $B) & 0xffff_ffff,
			($Href->[2] + $C) & 0xffff_ffff,
			($Href->[3] + $D) & 0xffff_ffff,
			($Href->[4] + $E) & 0xffff_ffff
	);
	
}


#--------------------------------------
# X を n ビット循環左シフト
#--------------------------------------
sub S
{	shift if $_[0] eq __PACKAGE__;

	no integer; # 下記の右シフト演算は，unsigned で行われる必要があるため．

	my ($n, $X) = @_;
	
	return (($X << $n) | ($X >> (32 - $n))) & 0xffff_ffff;
			# win2000,activePerl5.9では，最後の "& 0xfff..." はいらないけど
			# デフォルトが64ビットなマシン上でも動くようにね
}

#--------------------------------------
# function `f'
#--------------------------------------
sub f
{	shift if $_[0] eq __PACKAGE__;

	my ($t, $B, $C, $D) = @_;
	
	return $t <= 19 ? (($B & $C) | ((~$B) & $D))
	     : $t <= 39 ? ( $B ^ $C ^ $D)
	     : $t <= 59 ? (($B & $C) | ($B & $D) | ($C & $D))
	     : ($B ^ $C ^ $D);
}

#--------------------------------------
# function `K'
#--------------------------------------
sub K
{	shift if $_[0] eq __PACKAGE__;

	my ($t) = @_;
	
	return $t <= 19 ? 0x5A827999
	     : $t <= 39 ? 0x6ED9EBA1
	     : $t <= 59 ? 0x8F1BBCDC
	     : 0xCA62C1D6;
}

sub _min
{
	my $r = shift;
	
	for my $i (@_) {
		$r = $i if ($i < $r);
	}
	
	return $r;
}

sub bindump
{
	my $m = $_[0];
	for (my $i = 0; $i < length($m); $i++) {
		print "\n" if ($i % 16 == 0);
		printf("%02X ", unpack('C', substr($m, $i, 1)));
	}
}

1;

__END__