diff options
Diffstat (limited to 'shared/ossp_uuid/perl')
| -rw-r--r-- | shared/ossp_uuid/perl/MANIFEST | 10 | ||||
| -rw-r--r-- | shared/ossp_uuid/perl/Makefile.PL | 68 | ||||
| -rw-r--r-- | shared/ossp_uuid/perl/uuid.pm | 334 | ||||
| -rw-r--r-- | shared/ossp_uuid/perl/uuid.pod | 207 | ||||
| -rw-r--r-- | shared/ossp_uuid/perl/uuid.tm | 39 | ||||
| -rw-r--r-- | shared/ossp_uuid/perl/uuid.ts | 171 | ||||
| -rw-r--r-- | shared/ossp_uuid/perl/uuid.xs | 236 | ||||
| -rw-r--r-- | shared/ossp_uuid/perl/uuid_compat.pm | 176 | ||||
| -rw-r--r-- | shared/ossp_uuid/perl/uuid_compat.pod | 55 | ||||
| -rw-r--r-- | shared/ossp_uuid/perl/uuid_compat.ts | 55 |
10 files changed, 1351 insertions, 0 deletions
diff --git a/shared/ossp_uuid/perl/MANIFEST b/shared/ossp_uuid/perl/MANIFEST new file mode 100644 index 00000000..d9722036 --- /dev/null +++ b/shared/ossp_uuid/perl/MANIFEST @@ -0,0 +1,10 @@ +MANIFEST +Makefile.PL +uuid.xs +uuid.tm +uuid.pm +uuid.pod +uuid.ts +uuid_compat.pm +uuid_compat.pod +uuid_compat.ts diff --git a/shared/ossp_uuid/perl/Makefile.PL b/shared/ossp_uuid/perl/Makefile.PL new file mode 100644 index 00000000..92f4494f --- /dev/null +++ b/shared/ossp_uuid/perl/Makefile.PL @@ -0,0 +1,68 @@ +## +## OSSP uuid - Universally Unique Identifier +## Copyright (c) 2004-2007 Ralf S. Engelschall <rse@engelschall.com> +## Copyright (c) 2004-2007 The OSSP Project <http://www.ossp.org/> +## +## This file is part of OSSP uuid, a library for the generation +## of UUIDs which can found at http://www.ossp.org/pkg/lib/uuid/ +## +## Permission to use, copy, modify, and distribute this software for +## any purpose with or without fee is hereby granted, provided that +## the above copyright notice and this permission notice appear in all +## copies. +## +## THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESSED OR IMPLIED +## WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +## MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. +## IN NO EVENT SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR +## CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +## SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +## LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF +## USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +## ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +## OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT +## OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +## SUCH DAMAGE. +## +## Makefile.PL: Perl MakeMaker build source procedure +## + +require 5.008; + +use Config; +use ExtUtils::MakeMaker; + +# determine source directory +my ($srcdir) = map { my $d = $_; $d =~ s/\/libuuid\.la$//; $d } + grep { -f $_ } ("../libuuid.la", glob("../*/libuuid.la")) + or die "no source directory found (where libuuid.la is located)"; + +# determine extra build options +my $compat = 0; +@ARGV = grep { $_ =~ m/^COMPAT=(\d+)$/i ? ($compat = $1, 0) : 1 } @ARGV; + +# generate Makefile +WriteMakefile( + NAME => 'OSSP::uuid', + VERSION_FROM => 'uuid.pm', + ABSTRACT_FROM => 'uuid.pod', + PREREQ_PM => {}, + LIBS => [ "-L$srcdir/.libs -L$srcdir -luuid" ], + DEFINE => '', + INC => "-I. -I$srcdir", + PM => { 'uuid.pm' => '$(INST_LIBDIR)/uuid.pm', + 'uuid.pod' => '$(INST_LIBDIR)/uuid.pod', + ($compat ? ('uuid_compat.pm' => '$(INST_LIBDIR)/../Data/UUID.pm') : ()), + ($compat ? ('uuid_compat.pod' => '$(INST_LIBDIR)/../Data/UUID.pod') : ()), }, + MAN3PODS => { 'uuid.pod' => '$(INST_MAN3DIR)/OSSP::uuid.3', + ($compat ? ('uuid_compat.pod' => '$(INST_MAN3DIR)/Data::UUID.3') : ()), }, + TYPEMAPS => [ 'uuid.tm' ], + test => { TESTS => 'uuid.ts' . ($compat ? ' uuid_compat.ts' : '') }, + NO_META => 1, + # cruel hack to workaround the conflict between OSSP uuid's + # uuid_create() function and one from FreeBSD's libc + (( "$Config{'osname'}$Config{'osvers'}" =~ m/^freebsd[56]\./ + and $Config{'ld'} =~ m/cc$/ and -f "/usr/include/uuid.h") ? + ( LDDLFLAGS => $Config{'lddlflags'} . ' -Wl,-Bsymbolic') : ()) +); + diff --git a/shared/ossp_uuid/perl/uuid.pm b/shared/ossp_uuid/perl/uuid.pm new file mode 100644 index 00000000..b3223966 --- /dev/null +++ b/shared/ossp_uuid/perl/uuid.pm @@ -0,0 +1,334 @@ +## +## OSSP uuid - Universally Unique Identifier +## Copyright (c) 2004-2007 Ralf S. Engelschall <rse@engelschall.com> +## Copyright (c) 2004-2007 The OSSP Project <http://www.ossp.org/> +## +## This file is part of OSSP uuid, a library for the generation +## of UUIDs which can found at http://www.ossp.org/pkg/lib/uuid/ +## +## Permission to use, copy, modify, and distribute this software for +## any purpose with or without fee is hereby granted, provided that +## the above copyright notice and this permission notice appear in all +## copies. +## +## THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESSED OR IMPLIED +## WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +## MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. +## IN NO EVENT SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR +## CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +## SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +## LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF +## USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +## ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +## OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT +## OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +## SUCH DAMAGE. +## +## uuid.pm: Perl Binding (Perl part) +## + +## +## High-Level Perl Module TIE-style API +## (just a functionality-reduced TIE wrapper around the OO-style API) +## + +package OSSP::uuid::tie; + +use 5.008; +use strict; +use warnings; +use Carp; + +# inhert from Tie::Scalar +require Tie::Scalar; +our @ISA = qw(Tie::Scalar); + +# helper function +sub mode_sanity { + my ($mode) = @_; + if (not ( defined($mode) + and ref($mode) eq 'ARRAY' + and ( (@{$mode} == 1 and $mode->[0] =~ m|^v[14]$|) + or (@{$mode} == 3 and $mode->[0] =~ m|^v[35]$|)))) { + return (undef, "invalid UUID generation mode specification"); + } + if ($mode->[0] =~ m|^v[35]$|) { + my $uuid_ns = new OSSP::uuid; + $uuid_ns->load($mode->[1]) + or return (undef, "failed to load UUID $mode->[0] namespace"); + $mode->[1] = $uuid_ns; + } + return ($mode, undef); +} + +# constructor +sub TIESCALAR { + my ($class, @args) = @_; + my $self = {}; + bless ($self, $class); + $self->{-uuid} = new OSSP::uuid + or croak "failed to create OSSP::uuid object"; + my ($mode, $error) = mode_sanity(defined($args[0]) ? [ @args ] : [ "v1" ]); + croak $error if defined($error); + $self->{-mode} = $mode; + return $self; +} + +# destructor +sub DESTROY { + my ($self) = @_; + delete $self->{-uuid}; + delete $self->{-mode}; + return; +} + +# fetch value from scalar +# (applied semantic: export UUID in string format) +sub FETCH { + my ($self) = @_; + $self->{-uuid}->make(@{$self->{-mode}}) + or croak "failed to generate new UUID"; + my $value = $self->{-uuid}->export("str") + or croak "failed to export new UUID"; + return $value; +} + +# store value into scalar +# (applied semantic: configure new UUID generation mode) +sub STORE { + my ($self, $value) = @_; + my ($mode, $error) = mode_sanity($value); + croak $error if defined($error); + $self->{-mode} = $mode; + return; +} + +## +## High-Level Perl Module OO-style API +## (just an OO wrapper around the C-style API) +## + +package OSSP::uuid; + +use 5.008; +use strict; +use warnings; +use Carp; +use XSLoader; +use Exporter; + +# API version +our $VERSION = do { my @v = ('1.6.2' =~ m/\d+/g); sprintf("%d.".("%02d"x$#v), @v); }; + +# API inheritance +our @ISA = qw(Exporter); + +# API symbols +my $symbols = { + 'const' => [qw( + UUID_VERSION + UUID_LEN_BIN + UUID_LEN_STR + UUID_LEN_SIV + UUID_RC_OK + UUID_RC_ARG + UUID_RC_MEM + UUID_RC_SYS + UUID_RC_INT + UUID_RC_IMP + UUID_MAKE_V1 + UUID_MAKE_V3 + UUID_MAKE_V4 + UUID_MAKE_V5 + UUID_MAKE_MC + UUID_FMT_BIN + UUID_FMT_STR + UUID_FMT_SIV + UUID_FMT_TXT + )], + 'func' => [qw( + uuid_create + uuid_destroy + uuid_load + uuid_make + uuid_isnil + uuid_compare + uuid_import + uuid_export + uuid_error + uuid_version + )] +}; + +# API symbol exportation +our %EXPORT_TAGS = ( + 'all' => [ @{$symbols->{'const'}}, @{$symbols->{'func'}} ], + 'const' => [ @{$symbols->{'const'}} ], + 'func' => [ @{$symbols->{'func'}} ] +); +our @EXPORT_OK = @{$EXPORT_TAGS{'all'}}; +our @EXPORT = (); + +# constructor +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = {}; + bless ($self, $class); + $self->{-uuid} = undef; + $self->{-rc} = $self->UUID_RC_OK; + my $rc = uuid_create($self->{-uuid}); + if ($rc != $self->UUID_RC_OK) { + croak(sprintf("OSSP::uuid::new: uuid_create: %s (%d)", uuid_error($rc), $rc)); + return undef; + } + return $self; +} + +# destructor +sub DESTROY ($) { + my ($self) = @_; + $self->{-rc} = uuid_destroy($self->{-uuid}) if (defined($self->{-uuid})); + if ($self->{-rc} != $self->UUID_RC_OK) { + carp(sprintf("OSSP::uuid::DESTROY: uuid_destroy: %s (%d)", uuid_error($self->{-rc}), $self->{-rc})); + return; + } + $self->{-uuid} = undef; + $self->{-rc} = undef; + return; +} + +sub load ($$) { + my ($self, $name) = @_; + $self->{-rc} = uuid_load($self->{-uuid}, $name); + return ($self->{-rc} == $self->UUID_RC_OK); +} + +sub make ($$;@) { + my ($self, $mode, @valist) = @_; + my $mode_code = 0; + foreach my $spec (split(/,/, $mode)) { + if ($spec eq 'v1') { $mode_code |= $self->UUID_MAKE_V1; } + elsif ($spec eq 'v3') { $mode_code |= $self->UUID_MAKE_V3; } + elsif ($spec eq 'v4') { $mode_code |= $self->UUID_MAKE_V4; } + elsif ($spec eq 'v5') { $mode_code |= $self->UUID_MAKE_V5; } + elsif ($spec eq 'mc') { $mode_code |= $self->UUID_MAKE_MC; } + else { croak("invalid mode specification \"$spec\""); } + } + if (($mode_code & $self->UUID_MAKE_V3) or ($mode_code & $self->UUID_MAKE_V5)) { + if (not (ref($valist[0]) and $valist[0]->isa("OSSP::uuid"))) { + croak("UUID_MAKE_V3/UUID_MAKE_V5 requires namespace argument to be OSSP::uuid object"); + } + my $ns = $valist[0]->{-uuid}; + my $name = $valist[1]; + $self->{-rc} = uuid_make($self->{-uuid}, $mode_code, $ns, $name); + } + else { + $self->{-rc} = uuid_make($self->{-uuid}, $mode_code); + } + return ($self->{-rc} == $self->UUID_RC_OK); +} + +sub isnil ($) { + my ($self) = @_; + my $result; + $self->{-rc} = uuid_isnil($self->{-uuid}, $result); + return ($self->{-rc} == $self->UUID_RC_OK ? $result : undef); +} + +sub compare ($$) { + my ($self, $other) = @_; + my $result = 0; + if (not (ref($other) and $other->isa("OSSP::uuid"))) { + croak("argument has to an OSSP::uuid object"); + } + $self->{-rc} = uuid_compare($self->{-uuid}, $other->{-uuid}, $result); + return ($self->{-rc} == $self->UUID_RC_OK ? $result : undef); +} + +sub import { + # ATTENTION: The OSSP uuid API function "import" conflicts with + # the standardized "import" method the Perl world expects from + # their modules. In order to keep the Perl binding consist + # with the C API, we solve the conflict under run-time by + # distinguishing between the two types of "import" calls. + if (defined($_[0]) and ref($_[0]) =~ m/^OSSP::uuid/) { + # the regular OSSP::uuid "import" method + croak("import method expects 3 or 4 arguments") if (@_ < 3 or @_ > 4); # emulate prototype + my ($self, $fmt, $data_ptr, $data_len) = @_; + if ($fmt eq 'bin') { $fmt = $self->UUID_FMT_BIN; } + elsif ($fmt eq 'str') { $fmt = $self->UUID_FMT_STR; } + elsif ($fmt eq 'siv') { $fmt = $self->UUID_FMT_SIV; } + elsif ($fmt eq 'txt') { $fmt = $self->UUID_FMT_TXT; } + else { croak("invalid format \"$fmt\""); } + $data_len ||= length($data_ptr); # functional redudant, but Perl dislikes undef value here + $self->{-rc} = uuid_import($self->{-uuid}, $fmt, $data_ptr, $data_len); + return ($self->{-rc} == $self->UUID_RC_OK); + } + else { + # the special Perl "import" method + # (usually inherited from the Exporter) + no strict "refs"; + return OSSP::uuid->export_to_level(1, @_); + } +} + +sub export { + # ATTENTION: The OSSP uuid API function "export" conflicts with + # the standardized "export" method the Perl world expects from + # their modules. In order to keep the Perl binding consist + # with the C API, we solve the conflict under run-time by + # distinguishing between the two types of "export" calls. + if (defined($_[0]) and ref($_[0]) =~ m/^OSSP::uuid/) { + # the regular OSSP::uuid "export" method + croak("export method expects 2 arguments") if (@_ != 2); # emulate prototype + my ($self, $fmt) = @_; + my $data_ptr; + if ($fmt eq 'bin') { $fmt = $self->UUID_FMT_BIN; } + elsif ($fmt eq 'str') { $fmt = $self->UUID_FMT_STR; } + elsif ($fmt eq 'siv') { $fmt = $self->UUID_FMT_SIV; } + elsif ($fmt eq 'txt') { $fmt = $self->UUID_FMT_TXT; } + else { croak("invalid format \"$fmt\""); } + $self->{-rc} = uuid_export($self->{-uuid}, $fmt, $data_ptr, undef); + return ($self->{-rc} == $self->UUID_RC_OK ? $data_ptr : undef); + } + else { + # the special Perl "export" method + # (usually inherited from the Exporter) + return Exporter::export(@_); + } +} + +sub error ($;$) { + my ($self, $rc) = @_; + $rc = $self->{-rc} if (not defined($rc)); + return wantarray ? (uuid_error($rc), $rc) : uuid_error($rc); +} + +sub version (;$) { + my ($self) = @_; + return uuid_version(); +} + +## +## Low-Level Perl XS C-style API +## (actually just the activation of the XS part) +## + +# auto-loading constants +sub AUTOLOAD { + my $constname; + our $AUTOLOAD; + ($constname = $AUTOLOAD) =~ s/.*:://; + croak "&OSSP::uuid::constant not defined" if ($constname eq 'constant'); + my ($error, $val) = constant($constname); + croak $error if ($error); + { no strict 'refs'; *$AUTOLOAD = sub { $val }; } + goto &$AUTOLOAD; +} + +# static-loading functions +XSLoader::load('OSSP::uuid', $VERSION); + +1; + diff --git a/shared/ossp_uuid/perl/uuid.pod b/shared/ossp_uuid/perl/uuid.pod new file mode 100644 index 00000000..7c6172f0 --- /dev/null +++ b/shared/ossp_uuid/perl/uuid.pod @@ -0,0 +1,207 @@ +## +## OSSP uuid - Universally Unique Identifier +## Copyright (c) 2004-2007 Ralf S. Engelschall <rse@engelschall.com> +## Copyright (c) 2004-2007 The OSSP Project <http://www.ossp.org/> +## +## This file is part of OSSP uuid, a library for the generation +## of UUIDs which can found at http://www.ossp.org/pkg/lib/uuid/ +## +## Permission to use, copy, modify, and distribute this software for +## any purpose with or without fee is hereby granted, provided that +## the above copyright notice and this permission notice appear in all +## copies. +## +## THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESSED OR IMPLIED +## WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +## MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. +## IN NO EVENT SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR +## CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +## SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +## LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF +## USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +## ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +## OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT +## OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +## SUCH DAMAGE. +## +## uuid.pod: Perl Binding (Perl/POD part) +## + +=pod + +=head1 NAME + +OSSP::uuid - B<OSSP uuid> Perl Binding + +=head1 DESCRIPTION + +B<OSSP uuid> is a ISO-C:1999 application programming interface (API) +and corresponding command line interface (CLI) for the generation of +DCE 1.1, ISO/IEC 11578:1996 and RFC 4122 compliant I<Universally Unique +Identifier> (UUID). It supports DCE 1.1 variant UUIDs of version 1 (time +and node based), version 3 (name based, MD5), version 4 (random number +based) and version 5 (name based, SHA-1). Additional API bindings are +provided for the languages ISO-C++:1998, Perl:5 and PHP:4/5. Optional +backward compatibility exists for the ISO-C DCE-1.1 and Perl Data::UUID +APIs. + +B<OSSP::uuid> is the Perl binding to the B<OSSP uuid> API. +Three variants are provided: + +=head2 TIE-STYLE API + +The TIE-style API is a functionality-reduced wrapper around the OO-style +API and intended for very high-level convenience programming: + +=over 4 + +=item C<use OSSP::uuid;> + +=item B<tie>C< my $uuid, 'OSSP::uuid::tie', $mode, ...;> + +=item C<$uuid = [ $mode, ... ];> + +=item C<print "UUID=$uuid\n";> + +=item C<untie $uuid;> + +=back + +=head2 OO-STYLE API + +The OO-style API is a wrapper around the C-style API and intended for +high-level regular programming. + +=over 4 + +=item C<use OSSP::uuid;> + +=item C<my $uuid = >B<new>C< OSSP::uuid;> + +=item C<$uuid-E<gt>>B<load>C<($name);> + +=item C<$uuid-E<gt>>B<make>C<($mode, ...);> + +=item C<$result = $uuid-E<gt>>B<isnil>C<();> + +=item C<$result = $uuid-E<gt>>B<compare>C<($uuid2);> + +=item C<$uuid-E<gt>>B<import>C<($fmt, $data_ptr);> + +=item C<$data_ptr = $uuid-E<gt>>B<export>C<($fmt);> + +=item C<[(]$str[, $rc)] = $uuid-E<gt>>B<error>C<();> + +=item C<$ver = $uuid-E<gt>>B<version>C<();> + +=item C<undef $uuid;> + +=back + +Additionally, the strings C<"v1">, C<"v3">, C<"v4">, C<"v5"> and C<"mc"> +can be used in C<$mode> and the strings C<"bin">, C<"str">, and C<"txt"> +can be used for C<$fmt>. + +=head2 C-STYLE API + +The C-style API is a direct mapping +of the B<OSSP uuid> ISO-C API to Perl and is intended for low-level +programming. See uuid(3) for a description of the functions and +their expected arguments. + +=over 4 + +=item C<use OSSP::uuid qw(:all);> + +=item C<my $uuid; $rc = >B<uuid_create>C<($uuid);> + +=item C<$rc = >B<uuid_load>C<($uuid, $name);> + +=item C<$rc = >B<uuid_make>C<($uuid, $mode, ...);> + +=item C<$rc = >B<uuid_isnil>C<($uuid, $result);> + +=item C<$rc = >B<uuid_compare>C<($uuid, $uuid2, $result);> + +=item C<$rc = >B<uuid_import>C<($uuid, $fmt, $data_ptr, $data_len);> + +=item C<$rc = >B<uuid_export>C<($uuid, $fmt, $data_ptr, $data_len);> + +=item C<$str = >B<uuid_error>C<($rc);> + +=item C<$ver = >B<uuid_version>C<();> + +=item C<$rc = >B<uuid_destroy>C<($uuid);> + +=back + +Additionally, the following constants are exported for use in C<$rc>, C<$mode>, C<$fmt> and C<$ver>: + +C<UUID_VERSION>, +C<UUID_LEN_BIN>, +C<UUID_LEN_STR>, +C<UUID_RC_OK>, +C<UUID_RC_ARG>, +C<UUID_RC_MEM>, +C<UUID_RC_SYS>, +C<UUID_RC_INT>, +C<UUID_RC_IMP>, +C<UUID_MAKE_V1>, +C<UUID_MAKE_V3>, +C<UUID_MAKE_V4>, +C<UUID_MAKE_V5>, +C<UUID_MAKE_MC>, +C<UUID_FMT_BIN>, +C<UUID_FMT_STR>, +C<UUID_FMT_SIV>, +C<UUID_FMT_TXT>. + +=head1 EXAMPLES + +The following two examples create the version 3 UUID +C<02d9e6d5-9467-382e-8f9b-9300a64ac3cd>, both via the OO-style and the +C-style API. Error handling is omitted here for easier reading, but has +to be added for production-quality code. + + # TIE-style API (very high-level) + use OSSP::uuid; + tie my $uuid, 'OSSP::uuid::tie'; + $uuid = [ "v1" ]; + print "UUIDs: $uuid, $uuid, $uuid\n"; + $uuid = [ "v3", "ns:URL", "http://www.ossp.org/" ]; + print "UUIDs: $uuid, $uuid, $uuid\n"; + untie $uuid; + + # OO-style API (high-level) + use OSSP::uuid; + my $uuid = new OSSP::uuid; + my $uuid_ns = new OSSP::uuid; + $uuid_ns->load("ns:URL"); + $uuid->make("v3", $uuid_ns, "http://www.ossp.org/"); + undef $uuid_ns; + my $str = $uuid->export("str"); + undef $uuid; + print "$str\n"; + + # C-style API (low-level) + use OSSP::uuid qw(:all); + my $uuid; uuid_create($uuid); + my $uuid_ns; uuid_create($uuid_ns); + uuid_load($uuid_ns, "ns:URL"); + uuid_make($uuid, UUID_MAKE_V3, $uuid_ns, "http://www.ossp.org/"); + uuid_destroy($uuid_ns); + my $str; uuid_export($uuid, UUID_FMT_STR, $str, undef); + uuid_destroy($uuid); + print "$str\n"; + +=head1 SEE ALSO + +uuid(1), uuid-config(1), uuid(3). + +=head1 HISTORY + +The Perl binding B<OSSP::uuid> to B<OSSP uuid> was implemented in +November 2004 by Ralf S. Engelschall E<lt>rse@engelschall.comE<gt>. + +=cut + diff --git a/shared/ossp_uuid/perl/uuid.tm b/shared/ossp_uuid/perl/uuid.tm new file mode 100644 index 00000000..71ac32f6 --- /dev/null +++ b/shared/ossp_uuid/perl/uuid.tm @@ -0,0 +1,39 @@ +## +## OSSP uuid - Universally Unique Identifier +## Copyright (c) 2004-2007 Ralf S. Engelschall <rse@engelschall.com> +## Copyright (c) 2004-2007 The OSSP Project <http://www.ossp.org/> +## +## This file is part of OSSP uuid, a library for the generation +## of UUIDs which can found at http://www.ossp.org/pkg/lib/uuid/ +## +## Permission to use, copy, modify, and distribute this software for +## any purpose with or without fee is hereby granted, provided that +## the above copyright notice and this permission notice appear in all +## copies. +## +## THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESSED OR IMPLIED +## WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +## MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. +## IN NO EVENT SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR +## CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +## SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +## LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF +## USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +## ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +## OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT +## OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +## SUCH DAMAGE. +## +## uuid.tm: Perl XS typemap for xsubpp(1) +## + +TYPEMAP +uuid_t * T_PTRREF +uuid_t ** T_PTRREF +uuid_rc_t T_IV +uuid_fmt_t T_IV +int * T_PV +size_t * T_PV +const void * T_PV +void ** T_PV + diff --git a/shared/ossp_uuid/perl/uuid.ts b/shared/ossp_uuid/perl/uuid.ts new file mode 100644 index 00000000..298e26de --- /dev/null +++ b/shared/ossp_uuid/perl/uuid.ts @@ -0,0 +1,171 @@ +## +## OSSP uuid - Universally Unique Identifier +## Copyright (c) 2004-2007 Ralf S. Engelschall <rse@engelschall.com> +## Copyright (c) 2004-2007 The OSSP Project <http://www.ossp.org/> +## +## This file is part of OSSP uuid, a library for the generation +## of UUIDs which can found at http://www.ossp.org/pkg/lib/uuid/ +## +## Permission to use, copy, modify, and distribute this software for +## any purpose with or without fee is hereby granted, provided that +## the above copyright notice and this permission notice appear in all +## copies. +## +## THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESSED OR IMPLIED +## WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +## MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. +## IN NO EVENT SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR +## CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +## SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +## LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF +## USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +## ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +## OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT +## OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +## SUCH DAMAGE. +## +## uuid.ts: Perl Binding (Perl test suite part) +## + +use Test::More tests => 36; + +## +## Module Loading +## + +BEGIN { + use_ok('OSSP::uuid'); +}; +BEGIN { + use OSSP::uuid qw(:all); + ok(defined(UUID_VERSION), "UUID_VERSION"); + ok(UUID_RC_OK == 0, "UUID_RC_OK"); +}; + +## +## C-Style API +## + +my ($rc, $result, $uuid, $uuid_ns, $str, $ptr, $len); + +$rc = uuid_create($uuid); +ok($rc == UUID_RC_OK, "uuid_create (1)"); +$rc = uuid_create($uuid_ns); +ok($rc == UUID_RC_OK, "uuid_create (2)"); + +$rc = uuid_isnil($uuid, $result); +ok(($rc == UUID_RC_OK and $result == 1), "uuid_isnil (1)"); +$rc = uuid_isnil($uuid_ns, $result); +ok(($rc == UUID_RC_OK and $result == 1), "uuid_isnil (2)"); +$rc = uuid_compare($uuid, $uuid_ns, $result); +ok(($rc == UUID_RC_OK and $result == 0), "uuid_compare (1)"); +$rc = uuid_export($uuid, UUID_FMT_STR, $ptr, $len); +ok(( $rc == UUID_RC_OK + and $ptr eq "00000000-0000-0000-0000-000000000000" + and $len == UUID_LEN_STR), "uuid_export (1)"); + +$rc = uuid_load($uuid_ns, "ns:URL"); +ok($rc == UUID_RC_OK, "uuid_load (1)"); +$rc = uuid_export($uuid_ns, UUID_FMT_STR, $ptr, $len); +ok(( $rc == UUID_RC_OK + and $ptr eq "6ba7b811-9dad-11d1-80b4-00c04fd430c8" + and $len == UUID_LEN_STR), "uuid_export (2)"); + +$rc = uuid_make($uuid, UUID_MAKE_V3, $uuid_ns, "http://www.ossp.org/"); +ok($rc == UUID_RC_OK, "uuid_make (1)"); +$rc = uuid_export($uuid, UUID_FMT_STR, $ptr, $len); +ok(( $rc == UUID_RC_OK + and $ptr eq "02d9e6d5-9467-382e-8f9b-9300a64ac3cd" + and $len == UUID_LEN_STR), "uuid_export (3)"); + +$rc = uuid_export($uuid, UUID_FMT_BIN, $ptr, $len); +ok(( $rc == UUID_RC_OK + and $len == UUID_LEN_BIN), "uuid_export (4)"); +$rc = uuid_import($uuid_ns, UUID_FMT_BIN, $ptr, $len); +ok($rc == UUID_RC_OK, "uuid_import (1)"); +$rc = uuid_export($uuid_ns, UUID_FMT_STR, $ptr, $len); +ok(( $rc == UUID_RC_OK + and $ptr eq "02d9e6d5-9467-382e-8f9b-9300a64ac3cd" + and $len == UUID_LEN_STR), "uuid_export (5)"); +$rc = uuid_export($uuid_ns, UUID_FMT_SIV, $ptr, $len); +ok(( $rc == UUID_RC_OK + and $ptr eq "3789866285607910888100818383505376205" + and $len <= UUID_LEN_SIV), "uuid_export (6)"); + +$rc = uuid_destroy($uuid_ns); +ok($rc == UUID_RC_OK, "uuid_destroy (1)"); +$rc = uuid_destroy($uuid); +ok($rc == UUID_RC_OK, "uuid_destroy (2)"); + +## +## OO-style API +## + +$uuid = new OSSP::uuid; +ok(defined($uuid), "new OSSP::uuid (1)"); +$uuid_ns = new OSSP::uuid; +ok(defined($uuid_ns), "new OSSP::uuid (2)"); + +$rc = $uuid->isnil(); +ok((defined($rc) and $rc == 1), "isnil (1)"); +$rc = $uuid_ns->isnil(); +ok((defined($rc) and $rc == 1), "isnil (2)"); + +$rc = $uuid->compare($uuid_ns); +ok((defined($rc) and $rc == 0), "compare (1)"); + +$ptr = $uuid->export("str"); +ok(( defined($ptr) + and $ptr eq "00000000-0000-0000-0000-000000000000" + and length($ptr) == UUID_LEN_STR), "export (1)"); + +$rc = $uuid_ns->load("ns:URL"); +ok(defined($rc), "uuid_load (1)"); +$ptr = $uuid_ns->export("str"); +ok(( defined($ptr) + and $ptr eq "6ba7b811-9dad-11d1-80b4-00c04fd430c8" + and length($ptr) == UUID_LEN_STR), "export (2)"); + +$rc = $uuid->make("v3", $uuid_ns, "http://www.ossp.org/"); +ok(defined($rc), "make (1)"); +$ptr = $uuid->export("str"); +ok(( defined($ptr) + and $ptr eq "02d9e6d5-9467-382e-8f9b-9300a64ac3cd" + and length($ptr) == UUID_LEN_STR), "export (3)"); + +$ptr = $uuid->export("bin"); +ok(( defined($ptr) + and length($ptr) == UUID_LEN_BIN), "export (4)"); +$rc = $uuid_ns->import("bin", $ptr); +ok(defined($rc), "import (1)"); +$ptr = $uuid_ns->export("str"); +ok(( defined($ptr) + and $ptr eq "02d9e6d5-9467-382e-8f9b-9300a64ac3cd" + and length($ptr) == UUID_LEN_STR), "export (5)"); + +undef $uuid; +undef $uuid_ns; + +## +## TIE API +## + +$uuid = new OSSP::uuid; + +tie my $var, 'OSSP::uuid::tie'; + +my $val_get1 = $var; +my $val_get2 = $var; +ok($val_get1 ne $val_get2, "subsequent generation"); + +$uuid->import("str", $val_get1); +my $val_cmp1 = $uuid->export("str"); +$uuid->import("str", $val_get2); +my $val_cmp2 = $uuid->export("str"); +ok($val_get1 eq $val_cmp1, "validity comparison 1"); +ok($val_get2 eq $val_cmp2, "validity comparison 2"); + +$var = [ "v3", "ns:URL", "http://www.ossp.org/" ]; +$val_get1 = $var; +ok($val_get1 eq "02d9e6d5-9467-382e-8f9b-9300a64ac3cd", "generation of UUID v3"); + diff --git a/shared/ossp_uuid/perl/uuid.xs b/shared/ossp_uuid/perl/uuid.xs new file mode 100644 index 00000000..a9ed41d2 --- /dev/null +++ b/shared/ossp_uuid/perl/uuid.xs @@ -0,0 +1,236 @@ +/* +** OSSP uuid - Universally Unique Identifier +** Copyright (c) 2004-2007 Ralf S. Engelschall <rse@engelschall.com> +** Copyright (c) 2004-2007 The OSSP Project <http://www.ossp.org/> +** +** This file is part of OSSP uuid, a library for the generation +** of UUIDs which can found at http://www.ossp.org/pkg/lib/uuid/ +** +** Permission to use, copy, modify, and distribute this software for +** any purpose with or without fee is hereby granted, provided that +** the above copyright notice and this permission notice appear in all +** copies. +** +** THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESSED OR IMPLIED +** WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +** MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. +** IN NO EVENT SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR +** CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +** SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +** LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF +** USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +** ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +** OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT +** OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +** SUCH DAMAGE. +** +** uuid.xs: Perl Binding (Perl/XS part) +*/ + +#include "uuid.h" + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +MODULE = OSSP::uuid PACKAGE = OSSP::uuid + +void +constant(sv) + PREINIT: + dXSTARG; + STRLEN len; + int i; + static struct { + const char *name; + int value; + } constant_table[] = { + { "UUID_VERSION", UUID_VERSION }, + { "UUID_LEN_BIN", UUID_LEN_BIN }, + { "UUID_LEN_STR", UUID_LEN_STR }, + { "UUID_LEN_SIV", UUID_LEN_SIV }, + { "UUID_RC_OK", UUID_RC_OK }, + { "UUID_RC_ARG", UUID_RC_ARG }, + { "UUID_RC_MEM", UUID_RC_MEM }, + { "UUID_RC_SYS", UUID_RC_SYS }, + { "UUID_RC_INT", UUID_RC_INT }, + { "UUID_RC_IMP", UUID_RC_IMP }, + { "UUID_MAKE_V1", UUID_MAKE_V1 }, + { "UUID_MAKE_V3", UUID_MAKE_V3 }, + { "UUID_MAKE_V4", UUID_MAKE_V4 }, + { "UUID_MAKE_V5", UUID_MAKE_V5 }, + { "UUID_MAKE_MC", UUID_MAKE_MC }, + { "UUID_FMT_BIN", UUID_FMT_BIN }, + { "UUID_FMT_STR", UUID_FMT_STR }, + { "UUID_FMT_SIV", UUID_FMT_SIV }, + { "UUID_FMT_TXT", UUID_FMT_TXT } + }; + INPUT: + SV *sv; + const char *s = SvPV(sv, len); + PPCODE: + for (i = 0; i < sizeof(constant_table)/sizeof(constant_table[0]); i++) { + if (strcmp(s, constant_table[i].name) == 0) { + EXTEND(SP, 1); + PUSHs(&PL_sv_undef); + PUSHi(constant_table[i].value); + break; + } + } + if (i == sizeof(constant_table)/sizeof(constant_table[0])) { + sv = sv_2mortal(newSVpvf("unknown contant OSSP::uuid::%s", s)); + PUSHs(sv); + } + + +uuid_rc_t +uuid_create(uuid) + PROTOTYPE: + $ + INPUT: + uuid_t *&uuid = NO_INIT + CODE: + RETVAL = uuid_create(&uuid); + OUTPUT: + uuid + RETVAL + +uuid_rc_t +uuid_destroy(uuid) + PROTOTYPE: + $ + INPUT: + uuid_t *uuid + CODE: + RETVAL = uuid_destroy(uuid); + OUTPUT: + RETVAL + +uuid_rc_t +uuid_load(uuid,name) + PROTOTYPE: + $$ + INPUT: + uuid_t *uuid + const char *name + CODE: + RETVAL = uuid_load(uuid, name); + OUTPUT: + RETVAL + +uuid_rc_t +uuid_make(uuid,mode,...) + PROTOTYPE: + $$;$$ + INPUT: + uuid_t *uuid + unsigned int mode + PREINIT: + uuid_t *ns; + const char *name; + CODE: + if ((mode & UUID_MAKE_V3) || (mode & UUID_MAKE_V5)) { + if (items != 4) + croak("mode UUID_MAKE_V3/UUID_MAKE_V5 requires two additional arguments to uuid_make()"); + if (!SvROK(ST(2))) + croak("mode UUID_MAKE_V3/UUID_MAKE_V5 requires a UUID object as namespace"); + ns = INT2PTR(uuid_t *, SvIV((SV*)SvRV(ST(2)))); + name = (const char *)SvPV_nolen(ST(3)); + RETVAL = uuid_make(uuid, mode, ns, name); + } + else { + if (items != 2) + croak("invalid number of arguments to uuid_make()"); + RETVAL = uuid_make(uuid, mode); + } + OUTPUT: + RETVAL + +uuid_rc_t +uuid_isnil(uuid,result) + PROTOTYPE: + $$ + INPUT: + uuid_t *uuid + int &result = NO_INIT + CODE: + RETVAL = uuid_isnil(uuid, &result); + OUTPUT: + result + RETVAL + +uuid_rc_t +uuid_compare(uuid,uuid2,result) + PROTOTYPE: + $$$ + INPUT: + uuid_t *uuid + uuid_t *uuid2 + int &result = NO_INIT + CODE: + RETVAL = uuid_compare(uuid, uuid2, &result); + OUTPUT: + result + RETVAL + +uuid_rc_t +uuid_import(uuid,fmt,data_ptr,data_len) + PROTOTYPE: + $$$$ + INPUT: + uuid_t *uuid + uuid_fmt_t fmt + const void *data_ptr + size_t data_len + CODE: + if (ST(3) == &PL_sv_undef) + data_len = sv_len(ST(2)); + RETVAL = uuid_import(uuid, fmt, data_ptr, data_len); + OUTPUT: + RETVAL + +uuid_rc_t +uuid_export(uuid,fmt,data_ptr,data_len) + PROTOTYPE: + $$$$ + INPUT: + uuid_t *uuid + uuid_fmt_t fmt + void *&data_ptr = NO_INIT + size_t &data_len = NO_INIT + PPCODE: + data_ptr = NULL; + data_len = 0; + RETVAL = uuid_export(uuid, fmt, &data_ptr, &data_len); + if (RETVAL == UUID_RC_OK) { + if (fmt == UUID_FMT_SIV) + data_len = strlen((char *)data_ptr); + else if (fmt == UUID_FMT_STR || fmt == UUID_FMT_TXT) + data_len--; /* Perl doesn't wish NUL-termination on strings */ + sv_setpvn(ST(2), data_ptr, data_len); + free(data_ptr); + if (ST(3) != &PL_sv_undef) + sv_setuv(ST(3), (UV)data_len); + } + PUSHi((IV)RETVAL); + +char * +uuid_error(rc) + PROTOTYPE: + $ + INPUT: + uuid_rc_t rc + CODE: + RETVAL = uuid_error(rc); + OUTPUT: + RETVAL + +unsigned long +uuid_version() + PROTOTYPE: + INPUT: + CODE: + RETVAL = uuid_version(); + OUTPUT: + RETVAL + diff --git a/shared/ossp_uuid/perl/uuid_compat.pm b/shared/ossp_uuid/perl/uuid_compat.pm new file mode 100644 index 00000000..fdc57125 --- /dev/null +++ b/shared/ossp_uuid/perl/uuid_compat.pm @@ -0,0 +1,176 @@ +## +## OSSP uuid - Universally Unique Identifier +## Copyright (c) 2004-2007 Ralf S. Engelschall <rse@engelschall.com> +## Copyright (c) 2004-2007 The OSSP Project <http://www.ossp.org/> +## Copyright (c) 2004 Piotr Roszatycki <dexter@debian.org> +## +## This file is part of OSSP uuid, a library for the generation +## of UUIDs which can found at http://www.ossp.org/pkg/lib/uuid/ +## +## Permission to use, copy, modify, and distribute this software for +## any purpose with or without fee is hereby granted, provided that +## the above copyright notice and this permission notice appear in all +## copies. +## +## THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESSED OR IMPLIED +## WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +## MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. +## IN NO EVENT SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR +## CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +## SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +## LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF +## USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +## ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +## OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT +## OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +## SUCH DAMAGE. +## +## uuid_compat.pm: Data::UUID Backward Compatibility Perl API +## + +package Data::UUID; + +use 5.006; +use warnings; +use strict; + +use OSSP::uuid; +use MIME::Base64 qw(); + +require Exporter; + +our @ISA = qw(Exporter); +our @EXPORT = qw(NameSpace_DNS NameSpace_OID NameSpace_URL NameSpace_X500); + +our $VERSION = do { my @v = ('1.6.2' =~ m/\d+/g); sprintf("%d.".("%02d"x$#v), @v); }; + +sub new { + my $class = shift; + my $self = bless {}, $class; + return $self; +} + +sub create { + my ($self) = @_; + my $uuid = OSSP::uuid->new; + $uuid->make('v4'); + return $uuid->export('bin'); +} + +sub create_from_name { + my ($self, $nsid, $name) = @_; + my $uuid = OSSP::uuid->new; + my $nsiduuid = OSSP::uuid->new; + $nsiduuid->import('bin', $nsiduuid); + $uuid = OSSP::uuid->new; + $uuid->make('v3', $nsiduuid, $name); + return $uuid->export('bin'); +} + +sub to_string { + my ($self, $bin) = @_; + my $uuid = OSSP::uuid->new; + $uuid->import('bin', $bin); + return $uuid->export('str'); +} + +sub to_hexstring { + my ($self, $bin) = @_; + my $uuid = OSSP::uuid->new; + $uuid->import('bin', $bin); + (my $string = '0x' . $uuid->export('str')) =~ s/-//g; + return $string; +} + +sub to_b64string { + my ($self, $bin) = @_; + return MIME::Base64::encode_base64($bin, ''); +} + +sub from_string { + my ($self, $str) = @_; + my $uuid = OSSP::uuid->new; + $uuid->import('str', + $str =~ /^0x/ + ? join '-', unpack('x2 a8 a4 a4 a4 a12', $str) + : $str + ); + return $uuid->export('bin'); +} + +sub from_hexstring { + my ($self, $str) = @_; + my $uuid = OSSP::uuid->new; + $uuid->import('str', join '-', unpack('x2 a8 a4 a4 a4 a12', $str)); + return $uuid->export('bin'); +} + +sub from_b64string { + my ($self, $b64) = @_; + return MIME::Base64::decode_base64($b64); +} + +sub compare { + my ($self, $bin1, $bin2) = @_; + my $uuid1 = OSSP::uuid->new; + my $uuid2 = OSSP::uuid->new; + $uuid1->import('bin', $bin1); + $uuid2->import('bin', $bin2); + return $uuid1->compare($uuid2); +} + +my %NS = ( + 'NameSpace_DNS' => 'ns:DNS', + 'NameSpace_URL' => 'ns:URL', + 'NameSpace_OID' => 'ns:OID', + 'NameSpace_X500' => 'ns:X500', +); + +while (my ($k, $v) = each %NS) { + no strict 'refs'; + *{$k} = sub () { + my $uuid = OSSP::uuid->new; + $uuid->load($v); + return $uuid->export('bin'); + }; +} + +sub constant { + my ($self, $arg) = @_; + my $uuid = OSSP::uuid->new; + $uuid->load($NS{$arg} || 'nil'); + return $uuid->export('bin'); +} + +sub create_str { + my $self = shift; + return $self->to_string($self->create); +} + +sub create_hex { + my $self = shift; + return $self->to_hexstring($self->create); +} + +sub create_b64 { + my $self = shift; + return $self->to_b64string($self->create); +} + +sub create_from_name_str { + my $self = shift; + return $self->to_string($self->create_from_name(@_)); +} + +sub create_from_name_hex { + my $self = shift; + return $self->to_hexstring($self->create_from_name(@_)); +} + +sub create_from_name_b64 { + my $self = shift; + return $self->to_b64string($self->create_from_name(@_)); +} + +1; + diff --git a/shared/ossp_uuid/perl/uuid_compat.pod b/shared/ossp_uuid/perl/uuid_compat.pod new file mode 100644 index 00000000..e695acae --- /dev/null +++ b/shared/ossp_uuid/perl/uuid_compat.pod @@ -0,0 +1,55 @@ +## +## OSSP uuid - Universally Unique Identifier +## Copyright (c) 2004-2007 Ralf S. Engelschall <rse@engelschall.com> +## Copyright (c) 2004-2007 The OSSP Project <http://www.ossp.org/> +## +## This file is part of OSSP uuid, a library for the generation +## of UUIDs which can found at http://www.ossp.org/pkg/lib/uuid/ +## +## Permission to use, copy, modify, and distribute this software for +## any purpose with or without fee is hereby granted, provided that +## the above copyright notice and this permission notice appear in all +## copies. +## +## THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESSED OR IMPLIED +## WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +## MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. +## IN NO EVENT SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR +## CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +## SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +## LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF +## USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +## ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +## OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT +## OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +## SUCH DAMAGE. +## +## uuid_compat.pod: Data::UUID Backward Compatibility Perl API (Perl/POD part) +## + +=pod + +=head1 NAME + +Data::UUID - B<OSSP uuid> Backward Compatibility Perl Binding + +=head1 DESCRIPTION + +B<Data::UUID> is the B<OSSP uuid> backward compatibility Perl binding +to the API of the original B<Data::UUID> module. It allows other +B<Data::UUID> based Perl modules to run with B<OSSP::uuid> without +changes. + +=head1 SEE ALSO + +B<OSSP::uuid>. + +=head1 HISTORY + +The backward compatibility Perl binding B<Data::UUID> for B<OSSP +uuid> was originally implemented in 2004 by Piotr Roszatycki +E<lt>dexter@debian.orgE<gt>. It was later cleaned up and speed optimized +in December 2005 by David Wheeler E<lt>david@justatheory.comE<gt>. + +=cut + diff --git a/shared/ossp_uuid/perl/uuid_compat.ts b/shared/ossp_uuid/perl/uuid_compat.ts new file mode 100644 index 00000000..12507c69 --- /dev/null +++ b/shared/ossp_uuid/perl/uuid_compat.ts @@ -0,0 +1,55 @@ +## +## OSSP uuid - Universally Unique Identifier +## Copyright (c) 2004-2007 Ralf S. Engelschall <rse@engelschall.com> +## Copyright (c) 2004-2007 The OSSP Project <http://www.ossp.org/> +## Copyright (c) 2004 Piotr Roszatycki <dexter@debian.org> +## +## This file is part of OSSP uuid, a library for the generation +## of UUIDs which can found at http://www.ossp.org/pkg/lib/uuid/ +## +## Permission to use, copy, modify, and distribute this software for +## any purpose with or without fee is hereby granted, provided that +## the above copyright notice and this permission notice appear in all +## copies. +## +## THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESSED OR IMPLIED +## WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +## MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. +## IN NO EVENT SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR +## CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +## SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +## LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF +## USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +## ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +## OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT +## OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +## SUCH DAMAGE. +## +## uuid_compat.ts: Data::UUID Backward Compatibility Perl API (Perl test suite part) +## + +use Test::More tests => 14; + +BEGIN { + use_ok('Data::UUID'); + use Data::UUID; +}; + +ok($ug = new Data::UUID); + +ok($uuid1 = $ug->create()); +ok($uuid2 = $ug->to_hexstring($uuid1)); +ok($uuid3 = $ug->from_string($uuid2)); +ok($ug->compare($uuid1, $uuid3) == 0); + +ok($uuid4 = $ug->to_b64string($uuid1)); +ok($uuid5 = $ug->to_b64string($uuid3)); +ok($uuid4 eq $uuid5); + +ok($uuid6 = $ug->from_b64string($uuid5)); +ok($ug->compare($uuid6, $uuid1) == 0); + +ok($uuid7 = NameSpace_URL); +ok($uuid8 = $ug->from_string("6ba7b811-9dad-11d1-80b4-00c04fd430c8")); +ok($ug->compare($uuid7, $uuid8) == 0); + |