Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

first commit

  • Loading branch information...
commit 8300e77ff68078191887f9e109782e5a78beb582 0 parents
@amiri amiri authored
0  README
No changes.
19 dist.ini
@@ -0,0 +1,19 @@
+name = Digest-PBKDF2
+author = Amiri Barksdale <amiri@arisdottle.net>
+license = Perl_5
+copyright_holder = Amiri Barksdale
+copyright_year = 2011
+
+version = 0.001
+
+[@Basic]
+[InstallGuide]
+[MetaJSON]
+
+[MetaResources]
+repository.url = git://github.com/amiri/Digest-PBKDF2.git
+repository.web = http://github.com/amiri/Digest-PBKDF2
+repository.type = git
+
+[AutoPrereqs]
+[ReadmeFromPod]
49 lib/Digest/PBKDF2.pm
@@ -0,0 +1,49 @@
+package Digest::PBKDF2;
+
+use strict;
+use warnings;
+use parent "Digest::base";
+use Crypt::PBKDF2;
+use 5.010;
+use Devel::Dwarn;
+
+#ABSTRACT: This module is a subclass of Digest using the Crypt::PBKDF2 algorithm.
+
+sub new {
+ my ( $class, %params ) = @_;
+ my $guts = Crypt::PBKDF2->new(
+ map { $_ => $params{$_} }
+ grep { defined $params{$_} }
+ qw/hash_class hash_args hasher iterations output_len salt_len/
+ );
+ return bless { guts => $guts }, $class;
+}
+
+sub clone {
+ my $self = shift;
+ my $clone = {
+ guts => Crypt::PBKDF2->new(
+ map { $_ => $self->{guts}->{$_} } keys %{ $self->{guts} }
+ ),
+ _data => $self->{_data},
+ };
+ return bless $clone, ref $self;
+}
+
+sub add {
+ my $self = shift;
+ $self->{_data} .= join '', @_ if @_;
+ $self;
+}
+
+sub digest {
+ my $self = shift;
+ my @string = split '', $self->{_data};
+
+ my $salt = join( '', splice( @string, 0, $self->{guts}{salt_len} ) );
+ my $data = join( '', @string );
+
+ return $self->{guts}->generate( $data, salt => $salt );
+}
+
+1;
41 t/01_basic.t
@@ -0,0 +1,41 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use Test::More qw/no_plan/;
+use Test::Exception;
+use Devel::Dwarn;
+use Scalar::Util qw/refaddr/;
+
+use_ok "Digest::PBKDF2";
+
+my $dig = Digest::PBKDF2->new;
+
+can_ok( $dig, qw/new clone add digest/ );
+
+lives_ok( sub { $dig->add('cool') }, "I can add one chunk" );
+
+lives_ok( sub { $dig->add('outl2nd') }, "I can add another chunk" );
+
+my $clone;
+lives_ok( sub { $clone = $dig->clone }, "I can clone my object" );
+isnt(
+ refaddr $dig,
+ refaddr $clone,
+ "Cloning gives me a new Digest::PBKDF2 object"
+);
+isnt(
+ refaddr $dig->{guts},
+ refaddr $clone->{guts},
+ "Cloning gives new guts as well"
+);
+is( $clone->digest, $dig->digest,
+ "Clone and orgiinal product the same string" );
+is( $clone->digest,
+ '$PBKDF2$HMACSHA1:1000:Y29vbA==$SM6RfIvXeiGLkrYngY1iyGy3LjY=',
+ "And that string is what it should be"
+);
+is( $dig->digest,
+ '$PBKDF2$HMACSHA1:1000:Y29vbA==$SM6RfIvXeiGLkrYngY1iyGy3LjY=',
+ "Making sure it is..."
+);
Please sign in to comment.
Something went wrong with that request. Please try again.