Changeset 32744

Timestamp:

04/23/09 12:41:40 (4 years ago)

Author:

dayflower

Message:

added pseudo hash generator to U::G::P::Util

Location:

lang/perl/UUID-Generator-PurePerl/trunk

Files:

• Changes (modified) (1 diff)
• lib/UUID/Generator/PurePerl.pm (modified) (1 diff)
• lib/UUID/Generator/PurePerl/Util.pm (modified) (2 diffs)

lang/perl/UUID-Generator-PurePerl/trunk/Changes

@@ -1 +1 @@
 Revision history for Perl extension UUID::Generator::PurePerl
+
+0.04_02 Thu Apr 23 12:30:00 JST 2009
+        - added pseudo hash generator to U::G::P::Util
+          (for case that Digest::MD5 doesn't exist)
 
 0.04_01 Mon Apr 13 11:00:00 JST 2009

lang/perl/UUID-Generator-PurePerl/trunk/lib/UUID/Generator/PurePerl.pm

@@ -5 +5 @@
 use 5.006;
 
-our $VERSION = '0.04_01';
+our $VERSION = '0.04_02';
 
 use Carp;

lang/perl/UUID-Generator-PurePerl/trunk/lib/UUID/Generator/PurePerl/Util.pm

@@ -32 +32 @@
 }
 
+{
+    my $digester;
+
+    sub digester {
+        if (! defined $digester) {
+            my $d;
+            $d = eval { Digest->new('SHA-1') };
+            $d = eval { Digest->new('MD5')   }  if $@;
+            $d = UUID::Generator::PurePerl::Util::PseudoDigester->new() if $@;
+            $digester = $d;
+        }
+
+        return $digester;
+    }
+}
+
 sub digest_as_octets {
     my $num_octets = shift;
 
-    my $d;
-    $d = eval { Digest->new('SHA-1') };
-    $d = eval { Digest->new('MD5')   }  if $@;
-    die if $@;
-
+    my $d = digester();
+    $d->reset();
     $d->add($_) for @_;
 
@@ -51 +64 @@
 sub digest_as_16bit {
     return unpack 'n', digest_as_octets(2, @_);
+}
+
+package UUID::Generator::PurePerl::Util::PseudoDigester;
+
+sub new {
+    my $class = shift;
+    my $entity = q{};
+
+    return bless \$entity, $class;
+}
+
+sub digest {
+    my $self = shift;
+
+    my $entity = $$self;
+
+    my $source = q{};
+    while (length $entity > 0) {
+        # 4 bytes seems to be enough (8 bytes in ordinal crypt() impl.)
+        my $token = substr($entity, 0, 4, q{}) . "\0\0\0\0";
+        $source .= crypt $token, $token;
+    }
+
+    my @r = ( 0, 0, 0, 0 );     # 32bits * 4
+    my $index = 0;
+    while (length $source > 0) {
+        my $token = substr($source, 0, 4, q{}) . "\0\0\0\0";
+        $r[$index] ^= unpack 'N', $token;
+
+        $index = ($index + 1) % 4;
+    }
+
+    return pack 'NNNN', @r;
+}
+
+sub reset {
+    my $self = shift;
+    $$self = q{};
+    return $self;
+}
+
+sub add {
+    my ($self, $data) = @_;
+    $$self .= $data;
+    return $self;
 }