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
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;