use 5.006;
use strict;
use warnings;
package Data::GUID::Any;
# ABSTRACT: Generic interface for GUID/UUID creation
our $VERSION = '0.005';
use IPC::Cmd;
use Exporter;
our @ISA = qw/Exporter/;
our @EXPORT_OK = qw/ guid_as_string v1_guid_as_string v4_guid_as_string/;
our ($Using_vX, $Using_v1, $Using_v4) = ("") x 3;
our $UC = 1;
#--------------------------------------------------------------------------#
my $hex = "a-z0-9";
# case insensitive, since used to check if generators are functioning
sub _looks_like_guid {
my $guid = shift;
return $guid =~ /[$hex]{8}-[$hex]{4}-[$hex]{4}-[$hex]{4}-[$hex]{12}/i;
}
#--------------------------------------------------------------------------#
sub _xc {
return $UC ? uc($_[0]) : lc($_[0]);
}
#--------------------------------------------------------------------------#
# state variables for generator closures
my ($dumt_v1, $dumt_v4, $uuid_v1, $uuid_v4) = (undef) x 4; # reset if reloaded
my %generators = (
# v1 or v4
'Data::UUID::MT' => {
type => 'module',
v1 => sub {
$dumt_v1 ||= Data::UUID::MT->new(version => 1);
return _xc( $dumt_v1->create_string );
},
v4 => sub {
$dumt_v4 ||= Data::UUID::MT->new(version => 4);
return _xc( $dumt_v4->create_string );
},
},
'Data::UUID::LibUUID' => {
type => 'module',
v1 => sub { return _xc( Data::UUID::LibUUID::new_uuid_string(2) ) },
v4 => sub { return _xc( Data::UUID::LibUUID::new_uuid_string(4) ) },
vX => sub { return _xc( Data::UUID::LibUUID::new_uuid_string() ) },
},
'UUID::Tiny' => {
type => 'module',
v1 => sub { return _xc( UUID::Tiny::create_UUID_as_string(UUID::Tiny::UUID_V1()) ) },
v4 => sub { return _xc( UUID::Tiny::create_UUID_as_string(UUID::Tiny::UUID_V4()) ) },
},
'uuid' => {
type => 'binary',
v1 => sub {
$uuid_v1 ||= IPC::Cmd::can_run('uuid');
chomp( my $guid = qx/$uuid_v1 -v1/ ); return _xc( $guid );
},
v4 => sub {
$uuid_v4 ||= IPC::Cmd::can_run('uuid');
chomp( my $guid = qx/$uuid_v4 -v4/ ); return _xc( $guid );
},
},
# v1 only
'Data::GUID' => {
type => 'module',
v1 => sub { return _xc( Data::GUID->new->as_string ) },
},
'Data::UUID' => {
type => 'module',
v1 => sub { return _xc( Data::UUID->new->create_str ) },
},
# system dependent or custom
'UUID' => {
type => 'module',
vX => sub { my ($u,$s); UUID::generate($u); UUID::unparse($u, $s); return _xc( $s ) },
},
'Win32' => {
type => 'module',
vX => sub { my $guid = Win32::GuidGen(); return _xc( substr($guid,1,-1) ) },
},
'APR::UUID' => {
type => 'module',
vX => sub { return _xc( APR::UUID->new->format ) },
},
);
our $NO_BINARY; # for testing
sub _is_available {
my ($name) = @_;
if ( $generators{$name}{type} eq 'binary' ) {
return $NO_BINARY ? undef : IPC::Cmd::can_run($name);
}
else {
return eval "require $name";
}
}
sub _best_generator {
my ($list) = @_;
for my $option ( @$list ) {
my ($name, $version) = @$option;
next unless my $g = $generators{$name};
next unless _is_available($name);
return ($name, $g->{$version})
if $g->{$version} && _looks_like_guid( $g->{$version}->() );
}
return;
}
#--------------------------------------------------------------------------#
my %sets = (
any => [
['Data::UUID::MT' => 'v4'],
['Data::GUID' => 'v1'],
['Data::UUID' => 'v1'],
['Data::UUID::LibUUID' => 'vX'],
['UUID' => 'vX'],
['Win32' => 'vX'],
['uuid' => 'v1'],
['APR::UUID' => 'vX'],
['UUID::Tiny' => 'v1'],
],
v1 => [
['Data::UUID::MT' => 'v1'],
['Data::GUID' => 'v1'],
['Data::UUID' => 'v1'],
['Data::UUID::LibUUID' => 'v1'],
['uuid' => 'v1'],
['UUID::Tiny' => 'v1'],
],
v4 => [
['Data::UUID::MT' => 'v4'],
['Data::UUID::LibUUID' => 'v4'],
['uuid' => 'v4'],
['UUID::Tiny' => 'v4'],
],
);
sub _generator_set { return $sets{$_[0]} }
{
no warnings qw/once redefine/;
{
my ($n, $s) = _best_generator(_generator_set("any"));
die "Couldn't find a GUID provider" unless $n;
*guid_as_string = $s;
$Using_vX = $n;
}
{
my ($n, $s) = _best_generator(_generator_set("v1"));
*v1_guid_as_string = $s || sub { die "No v1 GUID provider found\n" };
$Using_v1 = $n || '';
}
{
my ($n, $s) = _best_generator(_generator_set("v4"));
*v4_guid_as_string = $s || sub { die "No v4 GUID provider found\n" };
$Using_v4 = $n || '';
}
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Data::GUID::Any - Generic interface for GUID/UUID creation
=head1 VERSION
version 0.005
=head1 SYNOPSIS
use Data::GUID::Any 'guid_as_string';
my $guid = guid_as_string();
=head1 DESCRIPTION
This module is a generic wrapper around various ways of obtaining Globally
Unique ID's (GUID's), also known as Universally Unique Identifiers (UUID's).
On installation, if Data::GUID::Any can't detect a way of generating both
version 1 and version 4 GUID's, it will add either Data::UUID::MT or UUID::Tiny
as a prerequisite, depending on whether or not a compiler is available.
For legacy compatibility with L<Data::UUID>, guid strings are returned uppercase,
even though RFC 4122 specifies that generators should provide lower-case strings.
To force lower case results from Data::GUID::Any, set C<$Data::GUID::Any::UC>
to a false value.
local $Data::GUID::Any::UC;
guid_as_string(); # will be lower case
=head1 USAGE
The following functions are available for export.
=head2 guid_as_string()
my $guid = guid_as_string();
Returns a guid in string format with upper-case hex characters:
FA2D5B34-23DB-11DE-B548-0018F34EC37C
This is the most general subroutine that offers the least amount of control
over the result. This routine returns whatever is the default type of GUID for
a source, which could be version 1 or version 4 (or, in the case of Win32,
something resembling a version 1, but specific to Microsoft).
It will use any of the following sources, listed from most preferred to least
preferred:
=over 4
=item *
L<Data::UUID::MT> (v4)
=item *
L<Data::GUID> (v1)
=item *
L<Data::UUID> (v1)
=item *
L<Data::UUID::LibUUID> (v4 or v1)
=item *
L<UUID> (v4 or v1)
=item *
L<Win32> (using GuidGen()) (similar to v1)
=item *
uuid (external program) (v1)
=item *
L<APR::UUID> (v4 or v1)
=item *
L<UUID::Tiny> (v1)
=back
At least one of them is guaranteed to exist or Data::GUID::Any will
throw an exception when loaded. This shouldn't happen if prerequisites
were correctly installed.
=head2 v1_guid_as_string()
my $guid = v1_guid_as_string();
Returns a version 1 (timestamp+MAC/random-identifier) GUID in string format
with upper-case hex characters from one of the following sources:
=over 4
=item *
L<Data::UUID::MT>
=item *
L<Data::GUID>
=item *
L<Data::UUID>
=item *
L<Data::UUID::LibUUID>
=item *
uuid (external program)
=item *
L<UUID::Tiny>
=back
If none of them are available, an exception will be thrown when this is called.
This shouldn't happen if prerequisites were correctly installed.
=head2 v4_guid_as_string()
my $guid = v4_guid_as_string();
Returns a version 4 (random) GUID in string format with upper-case hex
characters from one of the following modules:
=over 4
=item *
L<Data::UUID::MT>
=item *
L<Data::UUID::LibUUID>
=item *
uuid (external program)
=item *
L<UUID::Tiny>
=back
If none of them are available, an exception will be thrown when this is called.
This shouldn't happen if prerequisites were correctly installed.
=head1 SEE ALSO
=over 4
=item *
RFC 4122 [http://tools.ietf.org/html/rfc4122]
=back
=for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan
=head1 SUPPORT
=head2 Bugs / Feature Requests
Please report any bugs or feature requests through the issue tracker
at L<https://github.com/dagolden/Data-GUID-Any/issues>.
You will be notified automatically of any progress on your issue.
=head2 Source Code
This is open source software. The code repository is available for
public review and contribution under the terms of the license.
L<https://github.com/dagolden/Data-GUID-Any>
git clone https://github.com/dagolden/Data-GUID-Any.git
=head1 AUTHOR
David Golden <dagolden@cpan.org>
=head1 COPYRIGHT AND LICENSE
This software is Copyright (c) 2018 by David Golden.
This is free software, licensed under:
The Apache License, Version 2.0, January 2004
=cut
