Data-UUID-1.226/000755 000767 000024 00000000000 13644660517 013262 5ustar00rjbsstaff000000 000000 Data-UUID-1.226/LICENSE000644 000767 000024 00000002241 11111625064 014247 0ustar00rjbsstaff000000 000000 This distribution contains code derived from the sample UUID implementation in RFC 4122, which contains the following clause. /* ** Copyright (c) 1990- 1993, 1996 Open Software Foundation, Inc. ** Copyright (c) 1989 by Hewlett-Packard Company, Palo Alto, Ca. & ** Digital Equipment Corporation, Maynard, Mass. ** Copyright (c) 1998 Microsoft. ** To anyone who acknowledges that this file is provided "AS IS" ** without any express or implied warranty: permission to use, copy, ** modify, and distribute this file for any purpose is hereby ** granted without fee, provided that the above copyright notices and ** this notice appears in all source code copies, and that none of ** the names of Open Software Foundation, Inc., Hewlett-Packard ** Company, Microsoft, or Digital Equipment Corporation be used in ** advertising or publicity pertaining to distribution of the software ** without specific, written prior permission. Neither Open Software ** Foundation, Inc., Hewlett-Packard Company, Microsoft, nor Digital ** Equipment Corporation makes any representations about the ** suitability of this software for any purpose. */ The same terms apply to this code. Data-UUID-1.226/UUID.h000644 000767 000024 00000012174 12443673107 014201 0ustar00rjbsstaff000000 000000 #if !defined __UUID_H__ # define __UUID_H__ #include #include #include #ifndef _MSC_VER /* No unistd.h in MS VC */ #include #endif #include #if !defined INT2PTR #if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE) # define PTRV UV # define INT2PTR(any,d) (any)(d) #else # if PTRSIZE == LONGSIZE # define PTRV unsigned long # else # define PTRV unsigned # endif # define INT2PTR(any,d) (any)(PTRV)(d) #endif #define NUM2PTR(any,d) (any)(PTRV)(d) #define PTR2IV(p) INT2PTR(IV,p) #define PTR2UV(p) INT2PTR(UV,p) #define PTR2NV(p) NUM2PTR(NV,p) #if PTRSIZE == LONGSIZE # define PTR2ul(p) (unsigned long)(p) #else # define PTR2ul(p) INT2PTR(unsigned long,p) #endif #endif #if defined __cygwin__ || defined __mingw32__ || defined _MSC_VER #include #endif #if defined __darwin__ #include #endif #ifdef _MSC_VER #include #endif #if !defined _STDIR # define _STDIR "/var/tmp" #endif #if !defined _DEFAULT_UMASK # define _DEFAULT_UMASK 0007 #endif #define UUID_STATE ".UUID_STATE" #define UUID_NODEID ".UUID_NODEID" #if defined __mingw32__ || (defined _WIN32 && !defined(__cygwin__)) || defined _MSC_VER #define UUID_STATE_NV_STORE _STDIR"\\"UUID_STATE #define UUID_NODEID_NV_STORE _STDIR"\\"UUID_NODEID #else #define UUID_STATE_NV_STORE _STDIR"/"UUID_STATE #define UUID_NODEID_NV_STORE _STDIR"/"UUID_NODEID #endif #define UUIDS_PER_TICK 1024 #ifdef _MSC_VER #define I64(C) C##i64 #else #define I64(C) C##LL #endif #define F_BIN 0 #define F_STR 1 #define F_HEX 2 #define F_B64 3 #define CHECK(f1, f2) if (f1 != f2) RETVAL = f1 < f2 ? -1 : 1; typedef unsigned int unsigned32; typedef unsigned short unsigned16; typedef unsigned char unsigned8; typedef unsigned char byte; #ifndef _MSC_VER typedef unsigned long long unsigned64_t; # else typedef __int64 int64_t; typedef unsigned __int64 uint64_t; typedef __int32 int32_t; typedef unsigned __int32 uint32_t; typedef __int16 int16_t; typedef unsigned __int16 uint16_t; typedef __int8 int8_t; typedef unsigned __int8 uint8_t; typedef unsigned __int64 unsigned64_t; // http://msdn2.microsoft.com/en-us/library/296az74e.aspx - Integer Limits typedef int pid_t; #endif /* _MSC_VER */ typedef unsigned64_t perl_uuid_time_t; /* Android's lic provides neither lockf nor any of the related constants */ #if (defined __solaris__ || defined __linux__) && !defined(__android__) # define LOCK(f) lockf(fileno(f),F_LOCK,0); # define UNLOCK(f) lockf(fileno(f),F_ULOCK,0); #elif defined __darwin__ # define LOCK(f) flock(fileno(f),LOCK_EX); # define UNLOCK(f) flock(fileno(f),LOCK_UN); #else # define LOCK(f) # define UNLOCK(f) #endif #undef perl_uuid_t typedef struct _uuid_node_t { char nodeID[6]; } uuid_node_t; typedef struct _perl_uuid_t { unsigned32 time_low; unsigned16 time_mid; unsigned16 time_hi_and_version; unsigned8 clock_seq_hi_and_reserved; unsigned8 clock_seq_low; byte node[6]; } perl_uuid_t; typedef struct _uuid_state_t { perl_uuid_time_t ts; uuid_node_t node; unsigned16 cs; } uuid_state_t; typedef struct _uuid_context_t { uuid_state_t state; uuid_node_t nodeid; perl_uuid_time_t next_save; } uuid_context_t; static void format_uuid_v1( perl_uuid_t *uuid, unsigned16 clockseq, perl_uuid_time_t timestamp, uuid_node_t node ); static void format_uuid_v3( perl_uuid_t *uuid, unsigned char hash[16] ); static void get_current_time(perl_uuid_time_t * timestamp); static unsigned16 true_random(void); static void get_system_time(perl_uuid_time_t *perl_uuid_time); static void get_random_info(unsigned char seed[16]); static SV* make_ret(const perl_uuid_t u, int type); static SV* MD5Init(void); static void MD5Update(SV* ctx, SV* data); static void MD5Final(unsigned char hash[16], SV* ctx); static const char base64[] = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"; static unsigned char index64[256] = { 255,255,255,255, 255,255,255,255, 255,255,255,255, 255,255,255,255, 255,255,255,255, 255,255,255,255, 255,255,255,255, 255,255,255,255, 255,255,255,255, 255,255,255,255, 255,255,255,62, 255,255,255,63, 52,53,54,55, 56,57,58,59, 60,61,255,255, 255,254,255,255, 255, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9,10, 11,12,13,14, 15,16,17,18, 19,20,21,22, 23,24,25,255, 255,255,255,255, 255,26,27,28, 29,30,31,32, 33,34,35,36, 37,38,39,40, 41,42,43,44, 45,46,47,48, 49,50,51,255, 255,255,255,255, 255,255,255,255, 255,255,255,255, 255,255,255,255, 255,255,255,255, 255,255,255,255, 255,255,255,255, 255,255,255,255, 255,255,255,255, 255,255,255,255, 255,255,255,255, 255,255,255,255, 255,255,255,255, 255,255,255,255, 255,255,255,255, 255,255,255,255, 255,255,255,255, 255,255,255,255, 255,255,255,255, 255,255,255,255, 255,255,255,255, 255,255,255,255, 255,255,255,255, 255,255,255,255, 255,255,255,255, 255,255,255,255, 255,255,255,255, 255,255,255,255, 255,255,255,255, 255,255,255,255, 255,255,255,255, 255,255,255,255, 255,255,255,255, }; #endif Data-UUID-1.226/Changes000644 000767 000024 00000012304 13644660471 014554 0ustar00rjbsstaff000000 000000 Revision history for Perl extension Data::UUID. 1.226 2020-04-12 - set umask before fopen in destructor (thanks, Rafaël Garcia-Suarez) 1.225 2020-04-12 - pointless accidental release 1.224 2019-03-02 - No changes since 1.223 1.223 2019-02-14 (TRIAL) - Use File::Spec to get tmpdir instead of hardcoding (thanks, Desmond Daignault) 1.222 2018-04-29 (TRIAL) - Properly quote C strings passed in DEFINE (thanks, Salvador Fadiño) - Fix memory leak by decreasing reference count (thanks, Daniel Spang) 1.221 2015-08-10 - documentation improvements 1.220 2014-12-15 - improve chances it'll work on Android (thanks, Brian Fraser) 1.219 2013-07-06 - cygwin fixes (thanks, Reini Urban!) - Skip t/threads.t unless perl version is 5.13.4 or greater (thanks, VPIT) - compile with strict C89 compilers (thanks, VPIT) - more bugfixes (thanks, VPIT) 1.218 - support for Haiku OS (thanks, Tony Cook!) 1.217 2010-09-14 - documentation fixes - minor portability tweak to UUID.xs (thanks, Florian Ragwitz) 1.216 2010-09-04 - documentation fixes only 1.215 2010-05-24 - no changes, released as non-trial 1.214 TRIAL RELEASE 2010-05-14 - Use gv_stashpv instead of gv_stashpvs (Florian Ragwitz) 1.213 TRIAL RELEASE 2010-05-07 - Pass along the interpreter to ptable_store, if needed (Florian Ragwitz) 1.212 TRIAL RELEASE 2010-05-07 - fix MANIFEST (thanks for noticing, Florian Ragwitz) 1.211 TRIAL RELEASE 2010-05-07 - add a uniqueness test to threads.t (thanks, SCHWERN!) 1.210 TRIAL RELEASE 2010-05-07 - thread safety, added by Florian Ragwitz 1.203 Tue Nov 3 16:46:50 EST 2009 - avoid interactive configuration (thanks, DAXIM) 1.202 Mon Jun 15 18:42:19 EDT 2009 - localize changes to $! (thanks, Jesse Vincent!) 1.201 Sat Apr 18 14:09 2009 - replace Data-UUID's own md5 with Digest::MD5 (thanks, RUZ!) - apply patch from tokuhirom to avoid segmentation violation 1.149 Sat Nov 1 12:31 2008 - added explicit BSD license; code is basically RFC4122 + patches 1.148 Thu Nov 16 10:21 2006 - Debian has chosen to distribute their own Data::UUID, which has a different interface and breaks other modules. They also use a grossly-inflated version number, which means that this version number must be inflated to allow modules to rely on the CPAN Data::UUID properly. Tests added to EXPLICITLY assert the one known difference between genuine Data::UUID and Debian's ersatz version in libossp-uuid-perl. Thanks to ADAMK for bringing this to my attention. 0.148 Thu Nov 16 10:21 2006 - more Win32 fixes by Alexandr Ciornii 0.146 Tue Nov 14 18:02 2006 - packaging improvements 0.145 Sun Sep 17 22:12 2006 - Win32 compatibility/compilation improvements (rt #21486) -- thanks MERIJNB! 0.143 Sun Sep 17 22:12 2006 - more tick-tracking fixes (rt #21486) -- thanks MERIJNB! 0.142 Tue Sep 5 22:41 2006 - fix incorrect initialization of tick-tracking (rt #2481) 0.141 Tue Sep 5 22:16 2006 - partial fix for compilation under MSVC (thanks Alexandr Ciornii!) 0.14 Sat Mar 18 08:40 2006 - added use strict - added tests to shut up stupid Kwalitee tests 0.13 Sat Feb 25 15:20 2006 - fixed compilation errors on Mac OS X: bugs 12389, 15829 - avoid hanging under CPAN tools by using EUMM prompt(): bug 8046 (thanks, Schwern) - fix problems with "long" type on 64 big platforms: bug 14163 (thanks, Kevin Rosenberg) - improve compilation on Cygwin: bug 7088 (thanks, maxb) - improve compilation on Win32: bug 14082 (thanks, Christopher Laco) - fixed link to UUID draft: bug 12169 (thanks, kcivey) - fixed UUID collision on SMP machines: bug 15042 (thanks, Chia-liang Kao) 0.11 Wed Aug 27 16:05:00 2003 - reformatted POD documentation as per David Wheeler - added ref. links to articles on database keys reengineering problem 0.10 Thu Jul 17 17:12:00 2003 - added support for PERL_MM_USE_DEFAULT as per Heath Malstrom - replaced GetSystemTimeAsFileTime with QueryPerformanceCounter as per Paul Stodghill 0.08 Fri Nov 29 12:12:00 2002 - added default umask for state storage files (as per James A. Duncan, Fotango.com) 0.07 Wed Jun 12 17:31:00 2002 - changed get_system_time to use I64 ints (CPAN Ticket #737 - Incorrect Time based UUIDs) 0.06 Sun Mar 2 01:41:00 2002 - added code to fix ccflags on HP (as per Lincoln Baxter) - fixed state/nodeid sharing problem (as per Lincoln Baxter) - fixed most compiler warnings (as per Lincoln Baxter) - replaced Base64-encode algorithm to fix buffer overflow (as per Lincoln Baxter). - fixed count of tests in test.pl (as per Lincoln Baxter) - added ok() to every line of test.pl (as per Lincoln Baxter) 0.05 Tue Feb 12 09:46:00 2002 - added custom OS defines - added LOCK/UNLOCK defines for Darwin OS 0.04 Tue Dec 11 12:03:00 2001 - fixed padding in create_b64/to_b64string - added advisory locking for state storage 0.03 Mon Nov 5 12:47:00 2001 - fixed padding problem in from_b64string - re-tested with Cygwin v2.78.2.15 0.02 Wed Oct 31 12:11:00 2001 - fixed from_string/from_hexstring bug, which caused problems on little endian machines (linux) 0.01 Thu Oct 25 16:19:30 2001 - original version; created by h2xs 1.21 with options -f -nData::UUID -v0.01 Data-UUID-1.226/MANIFEST000644 000767 000024 00000000616 13644660517 014416 0ustar00rjbsstaff000000 000000 Changes LICENSE Makefile.PL MANIFEST ptable.h README smp-test/collision.t smp-test/uuid-fork.pl t/basic.t t/from-name-collisions.t t/leaky_dollar_bang.t t/pod-coverage.t t/pod.t t/segv.t t/threads.t typemap UUID.h UUID.pm UUID.xs META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Data-UUID-1.226/t/000755 000767 000024 00000000000 13644660517 013525 5ustar00rjbsstaff000000 000000 Data-UUID-1.226/README000644 000767 000024 00000003036 13644660256 014144 0ustar00rjbsstaff000000 000000 Data::UUID ================= Data::UUID - Perl extension for generating Globally/Universally Unique Identifiers (GUIDs/UUIDs). This module provides a framework for generating UUIDs (Universally Unique Identifiers, also known as GUIDs (Globally Unique Identifiers). A UUID is 128 bits long, and is guaranteed to be different from all other UUIDs/GUIDs generated until 3400 A.D. UUIDs were originally used in the Network Computing System (NCS) and later in the Open Software Foundation's (OSF) Distributed Computing Environment. Currently many different technologies rely on UUIDs to provide unique identity for various software components, Microsoft COM/DCOM for instance, uses GUIDs very extensively to uniquely identify classes, applications and components across network-connected systems. INSTALLATION To install this module type the following: perl Makefile.PL make make test make install NOTE: This module is designed to save its state information in a permanent storage location. The installation script (i.e. Makefile.PL) prompts for a directory name to use as a storage location for state file and defaults this directory to "/var/tmp" if no directory name is provided. The installation script will not accept names of directories that do not exist, however, it will take the locations, which the installing user has no write permissions to. In this case, the state information will not be saved, which will maximize the chances of generating duplicate UUIDs. COPYRIGHT AND LICENCE Copyright (C) 2001, Alexander Golomshtok Data-UUID-1.226/UUID.xs000644 000767 000024 00000035772 13644660441 014416 0ustar00rjbsstaff000000 000000 #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include "UUID.h" #if defined __BEOS__ || defined __HAIKU__ # undef bool # include #endif #ifdef USE_ITHREADS # define DU_THREADSAFE 1 #else # define DU_THREADSAFE 0 #endif #if DU_THREADSAFE # define pPTBL pTHX # define pPTBL_ pTHX_ # define aPTBL aTHX # define aPTBL_ aTHX_ # define PTABLE_VAL_FREE(V) ((void) (V)) # include "ptable.h" # define ptable_store(T, K, V) ptable_store(aTHX_ (T), (K), (V)) static ptable *instances; static perl_mutex instances_mutex; static void inc(pTHX_ ptable_ent *ent, void *ud) { UV count = PTR2UV(ent->val); PERL_UNUSED_VAR(ud); ptable_store(instances, ent->key, (void *)++count); } #endif static perl_uuid_t NameSpace_DNS = { /* 6ba7b810-9dad-11d1-80b4-00c04fd430c8 */ 0x6ba7b810, 0x9dad, 0x11d1, 0x80, 0xb4, { 0x00, 0xc0, 0x4f, 0xd4, 0x30, 0xc8 } }; static perl_uuid_t NameSpace_URL = { /* 6ba7b811-9dad-11d1-80b4-00c04fd430c8 */ 0x6ba7b811, 0x9dad, 0x11d1, 0x80, 0xb4, { 0x00, 0xc0, 0x4f, 0xd4, 0x30, 0xc8 } }; static perl_uuid_t NameSpace_OID = { /* 6ba7b812-9dad-11d1-80b4-00c04fd430c8 */ 0x6ba7b812, 0x9dad, 0x11d1, 0x80, 0xb4, { 0x00, 0xc0, 0x4f, 0xd4, 0x30, 0xc8 } }; static perl_uuid_t NameSpace_X500 = { /* 6ba7b814-9dad-11d1-80b4-00c04fd430c8 */ 0x6ba7b814, 0x9dad, 0x11d1, 0x80, 0xb4, { 0x00, 0xc0, 0x4f, 0xd4, 0x30, 0xc8 } }; static void format_uuid_v1( perl_uuid_t *uuid, unsigned16 clock_seq, perl_uuid_time_t timestamp, uuid_node_t node ) { uuid->time_low = (unsigned long)(timestamp & 0xFFFFFFFF); uuid->time_mid = (unsigned short)((timestamp >> 32) & 0xFFFF); uuid->time_hi_and_version = (unsigned short)((timestamp >> 48) & 0x0FFF); uuid->time_hi_and_version |= (1 << 12); uuid->clock_seq_low = clock_seq & 0xFF; uuid->clock_seq_hi_and_reserved = (clock_seq & 0x3F00) >> 8; uuid->clock_seq_hi_and_reserved |= 0x80; memcpy(&uuid->node, &node, sizeof uuid->node); } static void get_current_time(perl_uuid_time_t * timestamp) { perl_uuid_time_t time_now; static perl_uuid_time_t time_last; static unsigned16 uuids_this_tick; static int inited = 0; if (!inited) { get_system_time(&time_last); uuids_this_tick = UUIDS_PER_TICK; inited = 1; }; while (1) { get_system_time(&time_now); if (time_last != time_now) { uuids_this_tick = 0; time_last = time_now; break; }; if (uuids_this_tick < UUIDS_PER_TICK) { uuids_this_tick++; break; }; }; *timestamp = time_now + uuids_this_tick; } static unsigned16 true_random(void) { static int inited = 0; perl_uuid_time_t time_now; if (!inited) { get_system_time(&time_now); time_now = time_now/UUIDS_PER_TICK; srand((unsigned int)(((time_now >> 32) ^ time_now)&0xffffffff)); inited = 1; }; return (rand()); } static void format_uuid_v3( perl_uuid_t *uuid, unsigned char hash[16] ) { memcpy(uuid, hash, sizeof(perl_uuid_t)); uuid->time_low = ntohl(uuid->time_low); uuid->time_mid = ntohs(uuid->time_mid); uuid->time_hi_and_version = ntohs(uuid->time_hi_and_version); uuid->time_hi_and_version &= 0x0FFF; uuid->time_hi_and_version |= (3 << 12); uuid->clock_seq_hi_and_reserved &= 0x3F; uuid->clock_seq_hi_and_reserved |= 0x80; } static void get_system_time(perl_uuid_time_t *perl_uuid_time) { #if defined __cygwin__ || defined __MINGW32__ || defined WIN32 /* ULARGE_INTEGER time; */ LARGE_INTEGER time; /* use QeryPerformanceCounter for +ms resolution - as per Paul Stodghill GetSystemTimeAsFileTime((FILETIME *)&time); */ QueryPerformanceCounter(&time); time.QuadPart += (unsigned __int64) (1000*1000*10) * (unsigned __int64) (60 * 60 * 24) * (unsigned __int64) (17+30+31+365*18+5); *perl_uuid_time = time.QuadPart; #else struct timeval tp; gettimeofday(&tp, (struct timezone *)0); *perl_uuid_time = (tp.tv_sec * I64(10000000)) + (tp.tv_usec * I64(10)) + I64(0x01B21DD213814000); #endif } static void get_random_info(unsigned char seed[16]) { SV* ctx; #if defined __cygwin__ || defined __MINGW32__ || defined __MSWin32__ typedef struct { MEMORYSTATUS m; SYSTEM_INFO s; FILETIME t; LARGE_INTEGER pc; DWORD tc; DWORD l; char hostname[MAX_COMPUTERNAME_LENGTH + 1]; } randomness; #else typedef struct { #if defined __BEOS__ || defined __HAIKU__ system_info sys_info; #else long hostid; #endif struct timeval t; char hostname[257]; } randomness; #endif randomness r; #if defined __cygwin__ || defined __MINGW32__ || defined __MSWin32__ GlobalMemoryStatus(&r.m); GetSystemInfo(&r.s); GetSystemTimeAsFileTime(&r.t); QueryPerformanceCounter(&r.pc); r.tc = GetTickCount(); r.l = MAX_COMPUTERNAME_LENGTH + 1; GetComputerName(r.hostname, &r.l ); #else # if defined __BEOS__ || defined __HAIKU__ get_system_info(&r.sys_info); # elif !defined(__ANDROID__) r.hostid = gethostid(); # endif gettimeofday(&r.t, (struct timezone *)0); gethostname(r.hostname, 256); #endif ctx = MD5Init(); MD5Update(ctx, sv_2mortal(newSVpv((char*)&r, sizeof(randomness)))); MD5Final(seed, ctx); } static SV* make_ret(const perl_uuid_t u, int type) { char buf[BUFSIZ]; const unsigned char *from; unsigned char *to; STRLEN len; int i; memset(buf, 0x00, BUFSIZ); switch(type) { case F_BIN: memcpy(buf, &u, sizeof(perl_uuid_t)); len = sizeof(perl_uuid_t); break; case F_STR: sprintf(buf, "%8.8X-%4.4X-%4.4X-%2.2X%2.2X-", (unsigned int)u.time_low, u.time_mid, u.time_hi_and_version, u.clock_seq_hi_and_reserved, u.clock_seq_low); for(i = 0; i < 6; i++ ) sprintf(buf+strlen(buf), "%2.2X", u.node[i]); len = strlen(buf); break; case F_HEX: sprintf(buf, "0x%8.8X%4.4X%4.4X%2.2X%2.2X", (unsigned int)u.time_low, u.time_mid, u.time_hi_and_version, u.clock_seq_hi_and_reserved, u.clock_seq_low); for(i = 0; i < 6; i++ ) sprintf(buf+strlen(buf), "%2.2X", u.node[i]); len = strlen(buf); break; case F_B64: for(from = (const unsigned char*)&u, to = (unsigned char*)buf, i = sizeof(u); i > 0; i -= 3, from += 3) { *to++ = base64[from[0]>>2]; switch(i) { case 1: *to++ = base64[(from[0]&0x03)<<4]; *to++ = '='; *to++ = '='; break; case 2: *to++ = base64[((from[0]&0x03)<<4) | ((from[1]&0xF0)>>4)]; *to++ = base64[(from[1]&0x0F)<<2]; *to++ = '='; break; default: *to++ = base64[((from[0]&0x03)<<4) | ((from[1]&0xF0)>>4)]; *to++ = base64[((from[1]&0x0F)<<2) | ((from[2]&0xC0)>>6)]; *to++ = base64[(from[2]&0x3F)]; } } len = strlen(buf); break; default: croak("invalid type: %d\n", type); break; } return sv_2mortal(newSVpv(buf,len)); } static SV* MD5Init() { SV* res; int rcount; dSP; ENTER; SAVETMPS; PUSHMARK(SP); XPUSHs(sv_2mortal(newSVpv("Digest::MD5", 0))); PUTBACK; rcount = call_method("new", G_SCALAR); SPAGAIN; if ( rcount != 1 ) croak("couldn't construct new Digest::MD5 object"); res = newSVsv(POPs); PUTBACK; FREETMPS; LEAVE; return res; }; static void MD5Update( SV* ctx, SV* data ) { dSP; ENTER; SAVETMPS; PUSHMARK(SP); XPUSHs(ctx); XPUSHs(data); PUTBACK; call_method("add", G_DISCARD); SPAGAIN; PUTBACK; FREETMPS; LEAVE; }; static void MD5Final( unsigned char hash[16], SV* ctx ) { int rcount; char* tmp; STRLEN len; SV* retval; dSP; ENTER; SAVETMPS; PUSHMARK(SP); XPUSHs(sv_2mortal(ctx)); PUTBACK; rcount = call_method("digest", G_SCALAR); SPAGAIN; if ( rcount != 1 ) croak("Digest::MD5->digest hasn't returned a scalar"); retval = POPs; tmp = SvPV(retval, len); if ( len != 16 ) croak("Digest::MD5->digest returned not 16 bytes"); memcpy(hash, tmp, len); PUTBACK; FREETMPS; LEAVE; }; MODULE = Data::UUID PACKAGE = Data::UUID PROTOTYPES: DISABLE uuid_context_t* new(class) PREINIT: FILE *fd; unsigned char seed[16]; perl_uuid_time_t timestamp; mode_t mask; UV one = 1; CODE: RETVAL = (uuid_context_t *)PerlMemShared_malloc(sizeof(uuid_context_t)); if ((fd = fopen(UUID_STATE_NV_STORE, "rb"))) { fread(&(RETVAL->state), sizeof(uuid_state_t), 1, fd); fclose(fd); get_current_time(×tamp); RETVAL->next_save = timestamp; } if ((fd = fopen(UUID_NODEID_NV_STORE, "rb"))) { pid_t *hate = (pid_t *) &(RETVAL->nodeid); fread(&(RETVAL->nodeid), sizeof(uuid_node_t), 1, fd ); fclose(fd); *hate += getpid(); } else { get_random_info(seed); seed[0] |= 0x80; memcpy(&(RETVAL->nodeid), seed, sizeof(uuid_node_t)); mask = umask(_DEFAULT_UMASK); if ((fd = fopen(UUID_NODEID_NV_STORE, "wb"))) { fwrite(&(RETVAL->nodeid), sizeof(uuid_node_t), 1, fd); fclose(fd); }; umask(mask); } errno = 0; #if DU_THREADSAFE MUTEX_LOCK(&instances_mutex); ptable_store(instances, RETVAL, INT2PTR(void *, one)); MUTEX_UNLOCK(&instances_mutex); #endif OUTPUT: RETVAL void create(self) uuid_context_t *self; ALIAS: Data::UUID::create_bin = F_BIN Data::UUID::create_str = F_STR Data::UUID::create_hex = F_HEX Data::UUID::create_b64 = F_B64 PREINIT: perl_uuid_time_t timestamp; unsigned16 clockseq; perl_uuid_t uuid; FILE *fd; mode_t mask; PPCODE: clockseq = self->state.cs; get_current_time(×tamp); if ( self->state.ts == I64(0) || memcmp(&(self->nodeid), &(self->state.node), sizeof(uuid_node_t))) clockseq = true_random(); else if (timestamp <= self->state.ts) clockseq++; format_uuid_v1(&uuid, clockseq, timestamp, self->nodeid); self->state.node = self->nodeid; self->state.ts = timestamp; self->state.cs = clockseq; if (timestamp > self->next_save ) { mask = umask(_DEFAULT_UMASK); if((fd = fopen(UUID_STATE_NV_STORE, "wb"))) { LOCK(fd); fwrite(&(self->state), sizeof(uuid_state_t), 1, fd); UNLOCK(fd); fclose(fd); } umask(mask); self->next_save = timestamp + (10 * 10 * 1000 * 1000); } ST(0) = make_ret(uuid, ix); XSRETURN(1); void create_from_name(self,nsid,name) uuid_context_t *self; perl_uuid_t *nsid; SV *name; ALIAS: Data::UUID::create_from_name_bin = F_BIN Data::UUID::create_from_name_str = F_STR Data::UUID::create_from_name_hex = F_HEX Data::UUID::create_from_name_b64 = F_B64 PREINIT: SV *ctx; unsigned char hash[16]; perl_uuid_t net_nsid; perl_uuid_t uuid; PPCODE: net_nsid = *nsid; net_nsid.time_low = htonl(net_nsid.time_low); net_nsid.time_mid = htons(net_nsid.time_mid); net_nsid.time_hi_and_version = htons(net_nsid.time_hi_and_version); ctx = MD5Init(); MD5Update(ctx, sv_2mortal(newSVpv((char*)&net_nsid, sizeof(perl_uuid_t)))); MD5Update(ctx, name); MD5Final(hash, ctx); format_uuid_v3(&uuid, hash); ST(0) = make_ret(uuid, ix); XSRETURN(1); int compare(self,u1,u2) uuid_context_t *self; perl_uuid_t *u1; perl_uuid_t *u2; PREINIT: int i; CODE: RETVAL = 0; CHECK(u1->time_low, u2->time_low); CHECK(u1->time_mid, u2->time_mid); CHECK(u1->time_hi_and_version, u2->time_hi_and_version); CHECK(u1->clock_seq_hi_and_reserved, u2->clock_seq_hi_and_reserved); CHECK(u1->clock_seq_low, u2->clock_seq_low); for (i = 0; i < 6; i++) { if (u1->node[i] < u2->node[i]) RETVAL = -1; if (u1->node[i] > u2->node[i]) RETVAL = 1; } OUTPUT: RETVAL void to_string(self,uuid) uuid_context_t *self; perl_uuid_t *uuid; ALIAS: Data::UUID::to_hexstring = F_HEX Data::UUID::to_b64string = F_B64 PPCODE: ST(0) = make_ret(*uuid, ix ? ix : F_STR); XSRETURN(1); void from_string(self,str) uuid_context_t *self; char *str; ALIAS: Data::UUID::from_hexstring = F_HEX Data::UUID::from_b64string = F_B64 PREINIT: perl_uuid_t uuid; char *from, *to; int c; unsigned int i; unsigned char buf[4]; PPCODE: switch(ix) { case F_BIN: case F_STR: case F_HEX: from = str; memset(&uuid, 0x00, sizeof(perl_uuid_t)); if ( from[0] == '0' && from[1] == 'x' ) from += 2; for (i = 0; i < sizeof(perl_uuid_t); i++) { if (*from == '-') from++; if (sscanf(from, "%2x", &c) != 1) croak("from_string(%s) failed...\n", str); ((unsigned char*)&uuid)[i] = (unsigned char)c; from += 2; } uuid.time_low = ntohl(uuid.time_low); uuid.time_mid = ntohs(uuid.time_mid); uuid.time_hi_and_version = ntohs(uuid.time_hi_and_version); break; case F_B64: from = str; to = (char*)&uuid; while(from < (str + strlen(str))) { i = 0; memset(buf, 254, 4); do { c = index64[(int)*from++]; if (c != 255) buf[i++] = (unsigned char)c; if (from == (str + strlen(str))) break; } while (i < 4); if (buf[0] == 254 || buf[1] == 254) break; *to++ = (buf[0] << 2) | ((buf[1] & 0x30) >> 4); if (buf[2] == 254) break; *to++ = ((buf[1] & 0x0F) << 4) | ((buf[2] & 0x3C) >> 2); if (buf[3] == 254) break; *to++ = ((buf[2] & 0x03) << 6) | buf[3]; } break; default: croak("invalid type %d\n", ix); break; } ST(0) = make_ret(uuid, F_BIN); XSRETURN(1); #if DU_THREADSAFE void CLONE(klass) CODE: MUTEX_LOCK(&instances_mutex); ptable_walk(instances, inc, instances); MUTEX_UNLOCK(&instances_mutex); #endif void DESTROY(self) uuid_context_t *self; PREINIT: #if DU_THREADSAFE UV count; #endif FILE *fd; mode_t mask; CODE: #if DU_THREADSAFE MUTEX_LOCK(&instances_mutex); count = PTR2UV(ptable_fetch(instances, self)); count--; ptable_store(instances, self, (void *)count); MUTEX_UNLOCK(&instances_mutex); if (count == 0) { #endif mask = umask(_DEFAULT_UMASK); if ((fd = fopen(UUID_STATE_NV_STORE, "wb"))) { LOCK(fd); fwrite(&(self->state), sizeof(uuid_state_t), 1, fd); UNLOCK(fd); fclose(fd); }; umask(mask); PerlMemShared_free(self); #if DU_THREADSAFE } #endif BOOT: { HV *stash = gv_stashpv("Data::UUID", 0); STRLEN len = sizeof(perl_uuid_t); #if DU_THREADSAFE instances = ptable_new(); MUTEX_INIT(&instances_mutex); #endif newCONSTSUB(stash, "NameSpace_DNS", newSVpv((char *)&NameSpace_DNS, len)); newCONSTSUB(stash, "NameSpace_URL", newSVpv((char *)&NameSpace_URL, len)); newCONSTSUB(stash, "NameSpace_OID", newSVpv((char *)&NameSpace_OID, len)); newCONSTSUB(stash, "NameSpace_X500", newSVpv((char *)&NameSpace_X500, len)); } Data-UUID-1.226/typemap000644 000767 000024 00000000475 11172413335 014656 0ustar00rjbsstaff000000 000000 perl_uuid_t* T_PV uuid_context_t* T_PTRUUID INPUT T_PTRUUID if (SvROK($arg) && sv_derived_from($arg, \"Data::UUID\")) { IV tmp = SvIV((SV*)SvRV($arg)); $var = INT2PTR($type,tmp); } else croak(\"$var is not of type Data::UUID\") OUTPUT T_PTRUUID sv_setref_pv($arg, \"Data::UUID\", (void*)$var); Data-UUID-1.226/ptable.h000644 000767 000024 00000012245 12166144604 014676 0ustar00rjbsstaff000000 000000 /* This file is part of the Variable::Magic Perl module. * See http://search.cpan.org/dist/Variable-Magic/ */ /* This is a pointer table implementation essentially copied from the ptr_table * implementation in perl's sv.c, except that it has been modified to use memory * shared across threads. * Copyright goes to the original authors, bug reports to me. */ /* This header is designed to be included several times with different * definitions for PTABLE_NAME and PTABLE_VAL_FREE(). */ #undef VOID2 #ifdef __cplusplus # define VOID2(T, P) static_cast(P) #else # define VOID2(T, P) (P) #endif #undef pPTBLMS #undef pPTBLMS_ #undef aPTBLMS #undef aPTBLMS_ /* Context for PerlMemShared_* functions */ #ifdef PERL_IMPLICIT_SYS # define pPTBLMS pTHX # define pPTBLMS_ pTHX_ # define aPTBLMS aTHX # define aPTBLMS_ aTHX_ #else # define pPTBLMS void # define pPTBLMS_ # define aPTBLMS # define aPTBLMS_ #endif #ifndef pPTBL # define pPTBL pPTBLMS #endif #ifndef pPTBL_ # define pPTBL_ pPTBLMS_ #endif #ifndef aPTBL # define aPTBL aPTBLMS #endif #ifndef aPTBL_ # define aPTBL_ aPTBLMS_ #endif #ifndef PTABLE_NAME # define PTABLE_NAME ptable #endif #ifndef PTABLE_VAL_FREE # define PTABLE_VAL_FREE(V) #endif #ifndef PTABLE_JOIN # define PTABLE_PASTE(A, B) A ## B # define PTABLE_JOIN(A, B) PTABLE_PASTE(A, B) #endif #ifndef PTABLE_PREFIX # define PTABLE_PREFIX(X) PTABLE_JOIN(PTABLE_NAME, X) #endif #ifndef ptable_ent typedef struct ptable_ent { struct ptable_ent *next; const void * key; void * val; } ptable_ent; #define ptable_ent ptable_ent #endif /* !ptable_ent */ #ifndef ptable typedef struct ptable { ptable_ent **ary; size_t max; size_t items; } ptable; #define ptable ptable #endif /* !ptable */ #ifndef ptable_new STATIC ptable *ptable_new(pPTBLMS) { #define ptable_new() ptable_new(aPTBLMS) ptable *t = VOID2(ptable *, PerlMemShared_malloc(sizeof *t)); t->max = 15; t->items = 0; t->ary = VOID2(ptable_ent **, PerlMemShared_calloc(t->max + 1, sizeof *t->ary)); return t; } #endif /* !ptable_new */ #ifndef PTABLE_HASH # define PTABLE_HASH(ptr) \ ((PTR2UV(ptr) >> 3) ^ (PTR2UV(ptr) >> (3 + 7)) ^ (PTR2UV(ptr) >> (3 + 17))) #endif #ifndef ptable_find STATIC ptable_ent *ptable_find(const ptable * const t, const void * const key) { #define ptable_find ptable_find ptable_ent *ent; const UV hash = PTABLE_HASH(key); ent = t->ary[hash & t->max]; for (; ent; ent = ent->next) { if (ent->key == key) return ent; } return NULL; } #endif /* !ptable_find */ #ifndef ptable_fetch STATIC void *ptable_fetch(const ptable * const t, const void * const key) { #define ptable_fetch ptable_fetch const ptable_ent *const ent = ptable_find(t, key); return ent ? ent->val : NULL; } #endif /* !ptable_fetch */ #ifndef ptable_split STATIC void ptable_split(pPTBLMS_ ptable * const t) { #define ptable_split(T) ptable_split(aPTBLMS_ (T)) ptable_ent **ary = t->ary; const size_t oldsize = t->max + 1; size_t newsize = oldsize * 2; size_t i; ary = VOID2(ptable_ent **, PerlMemShared_realloc(ary, newsize * sizeof(*ary))); Zero(&ary[oldsize], newsize - oldsize, sizeof(*ary)); t->max = --newsize; t->ary = ary; for (i = 0; i < oldsize; i++, ary++) { ptable_ent **curentp, **entp, *ent; if (!*ary) continue; curentp = ary + oldsize; for (entp = ary, ent = *ary; ent; ent = *entp) { if ((newsize & PTABLE_HASH(ent->key)) != i) { *entp = ent->next; ent->next = *curentp; *curentp = ent; continue; } else entp = &ent->next; } } } #endif /* !ptable_split */ STATIC void PTABLE_PREFIX(_store)(pPTBL_ ptable * const t, const void * const key, void * const val) { ptable_ent *ent = ptable_find(t, key); if (ent) { void *oldval = ent->val; PTABLE_VAL_FREE(oldval); ent->val = val; } else if (val) { const size_t i = PTABLE_HASH(key) & t->max; ent = VOID2(ptable_ent *, PerlMemShared_malloc(sizeof *ent)); ent->key = key; ent->val = val; ent->next = t->ary[i]; t->ary[i] = ent; t->items++; if (ent->next && t->items > t->max) ptable_split(t); } } #ifndef ptable_walk STATIC void ptable_walk(pTHX_ ptable * const t, void (*cb)(pTHX_ ptable_ent *ent, void *userdata), void *userdata) { #define ptable_walk(T, CB, UD) ptable_walk(aTHX_ (T), (CB), (UD)) if (t && t->items) { register ptable_ent ** const array = t->ary; size_t i = t->max; do { ptable_ent *entry; for (entry = array[i]; entry; entry = entry->next) cb(aTHX_ entry, userdata); } while (i--); } } #endif /* !ptable_walk */ STATIC void PTABLE_PREFIX(_clear)(pPTBL_ ptable * const t) { if (t && t->items) { register ptable_ent ** const array = t->ary; size_t i = t->max; do { ptable_ent *entry = array[i]; while (entry) { ptable_ent * const oentry = entry; void *val = oentry->val; entry = entry->next; PTABLE_VAL_FREE(val); PerlMemShared_free(oentry); } array[i] = NULL; } while (i--); t->items = 0; } } STATIC void PTABLE_PREFIX(_free)(pPTBL_ ptable * const t) { if (!t) return; PTABLE_PREFIX(_clear)(aPTBL_ t); PerlMemShared_free(t->ary); PerlMemShared_free(t); } #undef pPTBL #undef pPTBL_ #undef aPTBL #undef aPTBL_ #undef PTABLE_NAME #undef PTABLE_VAL_FREE Data-UUID-1.226/META.yml000644 000767 000024 00000001266 13644660517 014540 0ustar00rjbsstaff000000 000000 --- abstract: 'Globally/Universally Unique Identifiers (GUIDs/UUIDs)' author: - 'Ricardo Signes ' build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.44, CPAN::Meta::Converter version 2.150010' license: bsd meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Data-UUID no_index: directory: - t - inc requires: Digest::MD5: '0' resources: bugtracker: https://github.com/rjbs/Data-UUID/issues repository: https://github.com/rjbs/Data-UUID version: '1.226' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Data-UUID-1.226/Makefile.PL000644 000767 000024 00000011771 13431437163 015234 0ustar00rjbsstaff000000 000000 use 5.006; use strict; use warnings; use ExtUtils::MakeMaker; use Config; use Getopt::Long qw(GetOptions :config pass_through); use Pod::Usage qw(pod2usage); use File::Spec; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. #added by Lincoln Baxter to fix cflags (for long long on HPUX) #guidence from DBD-Oracle module { package MY; # SUPER needs package context, $self is not sufficient use strict; use Config; my $os = $^O; sub const_cccmd { my ($self) = shift; local($_) = $self->SUPER::const_cccmd(@_); # are we using the non-bundled hpux compiler? if ($os eq "hpux" and $Config::Config{ccflags} =~ /-Aa\b/) { print "Changing -Aa to -Ae for HP-UX in ccmd to allow for long long.\n" if s/-Aa\b/-Ae/g; # allow "long long" in UUID.h } $_; } sub cflags { my ($self) = shift; local($_) = $self->SUPER::cflags(@_); # are we using the non-bundled hpux compiler? if ($os eq "hpux" and $Config::Config{ccflags} =~ /-Aa\b/) { print "Changing -Aa to -Ae for HP-UX in cflags.\n" if s/-Aa\b/-Ae/g; # allow "long long" in UUID.h } $_; } }; sub c_quote { my $str = shift; $str =~ s{([^\w/:_+\-\. ])}{sprintf "\\%03o", ord $1}ge; qq("$str"); } sub shell_quote { my $str = shift; return '""' if $str eq ''; if ($^O eq 'MSWin32') { if ($str =~ /[ \t\n\x0b"]/) { $str =~ s{(\\+)(?="|\z)}{$1$1}g; $str =~ s{"}{\\"}g; return qq("$str"); } return $str; } else { $str =~ s/'/'\\''/g; return qq('$str'); } } WriteMakefile( ($] >= 5.005 ## Add these new keywords supported since 5.005 ? (ABSTRACT_FROM => 'UUID.pm', # retrieve abstract from module AUTHOR => 'Ricardo Signes ') : ()), NAME => 'Data::UUID', VERSION_FROM => 'UUID.pm', # finds $VERSION PREREQ_PM => { 'Digest::MD5' => '0' }, # e.g., Module::Name => 1.1 LICENSE => 'bsd', LIBS => [], # e.g., '-lm' #works without -lsocket DEFINE => '', # e.g., '-DHAVE_SOMETHING' # Insert -I. if you add *.h files later: INC => '', # e.g., '-I/usr/include/other' # Un-comment this if you add C files to link with later: OBJECT => '$(O_FILES)', # link all the C files too META_MERGE => { resources => { bugtracker => 'https://github.com/rjbs/Data-UUID/issues', repository => 'https://github.com/rjbs/Data-UUID', }, }, CONFIGURE => sub { my %opt; GetOptions(\%opt, 's|state-storage-directory:s', 'd|default-umask:s', 'help|?', 'man') or pod2usage(2); pod2usage(1) if $opt{help}; pod2usage(-verbose => 2) if $opt{man}; print "Configured options (run perl Makefile.PL --help for how to change this):\n"; my $d = File::Spec->tmpdir; $d = $opt{s} || $d; print "\tUUID state storage: $d\n"; $d =~ s/\\/\\\\/g if $^O eq 'MSWin32'; my $m = '0007'; unless ($^O eq 'MSWin32') { $m = $opt{d} || $m; print "\tdefault umask: $m\n"; } chmod(0666, sprintf("%s/%s", $d, ".UUID_NODEID")); chmod(0666, sprintf("%s/%s", $d, ".UUID_STATE")); return { DEFINE => '-D_STDIR=' . shell_quote(c_quote($d)) . ' -D' . shell_quote("__$Config{osname}__") . ' -D_DEFAULT_UMASK=' . shell_quote($m) }; } ); __END__ =head1 NAME Makefile.PL - configure Makefile for Data::UUID =head1 SYNOPSIS perl Makefile.PL [options] [EU::MM options] perl Makefile.PL -s=/var/local/lib/data-uuid -d=0007 Options: --state-storage-directory directory for storing library state information --default-umask umask for files in the state storage directory --help brief help message --man full documentation Options can be abbreviated, see L. =head1 OPTIONS =over =item --state-storage-directory Optional. Takes a string that is interpreted as directory for storing library state information. Default is c:/tmp/ on Windows if it already exists, or the operating system's temporary directory (see tmpdir in L), or /var/tmp as fallback. =item --default-umask Optional. Takes a string that is interpreted as umask for the files in the state storage directory. Default is 0007. This is ignored on Windows. =item --help Print a brief help message and exits. =item --man Prints the manual page and exits. =back =head1 DESCRIPTION B writes the Makefile for the Data::UUID library. It is configured with the options L and L. Unless given, default values are used. In any case the values are printed for confirmation. Additionally, the usual EU::MM options are processed, see L. Data-UUID-1.226/UUID.pm000644 000767 000024 00000010647 13644660476 014402 0ustar00rjbsstaff000000 000000 package Data::UUID; use strict; use Carp; require Exporter; require DynaLoader; require Digest::MD5; our @ISA = qw(Exporter DynaLoader); our @EXPORT = qw( NameSpace_DNS NameSpace_OID NameSpace_URL NameSpace_X500 ); our $VERSION = '1.226'; bootstrap Data::UUID $VERSION; 1; __END__ =head1 NAME Data::UUID - Globally/Universally Unique Identifiers (GUIDs/UUIDs) =head1 SEE INSTEAD? The module L provides another interface for generating GUIDs. Right now, it relies on Data::UUID, but it may not in the future. Its interface may be just a little more straightforward for the average Perl programer. =head1 SYNOPSIS use Data::UUID; $ug = Data::UUID->new; $uuid1 = $ug->create(); $uuid2 = $ug->create_from_name(, ); $res = $ug->compare($uuid1, $uuid2); $str = $ug->to_string( $uuid ); $uuid = $ug->from_string( $str ); =head1 DESCRIPTION This module provides a framework for generating v3 UUIDs (Universally Unique Identifiers, also known as GUIDs (Globally Unique Identifiers). A UUID is 128 bits long, and is guaranteed to be different from all other UUIDs/GUIDs generated until 3400 CE. UUIDs were originally used in the Network Computing System (NCS) and later in the Open Software Foundation's (OSF) Distributed Computing Environment. Currently many different technologies rely on UUIDs to provide unique identity for various software components. Microsoft COM/DCOM for instance, uses GUIDs very extensively to uniquely identify classes, applications and components across network-connected systems. The algorithm for UUID generation, used by this extension, is described in the Internet Draft "UUIDs and GUIDs" by Paul J. Leach and Rich Salz. (See RFC 4122.) It provides reasonably efficient and reliable framework for generating UUIDs and supports fairly high allocation rates -- 10 million per second per machine -- and therefore is suitable for identifying both extremely short-lived and very persistent objects on a given system as well as across the network. This modules provides several methods to create a UUID. In all methods, C<< >> is a UUID and C<< >> is a free form string. # creates binary (16 byte long binary value) UUID. $ug->create(); $ug->create_bin(); # creates binary (16-byte long binary value) UUID based on particular # namespace and name string. $ug->create_from_name(, ); $ug->create_from_name_bin(, ); # creates UUID string, using conventional UUID string format, # such as: 4162F712-1DD2-11B2-B17E-C09EFE1DC403 # Note that digits A-F are capitalized, which is contrary to rfc4122 $ug->create_str(); $ug->create_from_name_str(, ); # creates UUID string as a hex string, # such as: 0x4162F7121DD211B2B17EC09EFE1DC403 # Note that digits A-F are capitalized, which is contrary to rfc4122 $ug->create_hex(); $ug->create_from_name_hex(, ); # creates UUID string as a Base64-encoded string $ug->create_b64(); $ug->create_from_name_b64(, ); Binary UUIDs can be converted to printable strings using following methods: # convert to conventional string representation $ug->to_string(); # convert to hex string (using upper, rather than lower, case letters) $ug->to_hexstring(); # convert to Base64-encoded string $ug->to_b64string(); Conversely, string UUIDs can be converted back to binary form: # recreate binary UUID from string $ug->from_string(); $ug->from_hexstring(); # recreate binary UUID from Base64-encoded string $ug->from_b64string(); Finally, two binary UUIDs can be compared using the following method: # returns -1, 0 or 1 depending on whether uuid1 less # than, equals to, or greater than uuid2 $ug->compare(, ); Examples: use Data::UUID; # this creates a new UUID in string form, based on the standard namespace # UUID NameSpace_URL and name "www.mycompany.com" $ug = Data::UUID->new; print $ug->create_from_name_str(NameSpace_URL, "www.mycompany.com"); =head2 EXPORT The module allows exporting of several standard namespace UUIDs: =over =item NameSpace_DNS =item NameSpace_URL =item NameSpace_OID =item NameSpace_X500 =back =head1 AUTHOR Alexander Golomshtok =head1 SEE ALSO The Internet Draft "UUIDs and GUIDs" by Paul J. Leach and Rich Salz (RFC 4122) =cut Data-UUID-1.226/smp-test/000755 000767 000024 00000000000 13644660517 015036 5ustar00rjbsstaff000000 000000 Data-UUID-1.226/META.json000644 000767 000024 00000002201 13644660517 014676 0ustar00rjbsstaff000000 000000 { "abstract" : "Globally/Universally Unique Identifiers (GUIDs/UUIDs)", "author" : [ "Ricardo Signes " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.44, CPAN::Meta::Converter version 2.150010", "license" : [ "bsd" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Data-UUID", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Digest::MD5" : "0" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/rjbs/Data-UUID/issues" }, "repository" : { "url" : "https://github.com/rjbs/Data-UUID" } }, "version" : "1.226", "x_serialization_backend" : "JSON::PP version 4.04" } Data-UUID-1.226/smp-test/uuid-fork.pl000644 000767 000024 00000000330 11111625064 017255 0ustar00rjbsstaff000000 000000 #!/usr/bin/perl use Data::UUID 'NameSpace_URL'; #my $du = Data::UUID->new; #$du->create_str; if (fork()) { print "GOT :".Data::UUID->new->create_str; exit; } print "GOT :".Data::UUID->new->create_str; Data-UUID-1.226/smp-test/collision.t000644 000767 000024 00000000465 11111625064 017204 0ustar00rjbsstaff000000 000000 #!/usr/bin/perl -w my $cnt = shift || 1000; my $collision = 0; for (1..$cnt) { my $foo = `$^X -l -Mblib smp-test/uuid-fork.pl`; my @ret = ($foo =~ m/^(.*)$/mg); ++$collision#, print "==> collision ($foo)\n" if $ret[0] eq $ret[1]; } print sprintf("%5.3f %% collision\n", $collision*100/$cnt); Data-UUID-1.226/t/pod.t000644 000767 000024 00000000406 11111625064 014455 0ustar00rjbsstaff000000 000000 use Test::More; plan skip_all => "Pod coverage tests are not active. Please set \$ENV{AUTHOR_TESTING} to activate." unless $ENV{AUTHOR_TESTING}; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok(); Data-UUID-1.226/t/segv.t000644 000767 000024 00000000247 11172413335 014645 0ustar00rjbsstaff000000 000000 #!perl use strict; use warnings; use Test::More tests => 2; use Data::UUID; eval { Data::UUID->create; }; like $@, qr{self is not of type Data::UUID}; ok 1; Data-UUID-1.226/t/threads.t000644 000767 000024 00000001375 12166144614 015343 0ustar00rjbsstaff000000 000000 use strict; use warnings; use Test::More; use Config; BEGIN { plan skip_all => 'Perl not compiled with useithreads' if !$Config{useithreads}; plan skip_all => 'This test does not cope well with this version of perl' if "$]" == 5.008_002 or ("$]" < 5.013_004 and not $ENV{AUTHOR_TESTING}); plan tests => 4; } use threads; use Data::UUID; my $ug = Data::UUID->new; my @threads = map { threads->create(sub { ($ug->create_str, Data::UUID->new->create_str) }); } 1 .. 20; my @ret = map { $_->join } @threads; pass 'we survived our threads'; is @ret, 40, 'got as all the uuids we expected'; ok !grep({ !defined } @ret), 'uuids look sane'; my %uuids = map { $_ => 1 } @ret; is keys %uuids, @ret, "all UUIDs are unique"; Data-UUID-1.226/t/leaky_dollar_bang.t000644 000767 000024 00000000606 11215546765 017345 0ustar00rjbsstaff000000 000000 use strict; use warnings; use Test::More tests => 1; use Data::UUID qw(NameSpace_DNS); my $generator = new Data::UUID; open(my $bad_fh,"<","/a/failing/path/that/does/not/exist/but/sets/dollarbang"); eval { ok($generator->create_from_name_str( NameSpace_DNS, '1.2.3.4' ), "\$! didn't leak!");; }; if (my $msg = $@) { ok(undef, "create_from_name_str failed: $msg"); } Data-UUID-1.226/t/basic.t000644 000767 000024 00000002251 11111625064 014754 0ustar00rjbsstaff000000 000000 #!perl use strict; use warnings; use Test::More tests => 28; BEGIN { use_ok('Data::UUID'); } my $ug = Data::UUID->new; isa_ok($ug, 'Data::UUID'); ok(my $uuid1 = $ug->create(), "create a new uuid"); ok(length($uuid1) eq 16, 'correct length of uuid'); ok(my $uuid2 = $ug->to_hexstring($uuid1), "hexstringify it"); ok(my $uuid3 = $ug->from_string($uuid2), "create a uuid from that string"); ok(!$ug->compare($uuid1, $uuid3), "they compare as equal"); ok(my $uuid4 = $ug->to_b64string($uuid1), "get base64 string of original uuid"); ok(my $uuid5 = $ug->to_b64string($uuid3), "get base64 string of from_string"); is($uuid4, $uuid5, "those base64 strings are equal"); ok(my $uuid6 = $ug->from_b64string($uuid5), "make uuid from the base64 string"); ok(!$ug->compare($uuid6,$uuid1), "and it compares at equal, too"); # some basic "all unique" tests my $HOW_MANY = 15; my %uuids; $uuids{ $ug->to_b64string($ug->create) } = 1 for 1 .. ($HOW_MANY); is( scalar keys %uuids, $HOW_MANY, "we get all unique UUIDs", ); for my $uuid (keys %uuids) { ok( index($uuid, "\n") == -1, "no carriage return in base64 version", ); } Data-UUID-1.226/t/from-name-collisions.t000644 000767 000024 00000000562 11111625064 017733 0ustar00rjbsstaff000000 000000 use strict; use warnings; use Test::More tests => 1; use Data::UUID qw(NameSpace_DNS); my $generator = new Data::UUID; my %res; for my $id ( 1 .. 1000 ) { $res{ $generator->create_from_name_str( NameSpace_DNS, $id ) }++; } my $collisions = 0; while ( my ($k, $v) = each %res ) { next if $v == 1; $collisions += $v; } is($collisions, 0, "no collisions"); Data-UUID-1.226/t/pod-coverage.t000644 000767 000024 00000001344 11111625064 016250 0ustar00rjbsstaff000000 000000 use strict; use Test::More; plan skip_all => "Pod coverage tests are not active. Please set \$ENV{AUTHOR_TESTING} to activate." unless $ENV{AUTHOR_TESTING}; eval "use Test::Pod::Coverage 1.06"; plan skip_all => "Test::Pod::Coverage 1.06 required for testing POD coverage" if $@; # Doesn't this show you why the pod-coverage Kwalitee metric is bull? my $covered = [ map { qr/\A$_\z/ } qw( compare constant create create_b64 create_bin create_from_name create_from_name_b64 create_from_name_bin create_from_name_hex create_from_name_str create_hex create_str from_b64string from_hexstring from_string new to_b64string to_hexstring to_string )]; all_pod_coverage_ok({also_private => $covered });