From e71e95544f23058606a7e67b3abe97ae7d34517e Mon Sep 17 00:00:00 2001 From: Graham Knop Date: Fri, 19 Nov 2010 18:32:39 -0600 Subject: [PATCH] add WebGUI::GUID and make WebGUI::Session::Id a wrapper around that --- lib/WebGUI/GUID.pm | 130 ++++++++++++++++++++++++++++++++++++++ lib/WebGUI/Session/Id.pm | 133 +++------------------------------------ t/Session/Id.t | 33 ++++++---- 3 files changed, 158 insertions(+), 138 deletions(-) create mode 100644 lib/WebGUI/GUID.pm diff --git a/lib/WebGUI/GUID.pm b/lib/WebGUI/GUID.pm new file mode 100644 index 000000000..845a3de94 --- /dev/null +++ b/lib/WebGUI/GUID.pm @@ -0,0 +1,130 @@ +package WebGUI::GUID; + + +=head1 LEGAL + + ------------------------------------------------------------------- + WebGUI is Copyright 2001-2009 Plain Black Corporation. + ------------------------------------------------------------------- + Please read the legal notices (docs/legal.txt) and the license + (docs/license.txt) that came with this distribution before using + this software. + ------------------------------------------------------------------- + http://www.plainblack.com info@plainblack.com + ------------------------------------------------------------------- + +=cut + +use strict; +use WebGUI::BestPractices; +use MIME::Base64::URLSafe; +use UUID::Tiny; + +my $idValidator = qr/^[A-Za-z0-9_-]{22}$/; + +=head1 NAME + +Package WebGUI::GUID; + +=head1 DESCRIPTION + +This package generates global unique ids, sometimes called GUIDs. A global unique ID is guaranteed to be unique everywhere and at everytime. + +B There is no such thing as perfectly unique ID's, but the chances of a duplicate ID are so minute that they are effectively unique. + +=head1 SYNOPSIS + + my $id = WebGUI::GUID->generate; + +=head1 METHODS + +These methods are available from this class: + +=cut + +#------------------------------------------------------------------- + +=head2 fromHex ( hexId ) + +Returns the guid corresponding to hexId. Converse of toHex. + +=head3 hexId + +Hex value to convert to guid. + +=cut + +sub fromHex { + shift; + my $hexId = shift; + my $binId = pack( 'H2' x 16, unpack( 'A2' x 16, $hexId ) ); + my $id = substr( urlsafe_b64encode($binId), 0, 22 ); + return $id; +} + +#------------------------------------------------------------------- + +=head2 getValidator + +Get the regular expression used to validate generated GUIDs. This is just to prevent +regular expressions from being duplicated all over the place. + +=cut + +sub getValidator { + return $idValidator; +} + +#------------------------------------------------------------------- + +=head2 generate + +This function generates a global unique id. + +=cut + +sub generate { + shift; + return urlsafe_b64encode( create_UUID( UUID_V4 ) ); +} + +#------------------------------------------------------------------- + +=head2 toHex ( guid ) + +Returns the hex value of a guid. For all GUIDs generated by the generate method, the return value will be 32 characters long. For some manually created invalid GUIDs, it may be 33 characters long. + +=head3 guid + +guid to convert to hex value. + +=cut + +sub toHex { + shift; + my $id = shift; + $id .= 'AA'; + my $bin_id = urlsafe_b64decode($id); + my $hex_id = unpack("H*", $bin_id); + $hex_id =~ s/0{3,4}$//; + return $hex_id; +} + + +#------------------------------------------------------------------- + +=head2 valid ( $idString ) + +Returns true if $idString is a valid WebGUI guid. + +=cut + +sub valid { + shift; + my $idString = shift; + return $idString =~ m/$idValidator/; +} + + +1; + diff --git a/lib/WebGUI/Session/Id.pm b/lib/WebGUI/Session/Id.pm index 6a12be990..7cacd8857 100644 --- a/lib/WebGUI/Session/Id.pm +++ b/lib/WebGUI/Session/Id.pm @@ -16,13 +16,7 @@ package WebGUI::Session::Id; =cut use strict; -use Digest::MD5 (); -use Scalar::Util qw( weaken ); -use Time::HiRes qw( gettimeofday usleep ); -use MIME::Base64 qw(encode_base64 decode_base64); -use Scalar::Util qw(weaken); - -my $idValidator = qr/^[A-Za-z0-9_-]{22}$/; +use WebGUI::GUID; =head1 NAME @@ -44,128 +38,17 @@ These methods are available from this class: =cut -#------------------------------------------------------------------- - -=head2 fromHex ( hexId ) - -Returns the guid corresponding to hexId. Converse of toHex. - -=head3 hexId - -Hex value to convert to guid. - -=cut - -sub fromHex { - my $self = shift; - my $hexId = shift; - my $binId = pack( 'H2' x 16, unpack( 'A2' x 16, $hexId ) ); - my $id = substr( encode_base64($binId), 0, 22 ); - $id =~ tr{+/}{_-}; - return $id; -} - -#------------------------------------------------------------------- - -=head2 getValidator - -Get the regular expression used to validate generated GUIDs. This is just to prevent -regular expressions from being duplicated all over the place. - -=cut - -sub getValidator { - return $idValidator; -} - -#------------------------------------------------------------------- - -=head2 generate - -This function generates a global unique id. - -=cut - -sub generate { - my $self = shift; - my($s,$us)=gettimeofday(); - my($v)=sprintf("%09d%06d%10d%06d%255s",rand(999999999),$us,$s,$$,$self->seed); - my $id = Digest::MD5::md5_base64($v); - $id =~ tr{+/}{_-}; - return $id; -} - -#------------------------------------------------------------------- - -=head2 new ( session ) - -Constructor. - -=head3 session - -A reference to the current session. - -=cut - sub new { - my $class = shift; - my $seed = shift; - my $self = bless { _seed => $seed }, $class; - return $self; + my $class = shift; + return bless {}, $class; } -#------------------------------------------------------------------- - -=head2 seed ( ) - -Returns the seed that be used for salting the data sent to MD5. - -=cut - -sub seed { - my $self = shift; - return $self->{_seed}; +for my $sub (qw(fromHex getValidator generate toHex valid)) { + no strict 'refs'; + *{$sub} = sub { + goto &{"WebGUI::GUID::$sub"}; + }; } - -#------------------------------------------------------------------- - -=head2 toHex ( guid ) - -Returns the hex value of a guid. For all GUIDs generated by the generate method, the return value will be 32 characters long. For some manually created invalid GUIDs, it may be 33 characters long. - -=head3 guid - -guid to convert to hex value. - -=cut - -sub toHex { - my $self = shift; - my $id = shift; - $id =~ tr{_-}{+/}; - $id .= 'AA'; - my $bin_id = decode_base64($id); - my $hex_id = unpack("H*", $bin_id); - $hex_id =~ s/0{3,4}$//; - return $hex_id -} - - -#------------------------------------------------------------------- - -=head2 valid ( $idString ) - -Returns true if $idString is a valid WebGUI guid. - -=cut - -sub valid { - my ($self, $idString) = @_; - return $idString =~ m/$idValidator/; -} - - 1; - diff --git a/t/Session/Id.t b/t/Session/Id.t index f5514b8a5..3d96d7924 100644 --- a/t/Session/Id.t +++ b/t/Session/Id.t @@ -50,23 +50,27 @@ my @testSets = ( my $session = WebGUI::Test->session; -plan tests => scalar(@testSets) + 6; - # generate my $generateId = $session->id->generate(); is(length($generateId), 22, "generate() - length of 22 characters"); -my @uniqueIds; -my $isUnique = 1; -my $isValid = 1; -for (1..2000) { - last unless $isUnique; - my $id = $session->id->generate(); - $isUnique = ($isUnique ? ! ($id ~~ @uniqueIds) : 0); - $isValid = ($isValid ? $session->id->valid($id) : 0); - push(@uniqueIds,$id); + +my %uniqueIds; +GEN_LOOP: { + for (1..2000) { + my $id = $session->id->generate(); + if (! $session->id->valid($id)) { + fail "GUID $id is valid"; + last GEN_LOOP; + } + elsif ($uniqueIds{$id}) { + fail "GUID $id is unique"; + last GEN_LOOP; + } + $uniqueIds{$id} = 1; + } + pass "All GUIDs valid"; + pass "All GUIDs unique"; } -ok($isUnique, "generate() - unique"); -ok($isValid, "generate() - valid id generated"); foreach my $testSet (@testSets) { is($session->id->valid($testSet->{guid}), $testSet->{valid}, $testSet->{comment}); @@ -80,3 +84,6 @@ is($session->id->fromHex('c2369b66c28e6fb90105288eddb430cc'), 'wjabZsKOb7kBBSiO3 my $re = $session->id->getValidator; is( ref $re, 'Regexp', 'getValidator returns a regexp object'); + +done_testing; +