Show
Ignore:
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:
3 modified

Legend:

Unmodified
Added
Removed

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

    r32529 r32744  
    11Revision history for Perl extension UUID::Generator::PurePerl 
     2 
     30.04_02 Thu Apr 23 12:30:00 JST 2009 
     4        - added pseudo hash generator to U::G::P::Util 
     5          (for case that Digest::MD5 doesn't exist) 
    26 
    370.04_01 Mon Apr 13 11:00:00 JST 2009 

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

    r32529 r32744  
    55use 5.006; 
    66 
    7 our $VERSION = '0.04_01'; 
     7our $VERSION = '0.04_02'; 
    88 
    99use Carp; 

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

    r32529 r32744  
    3232} 
    3333 
     34{ 
     35    my $digester; 
     36 
     37    sub digester { 
     38        if (! defined $digester) { 
     39            my $d; 
     40            $d = eval { Digest->new('SHA-1') }; 
     41            $d = eval { Digest->new('MD5')   }  if $@; 
     42            $d = UUID::Generator::PurePerl::Util::PseudoDigester->new() if $@; 
     43            $digester = $d; 
     44        } 
     45 
     46        return $digester; 
     47    } 
     48} 
     49 
    3450sub digest_as_octets { 
    3551    my $num_octets = shift; 
    3652 
    37     my $d; 
    38     $d = eval { Digest->new('SHA-1') }; 
    39     $d = eval { Digest->new('MD5')   }  if $@; 
    40     die if $@; 
    41  
     53    my $d = digester(); 
     54    $d->reset(); 
    4255    $d->add($_) for @_; 
    4356 
    … …  
    5164sub digest_as_16bit { 
    5265    return unpack 'n', digest_as_octets(2, @_); 
     66} 
     67 
     68package UUID::Generator::PurePerl::Util::PseudoDigester; 
     69 
     70sub new { 
     71    my $class = shift; 
     72    my $entity = q{}; 
     73 
     74    return bless \$entity, $class; 
     75} 
     76 
     77sub digest { 
     78    my $self = shift; 
     79 
     80    my $entity = $$self; 
     81 
     82    my $source = q{}; 
     83    while (length $entity > 0) { 
     84        # 4 bytes seems to be enough (8 bytes in ordinal crypt() impl.) 
     85        my $token = substr($entity, 0, 4, q{}) . "\0\0\0\0"; 
     86        $source .= crypt $token, $token; 
     87    } 
     88 
     89    my @r = ( 0, 0, 0, 0 );     # 32bits * 4 
     90    my $index = 0; 
     91    while (length $source > 0) { 
     92        my $token = substr($source, 0, 4, q{}) . "\0\0\0\0"; 
     93        $r[$index] ^= unpack 'N', $token; 
     94 
     95        $index = ($index + 1) % 4; 
     96    } 
     97 
     98    return pack 'NNNN', @r; 
     99} 
     100 
     101sub reset { 
     102    my $self = shift; 
     103    $$self = q{}; 
     104    return $self; 
     105} 
     106 
     107sub add { 
     108    my ($self, $data) = @_; 
     109    $$self .= $data; 
     110    return $self; 
    53111} 
    54112