head 1.25; access; symbols UUID_1_6_2:1.24 UUID_1_6_1:1.23 UUID_1_6_0:1.22 UUID_1_5_1:1.20 UUID_1_5_0:1.19 UUID_1_4_2:1.17 UUID_1_4_1:1.16 UUID_1_4_0:1.15 UUID_1_3_2:1.13 UUID_1_3_1:1.12 UUID_1_3_0:1.11 UUID_1_2_1:1.9 UUID_1_2_0:1.8 UUID_1_1_2:1.6 UUID_1_1_1:1.4 UUID_1_1_0:1.3; locks; strict; comment @# @; 1.25 date 2008.07.05.12.58.22; author rse; state dead; branches; next 1.24; commitid XLXN7vUmABwPcC9t; 1.24 date 2008.07.04.21.48.00; author rse; state Exp; branches; next 1.23; commitid y0hLDNAXwDqzax9t; 1.23 date 2008.01.10.14.18.49; author rse; state Exp; branches; next 1.22; commitid LqMgFGBgTR7clSMs; 1.22 date 2007.05.19.20.00.47; author rse; state Exp; branches; next 1.21; commitid qLbE5CV0mvMROzis; 1.21 date 2007.01.01.18.14.57; author rse; state Exp; branches; next 1.20; commitid jOXiIO8S8v7xFP0s; 1.20 date 2006.07.31.12.45.09; author rse; state Exp; branches; next 1.19; commitid uBoIc6jFr8slN0Hr; 1.19 date 2006.05.11.18.42.54; author rse; state Exp; branches; next 1.18; commitid YcLYmdTCsTWunDwr; 1.18 date 2006.05.11.09.37.30; author rse; state Exp; branches; next 1.17; commitid u4EPMISJDipjmAwr; 1.17 date 2006.03.13.09.42.48; author rse; state Exp; branches; next 1.16; commitid D0QSfAAm5ajNh0pr; 1.16 date 2006.02.07.08.42.53; author rse; state Exp; branches; next 1.15; commitid k181EBCE8QfZ2Dkr; 1.15 date 2006.01.13.06.44.33; author rse; state Exp; branches; next 1.14; commitid hYfQc9JIMh4bcphr; 1.14 date 2006.01.12.20.32.43; author rse; state Exp; branches; next 1.13; commitid bgsM5SxjtMhkOlhr; 1.13 date 2005.12.06.11.52.11; author rse; state Exp; branches; next 1.12; commitid D2QvoISTKeru7ycr; 1.12 date 2005.09.24.10.20.24; author rse; state Exp; branches; next 1.11; 1.11 date 2005.08.31.09.59.45; author rse; state Exp; branches; next 1.10; 1.10 date 2005.08.31.08.55.18; author rse; state Exp; branches; next 1.9; 1.9 date 2005.08.30.20.11.47; author rse; state Exp; branches; next 1.8; 1.8 date 2005.01.23.12.38.10; author rse; state Exp; branches; next 1.7; 1.7 date 2005.01.23.11.28.54; author rse; state Exp; branches; next 1.6; 1.6 date 2005.01.13.10.37.37; author rse; state Exp; branches; next 1.5; 1.5 date 2004.12.31.19.20.39; author rse; state Exp; branches; next 1.4; 1.4 date 2004.11.18.15.59.52; author rse; state Exp; branches; next 1.3; 1.3 date 2004.11.03.18.44.40; author rse; state Exp; branches; next 1.2; 1.2 date 2004.11.03.18.35.26; author rse; state Exp; branches; next 1.1; 1.1 date 2004.11.03.14.52.09; author rse; state Exp; branches; next ; desc @@ 1.25 log @remove OSSP uuid from CVS -- it is now versioned controlled in a Monotone repository @ text @## ## OSSP uuid - Universally Unique Identifier ## Copyright (c) 2004-2007 Ralf S. Engelschall ## Copyright (c) 2004-2007 The OSSP Project ## ## 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; @ 1.24 log @bump version before release @ text @@ 1.23 log @adjust copyright messages for 2008 and bump version in advance @ text @d121 1 a121 1 our $VERSION = do { my @@v = ('1.6.1' =~ m/\d+/g); sprintf("%d.".("%02d"x$#v), @@v); }; @ 1.22 log @bump before release @ text @d121 1 a121 1 our $VERSION = do { my @@v = ('1.6.0' =~ m/\d+/g); sprintf("%d.".("%02d"x$#v), @@v); }; @ 1.21 log @Adjust copyright messages for new year 2007. @ text @d121 1 a121 1 our $VERSION = do { my @@v = ('1.5.1' =~ m/\d+/g); sprintf("%d.".("%02d"x$#v), @@v); }; @ 1.20 log @bump before release @ text @d3 2 a4 2 ## Copyright (c) 2004-2006 Ralf S. Engelschall ## Copyright (c) 2004-2006 The OSSP Project @ 1.19 log @as we have already changes too much, switch to 1.5 now @ text @d121 1 a121 1 our $VERSION = do { my @@v = ('1.5.0' =~ m/\d+/g); sprintf("%d.".("%02d"x$#v), @@v); }; @ 1.18 log @Add full support for Single Integer Value (SIV) UUID representation for both importing and exporting in C/C++/Perl/PHP APIs. @ text @d121 1 a121 1 our $VERSION = do { my @@v = ('1.4.2' =~ m/\d+/g); sprintf("%d.".("%02d"x$#v), @@v); }; @ 1.17 log @bump version before release @ text @d132 1 d146 1 d261 1 d289 1 @ 1.16 log @bump before release @ text @d121 1 a121 1 our $VERSION = do { my @@v = ('1.4.1' =~ m/\d+/g); sprintf("%d.".("%02d"x$#v), @@v); }; @ 1.15 log @Adjust copyright messages for new year 2006. @ text @d121 1 a121 1 our $VERSION = do { my @@v = ('1.4.0' =~ m/\d+/g); sprintf("%d.".("%02d"x$#v), @@v); }; @ 1.14 log @bump up the version because of PostgreSQL bindings @ text @d3 2 a4 2 ## Copyright (c) 2004-2005 Ralf S. Engelschall ## Copyright (c) 2004-2005 The OSSP Project @ 1.13 log @bump before release @ text @d121 1 a121 1 our $VERSION = do { my @@v = ('1.3.2' =~ m/\d+/g); sprintf("%d.".("%02d"x$#v), @@v); }; @ 1.12 log @bump version before release @ text @d121 1 a121 1 our $VERSION = do { my @@v = ('1.3.1' =~ m/\d+/g); sprintf("%d.".("%02d"x$#v), @@v); }; @ 1.11 log @Added optional Data::UUID backward compatibility Perl API which can be enabled with the build-time option --with-perl-compat. Submitted by: Piotr Roszatycki @ text @d121 1 a121 1 our $VERSION = do { my @@v = ('1.3.0' =~ m/\d+/g); sprintf("%d.".("%02d"x$#v), @@v); }; @ 1.10 log @Add a functionality-reduced TIE-style Perl API OSSP::uuid::tie, intended for very high-level convenience programming. @ text @d121 1 a121 1 our $VERSION = do { my @@v = ('1.2.1' =~ m/\d+/g); sprintf("%d.".("%02d"x$#v), @@v); }; @ 1.9 log @bump before release @ text @d30 81 a119 4 ## ## API Definition ## a169 5 ## ## High-Level Perl Module OO-style API ## (just an OO wrapper around the C-style API) ## @ 1.8 log @add support for version 5 UUIDs also to Perl API @ text @d44 1 a44 1 our $VERSION = do { my @@v = ('1.2.0' =~ m/\d+/g); sprintf("%d.".("%02d"x$#v), @@v); }; @ 1.7 log @Added support for new version 5 UUIDs (name-based, SHA-1) according to latest draft-mealling-uuid-urn-05.txt. @ text @d64 1 d140 1 d144 1 a144 1 if ($mode_code & $self->UUID_MAKE_V3) { d146 1 a146 1 croak("UUID_MAKE_V3 requires namespace argument to be OSSP::uuid object"); @ 1.6 log @bump version and date before release @ text @d44 1 a44 1 our $VERSION = do { my @@v = ('1.1.2' =~ m/\d+/g); sprintf("%d.".("%02d"x$#v), @@v); }; @ 1.5 log @Adjust copyright messages for new year 2005. @ text @d44 1 a44 1 our $VERSION = do { my @@v = ('1.1.1' =~ m/\d+/g); sprintf("%d.".("%02d"x$#v), @@v); }; @ 1.4 log @bump before release @ text @d3 2 a4 2 ## Copyright (c) 2004 Ralf S. Engelschall ## Copyright (c) 2004 The OSSP Project @ 1.3 log @polish comments @ text @d44 1 a44 1 our $VERSION = do { my @@v = ('1.1.0' =~ m/\d+/g); sprintf("%d.".("%02d"x$#v), @@v); }; @ 1.2 log @adjust version in Perl module, too; bump for next release number @ text @d174 5 d181 1 a181 1 croak("import method expects 3 or 4 arguments") if (@@_ < 3 or @@_ > 4); d200 5 d207 1 a207 1 croak("export method expects 2 arguments") if (@@_ != 2); @ 1.1 log @Add Perl language binding providing both a C-style and OO-style API. @ text @d44 1 a44 1 our $VERSION = do { my @@v = ('1.0.4' =~ m/\d+/g); sprintf("%d.".("%02d"x$#v), @@v); }; @