Data commit

Task/SHA-256/Perl/sha-256-1.pl

@@ -0,0 +1,7 @@
+#!/usr/bin/perl
+use strict ;
+use warnings ;
+use Digest::SHA qw( sha256_hex ) ;
+
+my $digest = sha256_hex my $phrase = "Rosetta code" ;
+print "SHA-256('$phrase'): $digest\n" ;

Task/SHA-256/Perl/sha-256-2.pl

@@ -0,0 +1,139 @@
+package Digest::SHA256::PP;
+
+use strict;
+use warnings;
+
+use constant WORD => 2**32;
+use constant MASK => WORD - 1;
+
+my @h;
+my @k;
+
+for my $p ( 2 .. 311 ) {
+	# Horrible primality test, but sufficient for this task.
+	next if ("1" x $p) =~ /^(11+?)\1+$/;
+	# The choice to generate h and k instead of hard coding
+	# them is inspired by the Raku implementation.
+	my $c = $p ** ( 1/3 );
+	push @k, int( ($c - int $c) * WORD );
+	next if @h == 8;
+	my $s = $p ** ( 1/2 );
+	push @h, int( ($s - int $s) * WORD );
+}
+
+sub new {
+	my %self = ( state => [@h], str => "", len => 0 );
+	bless \%self, shift;
+}
+
+my $rightrotate = sub {
+	my $lo = $_[0] >> $_[1];
+	my $hi = $_[0] << (32 - $_[1]);
+	($hi | $lo);
+};
+
+# This is adapted from the wikipedia entry on SHA2.
+my $compress = sub {
+	my ($state, $bytes) = @_;
+	my @w = unpack 'N*', $bytes;
+	@w == 16 or die 'internal error';
+	my ($a, $b, $c, $d, $e, $f, $g, $h) = @$state;
+	until( @w == 64 ) {
+		my $s0 = $w[-15] >> 3;
+		my $s1 = $w[-2] >> 10;
+		$s0 ^= $rightrotate->($w[-15], $_) for 7, 18;
+		$s1 ^= $rightrotate->($w[-2], $_) for 17, 19;
+		push @w, ($w[-16] + $s0 + $w[-7] + $s1) & MASK;
+	}
+	my $i = 0;
+	for my $w (@w) {
+		my $ch = ($e & $f) ^ ((~$e) & $g);
+		my $maj = ($a & $b) ^ ($a & $c) ^ ($b & $c);
+		my ($S0, $S1) = (0, 0);
+		$S1 ^= $rightrotate->( $e, $_ ) for 6, 11, 25;
+		$S0 ^= $rightrotate->( $a, $_ ) for 2, 13, 22;
+		my $temp1 = $h + $S1 + $ch + $k[$i++] + $w;
+		my $temp2 = $S0 + $maj;
+		($h, $g, $f, $e, $d, $c, $b, $a) =
+			($g, $f, $e, ($d+$temp1)&MASK, $c, $b, $a, ($temp1+$temp2)&MASK);
+	}
+	my $j = 0;
+	$state->[$j++] += $_ for $a, $b, $c, $d, $e, $f, $g, $h;
+};
+
+use constant can_Q => eval { length pack 'Q>', 0 };
+
+sub add {
+	my ($self, $bytes) = @_;
+	$self->{len} += 8 * length $bytes;
+	if( !can_Q and $self->{len} >= WORD ) {
+		my $hi = int( $self->{len} / WORD );
+		$self->{big} += $hi;
+		$self->{len} -= $hi * WORD;
+	}
+	my $len = length $self->{str};
+	if( ($len + length $bytes) < 64 ) {
+		$self->{str} .= $bytes;
+		return $self;
+	}
+	my $off = 64 - $len;
+	$compress->( $self->{state}, $self->{str} . substr( $bytes, 0, $off ) );
+	$len = length $_[0];
+	while( $off+64 <= $len ) {
+		$compress->( $self->{state}, substr( $bytes, $off, 64 ) );
+		$off += 64;
+	}
+	$self->{str} = substr( $bytes, $off );
+	$self;
+}
+
+sub addfile {
+	my ($self, $fh) = @_;
+	my $s = "";
+	while( read( $fh, $s, 2**13 ) )	{
+		$self->add( $s );
+	}
+	$self;
+}
+
+
+sub digest {
+	my $self = shift;
+	my $final = $self->{str};
+	$final .= chr 0x80;
+	while( ( 8+length $final ) % 64 ) {
+		$final .= chr 0;
+	}
+	if( can_Q ) {
+		$final .= pack 'Q>', $self->{len};
+	} else {
+		$self->{big} ||= 0;
+		$final .= pack 'NN', $self->{big}, $self->{len};
+	}
+	$compress->( $self->{state}, substr $final, 0, 64, "" ) while length $final;
+	if( wantarray ) {
+		map pack('N', $_), @{ $self->{state} };
+	} else {
+		pack 'N*', @{ $self->{state} };
+	}
+}
+
+sub hexdigest {
+	if( wantarray ) {
+		map unpack( 'H*', $_), &digest;
+	} else {
+		unpack 'H*', &digest;
+	}
+}
+
+unless( caller ) {
+	my @testwith = (@ARGV ? @ARGV : 'Rosetta code');
+	for my $str (@testwith) {
+		my $digester = __PACKAGE__->new;
+		$digester->add($str);
+		print "'$str':\n";
+		print join(" ", $digester->hexdigest), "\n";
+	}
+}
+
+1;