add WebGUI::GUID and make WebGUI::Session::Id a wrapper around that
This commit is contained in:
Graham Knop
parent
cd0986ecdf
commit
e71e95544f
3 changed files with 158 additions and 138 deletions
130
lib/WebGUI/GUID.pm
Normal file
130
lib/WebGUI/GUID.pm
Normal file
|
|
@ -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<NOTE:> 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;
|
||||
|
||||
|
|
@ -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;
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue