UUID-0.24/0000755000175000017500000000000012457117723010352 5ustar rikrikUUID-0.24/Makefile.PL0000644000175000017500000001405212450003216012306 0ustar rikrikuse strict; use warnings; use Devel::CheckLib; use ExtUtils::MakeMaker; # ARRRRR!.. there are _at_least_ 3 different UUID interfaces: # Free/NetBSD/MacOSX, Windows, and e2fsprogs. # ... this is gonna suck! print "#\n"; # if the compiler can't find it, # no sense wasting our time... print "# ===> Checking for -luuid\n"; check_lib_or_exit( lib => 'uuid', debug => 1, ); print "#\n"; my @hfiles; for my $try (qw{ uuid/uuid.h uuid.h rpc.h }) { print "# ===> Checking for $try\n"; eval { assert_lib( lib => 'uuid', header => $try, debug => 1, )}; unless ( $@ ) { push @hfiles, $try; print "# ===> Found!\n"; } print "#\n"; } die "No header file found. Can't continue.\n" unless @hfiles; my $header; my $defs = []; my $libs = []; while ( $header = shift @hfiles ) { try_rpc( $header ) and last; try_e2fs( $header ) and last; try_win( $header ) and last; } die "No interface found. Can't continue.\n" unless $header; sub try_rpc { my $hdr = shift; print "# ===> Checking for RPC interface in $hdr\n"; eval { assert_lib( lib => 'uuid', header => $hdr, debug => 1, function => qq/ char str[37]; uuid_t u1,u2; int32_t r,s; uuid_create(&u1,&s); uuid_create_nil(&u2,&s); uuid_from_string(str,&u1,&s); uuid_to_string(&u1,&str,&s); r = uuid_compare(&u1,&u2,&s); r = uuid_equal(&u1,&u2,&s); r = uuid_is_nil(&u1,&s); return 0; /, )}; if ($@) { my $L = length $@; print "# ===> Err($L): \"$@\"\n"; return 0 } push @$defs, '-DPERL__UUID__RPC_INT'; push @$libs, '-luuid'; print "# ===> Found!\n"; print "#\n"; return 1; } sub try_e2fs { my $hdr = shift; print "# ===> Checking for e2fs interface in $hdr\n"; eval { assert_lib( lib => 'uuid', header => $hdr, debug => 1, function => qq/ int i; char s[37]; uuid_t u,uu; uuid_generate(u); uuid_generate_random(u); uuid_generate_time(u); uuid_unparse(u,s); uuid_unparse_lower(u,s); uuid_unparse_upper(u,s); uuid_parse(s,u); uuid_clear(u); uuid_copy(uu,u); i = uuid_compare(u,uu); i = uuid_is_null(u); return 0; /, )}; if ($@) { my $L = length $@; print "# ===> Err($L): \"$@\"\n"; return 0 } push @$defs, '-DPERL__UUID__E2FS_INT'; push @$libs, '-luuid'; print "# ===> Found!\n"; print "#\n"; return 1; } sub try_win { my $hdr = shift; print "# ===> Checking for Win interface in $hdr\n"; eval { assert_lib( lib => 'rpcrt4', header => [ $hdr, 'rpcdce.h' ], debug => 1, function => qq/ int i; UUID u,uu; RPC_CSTR cs; RPC_STATUS st; unsigned char *s; i = UuidCompare(&u,&uu,&st); st = UuidCreate(&u); st = UuidCreateNil(&uu); st = UuidCreateSequential(&uu); i = UuidEqual(&u,&uu,&st); st = UuidFromString(cs,&u); i = UuidIsNil(&u,&st); st = UuidToString(&u,&s); return 0; /, )}; if ($@) { my $L = length $@; print "# ===> Err($L): \"$@\"\n"; return 0 } push @$defs, '-DPERL__UUID__WIN_INT'; push @$libs, '-lrpcrt4'; print "# ===> Found!\n"; print "#\n"; return 1; } sub get_struct_size { my ( $hdrs, $libs ) = @_; print "# ===> Checking binary size\n"; ( my $lib = $libs->[0] ) =~ s/-l//; check_lib( lib => $lib, header => $hdrs, debug => 1, function => qq/ return sizeof(uuid_t); /, ); my $rv = $? >> 8; print "# ===> $rv\n"; print "#\n"; return $rv; } my $size = get_struct_size( $header, $libs ); push @$defs, "-DPERL__UUID__STRUCT_SZ=$size"; ($header = '-DPERL__UUID__'. uc $header ) =~ y{/.}{__}; push @$defs, $header; print "# ===> Writing Makefile\n"; WriteMakefile1( 'NAME' => 'UUID', 'AUTHOR' => 'Rick Myers ', 'VERSION_FROM' => 'UUID.pm', 'ABSTRACT_FROM' => 'UUID.pm', 'LICENSE' => 'artistic_2', 'MIN_PERL_VERSION' => '5.005', 'LIBS' => $libs, 'DEFINE' => join(' ', @$defs), #$header, 'INC' => '', 'PREREQ_PM' => {}, 'CONFIGURE_REQUIRES' => { 'Devel::CheckLib' => '1.02', }, 'TEST_REQUIRES' => { 'Test' => 0, }, #'META_MERGE' => { # 'resources' => { # #repository => 'URL to repository here', # }, #}, #BUILD_REQUIRES => { #}, ); sub WriteMakefile1 { #Written by Alexandr Ciornii, version 0.21. Added by eumm-upgrade. my %params=@_; my $eumm_version=$ExtUtils::MakeMaker::VERSION; $eumm_version=eval $eumm_version; die "EXTRA_META is deprecated" if exists $params{EXTRA_META}; die "License not specified" if not exists $params{LICENSE}; if ($params{BUILD_REQUIRES} and $eumm_version < 6.5503) { #EUMM 6.5502 has problems with BUILD_REQUIRES $params{PREREQ_PM}={ %{$params{PREREQ_PM} || {}} , %{$params{BUILD_REQUIRES}} }; delete $params{BUILD_REQUIRES}; } delete $params{CONFIGURE_REQUIRES} if $eumm_version < 6.52; delete $params{MIN_PERL_VERSION} if $eumm_version < 6.48; delete $params{META_MERGE} if $eumm_version < 6.46; delete $params{META_ADD} if $eumm_version < 6.46; delete $params{LICENSE} if $eumm_version < 6.31; delete $params{AUTHOR} if $] < 5.005; delete $params{ABSTRACT_FROM} if $] < 5.005; delete $params{BINARY_LOCATION} if $] < 5.005; WriteMakefile(%params); } # stay calm. don't blink. # this is just for me :-) sub MY::postamble { return <" ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.04, CPAN::Meta::Converter version 2.142690", "license" : [ "artistic_2" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "UUID", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0", "Test" : "0" } }, "configure" : { "requires" : { "Devel::CheckLib" : "1.02" } }, "runtime" : { "requires" : { "perl" : "5.005" } } }, "release_status" : "stable", "version" : "0.24" } UUID-0.24/Changes0000644000175000017500000001001712457117260011640 0ustar rikrikRevision history for Perl extension UUID. 0.24 Mon Jan 19 01:05:14 EST 2015 - Add 'extern "C"' for g++ 0.23 Sun Dec 28 18:58:04 EST 2014 - Reverse order of rpc.h and rpcdce.h in UUID.xs (rpc.h first) 0.22 Sun Dec 28 08:42:23 EST 2014 - Ugh! Forgot to include rpcdce.h in UUID.xs 0.21 Sun Dec 28 08:35:23 EST 2014 - Instead of unistd.h, try rpcdce.h on Win - Minor cleanup in test.pl 0.20 Sat Dec 27 19:27:28 EST 2014 - Also include unistd.h when using Rpc.h (Win) - Fix pointer problem in -luuid search on Win - Fix minor header propagation problem in Makefile.PL 0.19 Fri Dec 26 17:09:12 EST 2014 - Fix pointer confusion in do_uuid() on BSD [rt.cpan.org #101137] 0.18 Fri Dec 26 08:20:06 EST 2014 - Allow for non-true/false return from uuid_from_string() on BSD - Remove unused dependency on Config.pm - Added yet more debug info for 'make test' time - Change -DPERL__UUID__UUID_BUF_SZ to -DPERL__UUID__STRUCT_SZ 0.17 Fri Dec 26 05:05:13 EST 2014 - Removed two nested comments on BSD /* sigh */ - Let e2fs machines use sv_cmp too (let's see if OSX Frankenbox works) - Changed warns in Makefile.PL to prints 0.16 Thu Dec 25 18:24:23 EST 2014 - Typo on Windows/BSD - Trying sv_cmp() instead of uuid_compare() on RPC-based machines 0.15 Thu Dec 25 05:55:13 EST 2014 - REALLY fix do_uuid() typo. Really. - Fix pointer problems on BSD - Removed uuid_copy() from BSD. How did that get there? =) - Added yet another test for OSX segfault! - Check and set -DPERL__UUID__UUID_BUF_SZ=?? in Makefile.PL (Should be the same everywhere, right? Right?) 0.14 Wed Dec 24 22:39:42 EST 2014 - Fix typo in Windows do_uuid() for compiler fail on strawberry - Now checking for all header files instead of taking first - Added more detail for failed interface search - Added check for uuid struct size 0.13 Wed Dec 24 07:45:49 EST 2014 - Split -luuid search into header file and interface type stages - Removed SvPV_nolen everywhere (buffer overflows) 0.12 Wed Dec 24 03:07:50 EST 2014 - Added support for non-e2fs systems (BSD, OSX, Win) 0.11_01 Tue Dec 23 20:23:29 EST 2014 - Modified test.pl to hopefully catch where MacOSX fails - Heavy mods to Makefile.PL to differentiate between interfaces - Makefile.PL *lots* more verbose - Lots of #ifdefs added in XS - First shot at code that works for BSD style interface 0.11 Mon Dec 22 19:03:09 EST 2014 - Looks like I've managed to cut the failure reports down a little TOO far, so now splitting the search for -luuid into two separate phases. The first, which I don't want to deal with right now, tests for usability of the -luuid flag by itself. The second, tests for usability of individual functions. We'll deal with platforms that actually find libuuid first, then MAYBE revisit others. 0.10 Mon Dec 22 11:55:30 EST 2014 - Added clear() and is_null() - Added copy() and compare() - Added unparse_lower() and unparse_upper() - Added generate_random() and generate_time() 0.09 Mon Dec 22 04:31:26 EST 2014 - Drag test.pl into this century using Test.pm - Add postamble to Makefile to generate README - Overhaul POD - Fix MacOS warning "unsigned char* <--> char*" 0.08 Sun Dec 21 06:06:21 EST 2014 - Added README with pod2text UUID.pm README - Switched libuuid search to Devel::CheckLib 0.07 Sat Dec 20 21:12:17 EST 2014 - Updated Makefile.PL - Added search for -luuid at Makefile.PL time - Updated license and POD to Artistic 2.0 0.06 Thu Dec 18 08:01:44 EST 2014 - Took over maintaining (Rick Myers - JRM) - Added uuid() 0.05 Fri Dec 14 20:00:00 GMT 2012 - Took over maintaining (Lukas Zapletal - LZAP) - Version bump (no changes) - Releasing in the original location 0.04 Wed Jul 22 20:17:26 PDT 2009 - Seems to be abandoned (again) - Bump version number and upload to PAUSE 0.03 Fri Jan 12 15:24:24 MST 2007 - Added Artistic license - Took over maintaining (Colin Faber - CFABER) 0.02 Unknown - unknown changes 0.01 Thu Feb 8 06:07:59 2001 - original version; created by h2xs 1.20 with options -A -n UUID UUID-0.24/UUID.pm0000644000175000017500000001463312457117325011463 0ustar rikrikpackage UUID; require 5.005; use strict; #use warnings; require Exporter; require DynaLoader; use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK $VERSION); @ISA = qw(Exporter DynaLoader); # This allows declaration use UUID ':all'; # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK # will save memory. %EXPORT_TAGS = ( 'all' => [qw( &clear &compare © &generate &generate_random &generate_time &is_null &parse &unparse &unparse_lower &unparse_upper &uuid )], ); @EXPORT_OK = ( @{$EXPORT_TAGS{'all'}} ); $VERSION = '0.24'; bootstrap UUID $VERSION; # Preloaded methods go here. 1; __END__ =head1 NAME UUID - DCE compatible Universally Unique Identifier library for Perl =head1 SYNOPSIS use UUID ':all'; generate($uuid); # generate binary UUID, prefer random generate_random($uuid); # generate binary UUID, using random generate_time($uuid); # generate binary UUID, using time $string = uuid(); # generate stringified UUID unparse($uuid, $string); # change $uuid string unparse_lower($uuid, $string); # change $uuid to lowercase string unparse_upper($uuid, $string); # change $uuid to uppercase string $rc = parse($string, $uuid); # map string to UUID, return -1 on error copy($dst, $src); # copy binary UUID from $src to $dst compare($uuid1, $uuid2); # compare binary UUIDs clear( $uuid ); # set binary UUID to NULL is_null( $uuid); # compare binary UUID to NULL =head1 DESCRIPTION The UUID library is used to generate unique identifiers for objects that may be accessible beyond the local system. For instance, they could be used to generate unique HTTP cookies across multiple web servers without communication between the servers, and without fear of a name clash. The generated UUIDs can be reasonably expected to be unique within a system, and unique across all systems, and are compatible with those created by the Open Software Foundation (OSF) Distributed Computing Environment (DCE) utility uuidgen. =head1 FUNCTIONS Most of the UUID functions expose the underlying I C interface rather directly. That is, many return their values in their parameters and nothing else. Not very Perlish, is it? It's been like that for a long time though, so not very likely to change any time soon. All take or return UUIDs in either binary or string format. The string format resembles the following: 1b4e28ba-2fa1-11d2-883f-0016d3cca427 Or, in terms of printf(3) format: "%08x-%04x-%04x-%04x-%012x" The binary format is simply a packed 16 byte binary value. =head2 B I<$uuid> B<)> Generates a new binary UUID based on high quality randomness from I, if available. Alternately, the current time, the local ethernet MAC address (if available), and random data generated using a pseudo-random generator are used. The previous content of I<$uuid>, if any, is lost. =head2 B I<$uuid> B<)> Generates a new binary UUID but forces the use of the all-random algorithm, even if a high-quality random number generator (i.e., I) is not available, in which case a pseudo-random generator is used. Note that the use of a pseudo-random generator may compromise the uniqueness of UUIDs generated in this fashion. =head2 B I<$uuid> B<)> Generates a new binary UUID but forces the use of the alternative algorithm which uses the current time and the local ethernet MAC address (if available). This algorithm used to be the default one used to generate UUIDs, but because of the use of the ethernet MAC address, it can leak information about when and where the UUID was generated. This can cause privacy problems in some applications, so the B function only uses this algorithm if a high-quality source of randomness is not available. =head2 B I<$uuid>B<,> I<$string> B<)> Converts the binary UUID in I<$uuid> to string format and returns in I<$string>. The previous content of I<$string>, if any, is lost. The case of the hex digits returned may be upper or lower case, and is dependent on the system-dependent local default. =head2 B I<$uuid>B<,> I<$string> B<)> Same as B but I<$string> is forced to lower case. =head2 B I<$uuid>B<,> I<$string> B<)> Same as B but I<$string> is forced to upper case. =head2 B<$rc = parse(> I<$string>B<,> I<$uuid> B<)> Converts the string format UUID in I<$string> to binary and returns in I<$uuid>. The previous content of I<$uuid>, if any, is lost. Returns 0 on success and -1 on failure. Additionally on failure, the content of I<$uuid> is unchanged. =head2 B I<$uuid> B<)> Sets I<$uuid> equal to the value of the NULL UUID. =head2 B I<$uuid> B<)> Compares the value of I<$uuid> to the NULL UUID. Returns 1 if NULL, and 0 otherwise. =head2 B I<$dst>B<,> I<$src> B<)> Copies the binary I<$src> UUID to I<$dst>. If I<$src> isn't a UUID, I<$dst> is set to the NULL UUID. =head2 B I<$uuid1>B<,> I<$uuid2> B<)> Compares two binary UUIDs. Returns an integer less than, equal to, or greater than zero if I<$uuid1> is less than, equal to, or greater than I<$uuid2>. However, if either operand is not a UUID, falls back to a simple string comparison returning similar values. =head2 B<>I<$string> B<= uuid()> Creates a new string format UUID and returns it in a more Perlish way. Functionally the equivalent of calling B and then B, but throwing away the intermediate binary UUID. =head1 EXPORTS All functions may be imported in the usual manner, either individually or all at once using the "I<:all>" tag. =head1 TODO Need more tests and sanity checks. =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014, 2015 by Rick Myers. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) Details of this license can be found within the 'License' text file. =head1 AUTHOR Current maintainer: Rick Myers . Authors and/or previous maintainers: Lukas Zapletal Joseph N. Hall Colin Faber Peter J. Braam =head1 SEE ALSO B, B, B, B, B, B, B, B, B. =cut UUID-0.24/README0000644000175000017500000001336112457117332011232 0ustar rikrikNAME UUID - DCE compatible Universally Unique Identifier library for Perl SYNOPSIS use UUID ':all'; generate($uuid); # generate binary UUID, prefer random generate_random($uuid); # generate binary UUID, using random generate_time($uuid); # generate binary UUID, using time $string = uuid(); # generate stringified UUID unparse($uuid, $string); # change $uuid string unparse_lower($uuid, $string); # change $uuid to lowercase string unparse_upper($uuid, $string); # change $uuid to uppercase string $rc = parse($string, $uuid); # map string to UUID, return -1 on error copy($dst, $src); # copy binary UUID from $src to $dst compare($uuid1, $uuid2); # compare binary UUIDs clear( $uuid ); # set binary UUID to NULL is_null( $uuid); # compare binary UUID to NULL DESCRIPTION The UUID library is used to generate unique identifiers for objects that may be accessible beyond the local system. For instance, they could be used to generate unique HTTP cookies across multiple web servers without communication between the servers, and without fear of a name clash. The generated UUIDs can be reasonably expected to be unique within a system, and unique across all systems, and are compatible with those created by the Open Software Foundation (OSF) Distributed Computing Environment (DCE) utility uuidgen. FUNCTIONS Most of the UUID functions expose the underlying libuuid C interface rather directly. That is, many return their values in their parameters and nothing else. Not very Perlish, is it? It's been like that for a long time though, so not very likely to change any time soon. All take or return UUIDs in either binary or string format. The string format resembles the following: 1b4e28ba-2fa1-11d2-883f-0016d3cca427 Or, in terms of printf(3) format: "%08x-%04x-%04x-%04x-%012x" The binary format is simply a packed 16 byte binary value. generate( $uuid ) Generates a new binary UUID based on high quality randomness from /dev/urandom, if available. Alternately, the current time, the local ethernet MAC address (if available), and random data generated using a pseudo-random generator are used. The previous content of $uuid, if any, is lost. generate_random( $uuid ) Generates a new binary UUID but forces the use of the all-random algorithm, even if a high-quality random number generator (i.e., /dev/urandom) is not available, in which case a pseudo-random generator is used. Note that the use of a pseudo-random generator may compromise the uniqueness of UUIDs generated in this fashion. generate_time( $uuid ) Generates a new binary UUID but forces the use of the alternative algorithm which uses the current time and the local ethernet MAC address (if available). This algorithm used to be the default one used to generate UUIDs, but because of the use of the ethernet MAC address, it can leak information about when and where the UUID was generated. This can cause privacy problems in some applications, so the generate() function only uses this algorithm if a high-quality source of randomness is not available. unparse( $uuid, $string ) Converts the binary UUID in $uuid to string format and returns in $string. The previous content of $string, if any, is lost. The case of the hex digits returned may be upper or lower case, and is dependent on the system-dependent local default. unparse_lower( $uuid, $string ) Same as unparse() but $string is forced to lower case. unparse_upper( $uuid, $string ) Same as unparse() but $string is forced to upper case. $rc = parse( $string, $uuid ) Converts the string format UUID in $string to binary and returns in $uuid. The previous content of $uuid, if any, is lost. Returns 0 on success and -1 on failure. Additionally on failure, the content of $uuid is unchanged. clear( $uuid ) Sets $uuid equal to the value of the NULL UUID. is_null( $uuid ) Compares the value of $uuid to the NULL UUID. Returns 1 if NULL, and 0 otherwise. copy( $dst, $src ) Copies the binary $src UUID to $dst. If $src isn't a UUID, $dst is set to the NULL UUID. compare( $uuid1, $uuid2 ) Compares two binary UUIDs. Returns an integer less than, equal to, or greater than zero if $uuid1 is less than, equal to, or greater than $uuid2. However, if either operand is not a UUID, falls back to a simple string comparison returning similar values. $string = uuid() Creates a new string format UUID and returns it in a more Perlish way. Functionally the equivalent of calling generate() and then unparse(), but throwing away the intermediate binary UUID. EXPORTS All functions may be imported in the usual manner, either individually or all at once using the ":all" tag. TODO Need more tests and sanity checks. COPYRIGHT AND LICENSE This software is Copyright (c) 2014, 2015 by Rick Myers. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) Details of this license can be found within the 'License' text file. AUTHOR Current maintainer: Rick Myers . Authors and/or previous maintainers: Lukas Zapletal Joseph N. Hall Colin Faber Peter J. Braam SEE ALSO uuid(3), uuid_clear(3), uuid_compare(3), uuid_copy(3), uuid_generate(3), uuid_is_null(3), uuid_parse(3), uuid_unparse(3), perl(1). UUID-0.24/MANIFEST0000644000175000017500000000026612457117723011507 0ustar rikrikChanges License Makefile.PL MANIFEST This list of files META.yml README test.pl UUID.pm UUID.xs META.json Module JSON meta-data (added by MakeMaker) UUID-0.24/META.yml0000644000175000017500000000102312457117723011617 0ustar rikrik--- abstract: 'DCE compatible Universally Unique Identifier library for Perl' author: - 'Rick Myers ' build_requires: ExtUtils::MakeMaker: '0' Test: '0' configure_requires: Devel::CheckLib: '1.02' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.04, CPAN::Meta::Converter version 2.142690' license: artistic_2 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: UUID no_index: directory: - t - inc requires: perl: '5.005' version: '0.24' UUID-0.24/UUID.xs0000644000175000017500000002157112457116652011502 0ustar rikrik#ifdef __cplusplus extern "C" { #endif #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #ifdef PERL__UUID__UUID_UUID_H #include #elif PERL__UUID__UUID_H #include #elif PERL__UUID__RPC_H #include #include #endif #ifdef __cplusplus } #endif /* #ifndef SvPV_nolen # define SvPV_nolen(sv) SvPV(sv, na) #endif */ /* 2 hex digits per byte + 4 separators + 1 trailing null */ #define UUID_BUF_SZ() (2 * PERL__UUID__STRUCT_SZ + 4 + 1) #ifdef PERL__UUID__E2FS_INT #define UUID_T uuid_t #define UUID2SV(u) ((char*)u) #define SV2UUID(s) ((unsigned char*)SvGROW(s, sizeof(uuid_t)+1)) #elif PERL__UUID__RPC_INT #define UUID_T uuid_t #define UUID2SV(u) ((char*)&u) #define SV2UUID(s) ((uuid_t*)SvGROW(s, sizeof(uuid_t)+1)) #elif PERL__UUID__WIN_INT #define UUID_T UUID #define UUID2SV(u) ((char*)&u) #define SV2UUID(s) ((UUID*)SvGROW(s, sizeof(UUID)+1)) #endif #define SV2STR(s) (SvGROW(s, UUID_BUF_SZ()+1)) void do_generate(SV *str) { UUID_T uuid; #ifdef PERL__UUID__E2FS_INT uuid_generate( uuid ); #elif PERL__UUID__RPC_INT int32_t s; uuid_create(&uuid, &s); #elif PERL__UUID__WIN_INT RPC_STATUS st; st = UuidCreate(&uuid); #endif sv_setpvn(str, UUID2SV(uuid), sizeof(UUID_T)); } void do_generate_random(SV *str) { UUID_T uuid; #ifdef PERL__UUID__E2FS_INT uuid_generate_random( uuid ); #elif PERL__UUID__RPC_INT int32_t s; uuid_create(&uuid, &s); #elif PERL__UUID__WIN_INT UuidCreate(&uuid); #endif sv_setpvn(str, UUID2SV(uuid), sizeof(UUID_T)); } void do_generate_time(SV *str) { UUID_T uuid; #ifdef PERL__UUID__E2FS_INT uuid_generate_time( uuid ); #elif PERL__UUID__RPC_INT int32_t s; uuid_create(&uuid, &s); #elif PERL__UUID__WIN_INT UuidCreateSequential(&uuid); #endif sv_setpvn(str, UUID2SV(uuid), sizeof(UUID_T)); } void do_unparse(SV *in, SV * out) { #ifdef PERL__UUID__E2FS_INT char str[UUID_BUF_SZ()]; uuid_unparse(SV2UUID(in), str); sv_setpvn(out, str, UUID_BUF_SZ()-1); #elif PERL__UUID__RPC_INT char *str; int32_t s; uuid_to_string(SV2UUID(in), &str, &s); /* free str */ sv_setpvn(out, str, UUID_BUF_SZ()-1); free(str); #elif PERL__UUID__WIN_INT RPC_CSTR str; RPC_STATUS st; st = UuidToString(SV2UUID(in), &str); /* free str */ if( st != RPC_S_OK ) croak("UuidToString error: %i", st); sv_setpvn(out, str, UUID_BUF_SZ()-1); RpcStringFree(&str); #endif } void do_unparse_lower(SV *in, SV * out) { #ifdef PERL__UUID__E2FS_INT char str[UUID_BUF_SZ()]; uuid_unparse_lower(SV2UUID(in), str); sv_setpvn(out, str, UUID_BUF_SZ()-1); #elif PERL__UUID__RPC_INT char *p, *str; int32_t s; uuid_to_string(SV2UUID(in), &str, &s); /* free str */ for(p=str; *p; ++p) *p = tolower(*p); sv_setpvn(out, str, UUID_BUF_SZ()-1); free(str); #elif PERL__UUID__WIN_INT char *p; RPC_CSTR str; RPC_STATUS st; st = UuidToString(SV2UUID(in), &str); /* free str */ if( st != RPC_S_OK ) croak("UuidToString error: %i", st); for(p=str; *p; ++p) *p = tolower(*p); sv_setpvn(out, str, UUID_BUF_SZ()-1); RpcStringFree(&str); #endif } void do_unparse_upper(SV *in, SV * out) { #ifdef PERL__UUID__E2FS_INT char str[UUID_BUF_SZ()]; uuid_unparse_upper(SV2UUID(in), str); sv_setpvn(out, str, UUID_BUF_SZ()-1); #elif PERL__UUID__RPC_INT char *p, *str; int32_t s; uuid_to_string(SV2UUID(in), &str, &s); /* free str */ for(p=str; *p; ++p) *p = toupper(*p); sv_setpvn(out, str, UUID_BUF_SZ()-1); free(str); #elif PERL__UUID__WIN_INT char *p; RPC_CSTR str; RPC_STATUS st; st = UuidToString(SV2UUID(in), &str); /* free str */ if( st != RPC_S_OK ) croak("UuidToString error: %i", st); for(p=str; *p; ++p) *p = toupper(*p); sv_setpvn(out, str, UUID_BUF_SZ()-1); RpcStringFree(&str); #endif } int do_parse(SV *in, SV * out) { UUID_T uuid; #ifdef PERL__UUID__E2FS_INT int rc; rc = uuid_parse(SV2STR(in), uuid); if( !rc ) sv_setpvn(out, UUID2SV(uuid), sizeof(UUID_T)); return rc; #elif PERL__UUID__RPC_INT int rc; uuid_from_string(SV2STR(in), &uuid, &rc); if( !rc ) sv_setpvn(out, UUID2SV(uuid), sizeof(UUID_T)); return rc == uuid_s_ok ? 0 : -1; #elif PERL__UUID__WIN_INT RPC_STATUS rc; rc = UuidFromString(SV2STR(in), &uuid); if( rc == RPC_S_OK ) sv_setpvn(out, UUID2SV(uuid), sizeof(UUID_T)); return rc == RPC_S_OK ? 0 : -1; #endif } void do_clear(SV *in) { UUID_T uuid; #ifdef PERL__UUID__E2FS_INT uuid_clear(uuid); #elif PERL__UUID__RPC_INT int32_t s; uuid_create_nil(&uuid,&s); #elif PERL__UUID__WIN_INT UuidCreateNil(&uuid); #endif sv_setpvn(in, UUID2SV(uuid), sizeof(UUID_T)); } int do_is_null(SV *in) { #ifdef PERL__UUID__E2FS_INT if( SvCUR(in) != sizeof(uuid_t) ) return 0; return uuid_is_null(SV2UUID(in)); #elif PERL__UUID__RPC_INT int32_t s; return uuid_is_nil(SV2UUID(in),&s); #elif PERL__UUID__WIN_INT int rc; RPC_STATUS st; rc = UuidIsNil(SV2UUID(in), &st); return rc == TRUE ? 1 : 0; #endif } int do_compare(SV *uu1, SV *uu2) { #ifdef PERL__UUID__E2FS_INT /* if( SvCUR(uu1) == sizeof(uuid_t) ) if( SvCUR(uu2) == sizeof(uuid_t) ) return uuid_compare(SV2UUID(uu1), SV2UUID(uu2)); */ #elif PERL__UUID__RPC_INT /* int32_t s; if( SvCUR(uu1) == sizeof(uuid_t) ) if( SvCUR(uu2) == sizeof(uuid_t) ) return uuid_compare(SV2UUID(uu1), SV2UUID(uu2), &s); */ #elif PERL__UUID__WIN_INT #endif return sv_cmp(uu1, uu2); } void do_copy(SV *dst, SV *src) { UUID_T uuid; #ifdef PERL__UUID__E2FS_INT if( SvCUR(src) != sizeof(uuid_t) ) uuid_clear(uuid); else uuid_copy(uuid, SV2UUID(src)); #elif PERL__UUID__RPC_INT int32_t s; if( SvCUR(src) != sizeof(uuid_t) ) uuid_create_nil(&uuid, &s); else memcpy(&uuid, SV2UUID(src), sizeof(uuid_t)); /* uuid_copy(uuid, SV2UUID(src), &s); <-- duh, not on bsd */ #elif PERL__UUID__WIN_INT if( SvCUR(src) != sizeof(uuid_t) ) UuidCreateNil(&uuid); else memcpy(&uuid, SV2UUID(src), sizeof(UUID)); #endif sv_setpvn(dst, UUID2SV(uuid), sizeof(UUID_T)); } SV* do_uuid() { UUID_T uuid; #ifdef PERL__UUID__E2FS_INT char str[UUID_BUF_SZ()]; uuid_generate(uuid); uuid_unparse(uuid, str); return newSVpvn(str, UUID_BUF_SZ()-1); #elif PERL__UUID__RPC_INT SV *sv; char *str; int32_t s; uuid_create(&uuid, &s); uuid_to_string(&uuid, &str, &s); /* free str */ sv = newSVpvn(str, UUID_BUF_SZ()-1); free(str); return sv; #elif PERL__UUID__WIN_INT SV *sv; RPC_STATUS st; RPC_CSTR str; UuidCreateSequential(&uuid); st = UuidToString(&uuid, &str); /* free str */ if( st != RPC_S_OK ) croak("UuidToString error: %i", st); sv = newSVpvn(str, UUID_BUF_SZ()-1); RpcStringFree(&str); return sv; #endif } void do_debug() { SV *bmsg, *smsg; #ifdef PERL__UUID__UUID_UUID_H PerlIO_puts(PerlIO_stdout(), "# Header: uuid/uuid.h\n"); #elif PERL__UUID__UUID_H PerlIO_puts(PerlIO_stdout(), "# Header: uuid.h\n"); #elif PERL__UUID__RPC_H PerlIO_puts(PerlIO_stdout(), "# Header: rpc.h\n"); #endif #ifdef PERL__UUID__E2FS_INT PerlIO_puts(PerlIO_stdout(), "# Interface: e2fs\n"); #elif PERL__UUID__RPC_INT PerlIO_puts(PerlIO_stdout(), "# Interface: rpc\n"); #elif PERL__UUID__WIN_INT PerlIO_puts(PerlIO_stdout(), "# Interface: win\n"); #endif bmsg = mess("# Buffer size: %i\n", UUID_BUF_SZ()); PerlIO_puts(PerlIO_stdout(), SvPVX(bmsg)); smsg = mess("# Struct size: %i\n", PERL__UUID__STRUCT_SZ); PerlIO_puts(PerlIO_stdout(), SvPVX(smsg)); } MODULE = UUID PACKAGE = UUID void generate(str) SV * str PROTOTYPE: $ CODE: do_generate(str); void generate_random(str) SV * str PROTOTYPE: $ CODE: do_generate_random(str); void generate_time(str) SV * str PROTOTYPE: $ CODE: do_generate_time(str); void unparse(in, out) SV * in SV * out PROTOTYPE: $$ CODE: do_unparse(in, out); void unparse_lower(in, out) SV * in SV * out PROTOTYPE: $$ CODE: do_unparse_lower(in, out); void unparse_upper(in, out) SV * in SV * out PROTOTYPE: $$ CODE: do_unparse_upper(in, out); int parse(in, out) SV * in SV * out PROTOTYPE: $$ CODE: RETVAL = do_parse(in, out); OUTPUT: RETVAL void clear(in) SV * in PROTOTYPE: $ CODE: do_clear(in); int is_null(in) SV * in PROTOTYPE: $ CODE: RETVAL = do_is_null(in); OUTPUT: RETVAL void copy(dst, src) SV * dst SV * src CODE: do_copy(dst, src); int compare(uu1, uu2) SV * uu1 SV * uu2 CODE: RETVAL = do_compare(uu1, uu2); OUTPUT: RETVAL SV* uuid() PROTOTYPE: CODE: RETVAL = do_uuid(); OUTPUT: RETVAL void debug() PROTOTYPE: CODE: do_debug(); UUID-0.24/License0000644000175000017500000002152012445413324011650 0ustar rikrikThis software is Copyright (c) 2014 by Rick Myers. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The Artistic License 2.0 Copyright (c) 2000-2006, The Perl Foundation. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble This license establishes the terms under which a given free software Package may be copied, modified, distributed, and/or redistributed. The intent is that the Copyright Holder maintains some artistic control over the development of that Package while still keeping the Package available as open source and free software. You are always permitted to make arrangements wholly outside of this license directly with the Copyright Holder of a given Package. If the terms of this license do not permit the full use that you propose to make of the Package, you should contact the Copyright Holder and seek a different licensing arrangement. Definitions "Copyright Holder" means the individual(s) or organization(s) named in the copyright notice for the entire Package. "Contributor" means any party that has contributed code or other material to the Package, in accordance with the Copyright Holder's procedures. "You" and "your" means any person who would like to copy, distribute, or modify the Package. "Package" means the collection of files distributed by the Copyright Holder, and derivatives of that collection and/or of those files. A given Package may consist of either the Standard Version, or a Modified Version. "Distribute" means providing a copy of the Package or making it accessible to anyone else, or in the case of a company or organization, to others outside of your company or organization. "Distributor Fee" means any fee that you charge for Distributing this Package or providing support for this Package to another party. It does not mean licensing fees. "Standard Version" refers to the Package if it has not been modified, or has been modified only in ways explicitly requested by the Copyright Holder. "Modified Version" means the Package, if it has been changed, and such changes were not explicitly requested by the Copyright Holder. "Original License" means this Artistic License as Distributed with the Standard Version of the Package, in its current version or as it may be modified by The Perl Foundation in the future. "Source" form means the source code, documentation source, and configuration files for the Package. "Compiled" form means the compiled bytecode, object code, binary, or any other form resulting from mechanical transformation or translation of the Source form. Permission for Use and Modification Without Distribution (1) You are permitted to use the Standard Version and create and use Modified Versions for any purpose without restriction, provided that you do not Distribute the Modified Version. Permissions for Redistribution of the Standard Version (2) You may Distribute verbatim copies of the Source form of the Standard Version of this Package in any medium without restriction, either gratis or for a Distributor Fee, provided that you duplicate all of the original copyright notices and associated disclaimers. At your discretion, such verbatim copies may or may not include a Compiled form of the Package. (3) You may apply any bug fixes, portability changes, and other modifications made available from the Copyright Holder. The resulting Package will still be considered the Standard Version, and as such will be subject to the Original License. Distribution of Modified Versions of the Package as Source (4) You may Distribute your Modified Version as Source (either gratis or for a Distributor Fee, and with or without a Compiled form of the Modified Version) provided that you clearly document how it differs from the Standard Version, including, but not limited to, documenting any non-standard features, executables, or modules, and provided that you do at least ONE of the following: (a) make the Modified Version available to the Copyright Holder of the Standard Version, under the Original License, so that the Copyright Holder may include your modifications in the Standard Version. (b) ensure that installation of your Modified Version does not prevent the user installing or running the Standard Version. In addition, the Modified Version must bear a name that is different from the name of the Standard Version. (c) allow anyone who receives a copy of the Modified Version to make the Source form of the Modified Version available to others under (i) the Original License or (ii) a license that permits the licensee to freely copy, modify and redistribute the Modified Version using the same licensing terms that apply to the copy that the licensee received, and requires that the Source form of the Modified Version, and of any works derived from it, be made freely available in that license fees are prohibited but Distributor Fees are allowed. Distribution of Compiled Forms of the Standard Version or Modified Versions without the Source (5) You may Distribute Compiled forms of the Standard Version without the Source, provided that you include complete instructions on how to get the Source of the Standard Version. Such instructions must be valid at the time of your distribution. If these instructions, at any time while you are carrying out such distribution, become invalid, you must provide new instructions on demand or cease further distribution. If you provide valid instructions or cease distribution within thirty days after you become aware that the instructions are invalid, then you do not forfeit any of your rights under this license. (6) You may Distribute a Modified Version in Compiled form without the Source, provided that you comply with Section 4 with respect to the Source of the Modified Version. Aggregating or Linking the Package (7) You may aggregate the Package (either the Standard Version or Modified Version) with other packages and Distribute the resulting aggregation provided that you do not charge a licensing fee for the Package. Distributor Fees are permitted, and licensing fees for other components in the aggregation are permitted. The terms of this license apply to the use and Distribution of the Standard or Modified Versions as included in the aggregation. (8) You are permitted to link Modified and Standard Versions with other works, to embed the Package in a larger work of your own, or to build stand-alone binary or bytecode versions of applications that include the Package, and Distribute the result without restriction, provided the result does not expose a direct interface to the Package. Items That are Not Considered Part of a Modified Version (9) Works (including, but not limited to, modules and scripts) that merely extend or make use of the Package, do not, by themselves, cause the Package to be a Modified Version. In addition, such works are not considered parts of the Package itself, and are not subject to the terms of this license. General Provisions (10) Any use, modification, and distribution of the Standard or Modified Versions is governed by this Artistic License. By using, modifying or distributing the Package, you accept this license. Do not use, modify, or distribute the Package, if you do not accept this license. (11) If your Modified Version has been derived from a Modified Version made by someone other than you, you are nevertheless required to ensure that your Modified Version complies with the requirements of this license. (12) This license does not grant you the right to use any trademark, service mark, tradename, or logo of the Copyright Holder. (13) This license includes the non-exclusive, worldwide, free-of-charge patent license to make, have made, use, offer to sell, sell, import and otherwise transfer the Package with respect to any patent claims licensable by the Copyright Holder that are necessarily infringed by the Package. If you institute patent litigation (including a cross-claim or counterclaim) against any party alleging that the Package constitutes direct or contributory patent infringement, then this Artistic License to you shall terminate on the date that such litigation is filed. (14) Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. UUID-0.24/test.pl0000644000175000017500000000441012450003422011644 0ustar rikrikuse warnings; use Test; BEGIN { plan tests => 34 } use UUID; UUID::debug(); UUID::generate( $bin ); ok length $bin, 16; UUID::generate_random( $bin ); ok length $bin, 16; UUID::generate_time( $bin ); ok length $bin, 16; UUID::unparse( $bin, $str ); ok $str, qr{^[-0-9a-f]+$}i; $rc = UUID::parse( $str, $bin2 ); ok $rc, 0; ok $bin, $bin2; UUID::unparse_lower( $bin, $str ); UUID::unparse_upper( $bin, $str2 ); ok length( $str ), 36; ok $str, qr/^[-a-f0-9]+$/; ok lc( $str ), lc( $str2 ); ok $str ne $str2; # content of uuid is unchanged if parse fails UUID::generate( $bin ); $bin2 = $bin; $str = 'Peter is a moose'; $rc = UUID::parse( $str, $bin ); ok $rc, -1; ok $bin, $bin2; UUID::generate( $bin ); $rc = UUID::is_null( $bin ); ok $rc, 0; UUID::clear( $bin ); ok length( $bin ), 16; ok UUID::is_null( $bin ), 1; $bin = 'bogus value'; ok UUID::is_null( $bin ), 0; # != the null uuid, right? $bin = '1234567890123456'; ok UUID::is_null( $bin ), 0; # still not null # make sure compare operands sane UUID::generate( $bin1 ); $bin2 = 'x'; ok abs(UUID::compare( $bin1, $bin2 )), 1; ok abs(UUID::compare( $bin2, $bin1 )), 1; $bin2 = 'some silly ridulously long string that couldnt possibly be a uuid'; ok abs(UUID::compare( $bin1, $bin2 )), 1; ok abs(UUID::compare( $bin2, $bin1 )), 1; # sane compare $uuid=1; UUID::generate( $uuid ); # this is wrong. dont want to fix it though. ok 1; $bin2 = '1234567890123456'; ok 1; $tmp1 = UUID::compare( $bin1, $bin2 ); ok 1; $tmp2 = UUID::compare( $bin2, $bin1 ); ok 1; $tmp2 = -UUID::compare( $bin2, $bin1 ); ok $tmp1, $tmp2; ok UUID::compare( $bin1, $bin2 ), -UUID::compare( $bin2, $bin1 ); $bin2 = $bin1; ok UUID::compare( $bin1, $bin2 ), 0; # make sure we get back a null if src isnt sane $bin1 = 'x'; UUID::copy( $bin2, $bin1 ); ok UUID::is_null( $bin2 ), 1; $bin1 = 'another really really really long sting'; UUID::copy( $bin2, $bin1 ); ok UUID::is_null( $bin2 ); # sane copy UUID::generate( $bin1 ); $bin2 = '1234567890123456'; UUID::copy( $bin2, $bin1 ); ok UUID::compare( $bin1, $bin2 ), 0; # make sure we get back the same scalar we passed in $bin1 = '1234567890123456'; UUID::generate( $bin2 ); $save1 = \$bin2; UUID::copy( $bin2, $bin1 ); $save2 = \$bin2; ok $save1, $save2; ok $$save1, $$save2; $rc = UUID::uuid(); ok length($rc), 36; exit 0;