oqapi/webgui
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

add WebGUI::GUID and make WebGUI::Session::Id a wrapper around that

Browse source
This commit is contained in:
Graham Knop 2010-11-19 18:32:39 -06:00
parent cd0986ecdf
commit e71e95544f
3 changed files with 158 additions and 138 deletions
Download patch file Download diff file Expand all files Collapse all files

130
lib/WebGUI/GUID.pm Normal file
View 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;

133
lib/WebGUI/Session/Id.pm
View file

@ -16,13 +16,7 @@ package WebGUI::Session::Id;
=cut =cut
use strict; use strict;
use Digest::MD5 (); use WebGUI::GUID;
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}$/;
=head1 NAME =head1 NAME
@ -44,128 +38,17 @@ These methods are available from this class:
=cut =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 { sub new {
my $class = shift; my $class = shift;
my $seed = shift; return bless {}, $class;
my $self = bless { _seed => $seed }, $class;
return $self;
} }
#------------------------------------------------------------------- for my $sub (qw(fromHex getValidator generate toHex valid)) {
no strict 'refs';
=head2 seed ( ) *{$sub} = sub {
goto &{"WebGUI::GUID::$sub"};
Returns the seed that be used for salting the data sent to MD5. };
=cut
sub seed {
my $self = shift;
return $self->{_seed};
} }
#-------------------------------------------------------------------
=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; 1;

33
t/Session/Id.t
View file

@ -50,23 +50,27 @@ my @testSets = (
my $session = WebGUI::Test->session; my $session = WebGUI::Test->session;
plan tests => scalar(@testSets) + 6;
# generate # generate
my $generateId = $session->id->generate(); my $generateId = $session->id->generate();
is(length($generateId), 22, "generate() - length of 22 characters"); is(length($generateId), 22, "generate() - length of 22 characters");
my @uniqueIds;
my $isUnique = 1; my %uniqueIds;
my $isValid = 1; GEN_LOOP: {
for (1..2000) { for (1..2000) {
last unless $isUnique; my $id = $session->id->generate();
my $id = $session->id->generate(); if (! $session->id->valid($id)) {
$isUnique = ($isUnique ? ! ($id ~~ @uniqueIds) : 0); fail "GUID $id is valid";
$isValid = ($isValid ? $session->id->valid($id) : 0); last GEN_LOOP;
push(@uniqueIds,$id); }
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) { foreach my $testSet (@testSets) {
is($session->id->valid($testSet->{guid}), $testSet->{valid}, $testSet->{comment}); 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; my $re = $session->id->getValidator;
is( ref $re, 'Regexp', 'getValidator returns a regexp object'); is( ref $re, 'Regexp', 'getValidator returns a regexp object');
done_testing;