UUID-0.31/0000755000175000017500000000000014522341002010330 5ustar rikrikUUID-0.31/LICENSE0000644000175000017500000002152414522341002011341 0ustar rikrikThis software is Copyright (c) 2014-2023 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.31/Makefile.PL0000644000175000017500000003301314522340036012310 0ustar rikrikuse strict; use warnings; use Devel::CheckLib; use ExtUtils::MakeMaker; BEGIN { #local $/; #open my $fh, '<', 'UUID.pm' or die $!; #my $content = <$fh>; #$main::DEV_VERSION = $content =~ /VERSION\s+=\s+\S+_/; $main::USE_DEBUG = 0; @ARGV = map { ( /^UUID_DEBUG=(.+)/ and (($main::USE_DEBUG=$1) or 1) ) ? () : $_ } @ARGV; } use constant DEBUG => $ENV{UUID_DEBUG} || ( $main::USE_DEBUG ? 1 : 0 ) #|| ( $ENV{AUTOMATED_TESTING} && $main::DEV_VERSION ) #|| $main::DEV_VERSION # <--- always debug dev versions || 0 ; # buffering will ruin your day! select STDERR; $|=1; select STDOUT; $|=1; # ARRRRR!.. there are _at_least_ 4 different UUID interfaces: # Free/NetBSD/MacOSX, Windows, e2fsprogs, and OSSP. # ... this is gonna suck! if ( DEBUG ) { warn "#\n"; warn '# Devel::CheckLib::VERSION = ', $Devel::CheckLib::VERSION, "\n"; warn '# ExtUtils::MakeMaker::VERSION = ', $ExtUtils::MakeMaker::VERSION, "\n"; warn "#\n"; } my @hfiles; # Look for uuid/uuid.h first. uuid.h is known to contain the slower OSSP # interface on CentOS7. for my $try (qw{ uuid/uuid.h uuid.h rpc.h }) { warn "# ===> Checking for #include <${try}>\n" if DEBUG; eval { assert_lib( #lib => $link_lib, <-- dont link yet header => $try, debug => DEBUG, )}; unless ( $@ ) { push @hfiles, $try; warn "# ===> Found!\n" if DEBUG; } warn "#\n" if DEBUG; } bail('No headers found.') unless @hfiles; my $header; my $defs = []; my $libs = []; HEADER: while ( $header = shift @hfiles ) { # Look for uuid interface before ossp-uuid. # Our implementation with ossp is slower. for my $try_lib (qw{ rpcrt4 uuid ossp-uuid c }) { try_rpc( $header, $try_lib ) and last HEADER; try_e2fs( $header, $try_lib ) and last HEADER; try_ossp( $header, $try_lib ) and last HEADER; try_win( $header, $try_lib ) and last HEADER; } } bail('No interface found.') unless $header; sub try_rpc { my ( $hdr, $tlib ) = @_; warn "# ===> Checking for RPC interface in $hdr with -l$tlib\n" if DEBUG; eval { assert_lib( lib => $tlib, header => $hdr, debug => DEBUG, libpath => '/lib64 /usr/lib64', not_execute => 1, function => join("\n", map { s/^\s+//; $_ } split("\n", q{ char *str,buff[37]; uuid_t u1,u2; int32_t r,s; str=buff; 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 $@; warn "# ===> Err($L): \"$@\"\n" if DEBUG; return 0 } push @$defs, '-DPERL__UUID__RPC_INT'; push @$libs, "-l$tlib"; warn "# ===> Found!\n" if DEBUG; warn "#\n" if DEBUG; return 1; } sub try_e2fs { my ( $hdr, $tlib ) = @_; warn "# ===> Checking for e2fs interface in $hdr with -l$tlib\n" if DEBUG; eval { assert_lib( lib => $tlib, header => $hdr, debug => DEBUG, libpath => '/lib64 /usr/lib64', not_execute => 1, function => join("\n", map { s/^\s+//; $_ } split("\n", q{ 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_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 $@; warn "# ===> Err($L): \"$@\"\n" if DEBUG; return 0 } push @$defs, '-DPERL__UUID__E2FS_INT'; push @$libs, "-l$tlib"; warn "# ===> Found!\n" if DEBUG; warn "#\n" if DEBUG; return 1; } sub try_ossp { my ( $hdr, $tlib ) = @_; warn "# ===> Checking for ossp interface in $hdr with -l$tlib\n" if DEBUG; eval { assert_lib( lib => $tlib, header => $hdr, debug => DEBUG, libpath => '/lib64 /usr/lib64', not_execute => 1, function => join("\n", map { s/^\s+//; $_ } split("\n", q{ int i; size_t len; uuid_rc_t rc; char s[37]; uuid_t *u,*uu; uuid_create(&u); uuid_create(&uu); rc = uuid_make(u,UUID_MAKE_V1|UUID_MAKE_MC); /* uuid_generate */ rc = uuid_make(u,UUID_MAKE_V1); /* uuid_generate_time */ rc = uuid_make(u,UUID_MAKE_V4); /* for uuid_generate_random */ len = 36; uuid_export(u,UUID_FMT_STR,s,&len); uuid_import(u,UUID_FMT_STR,s,36); rc = uuid_load(u,"nil"); rc = uuid_clone(uu,&u); rc = uuid_compare(u,uu,&i); rc = uuid_isnil(u,&i); uuid_destroy(u); uuid_destroy(uu); return 0; })), )}; if ($@) { my $L = length $@; warn "# ===> Err($L): \"$@\"\n" if DEBUG; return 0 } push @$defs, '-DPERL__UUID__OSSP_INT'; push @$libs, "-l$tlib"; warn "# ===> Found!\n" if DEBUG; warn "#\n" if DEBUG; return 1; } sub try_win { my ( $hdr, $tlib ) = @_; warn "# ===> Checking for Win interface in $hdr with -l$tlib\n" if DEBUG; eval { assert_lib( lib => $tlib, header => [ $hdr, 'rpcdce.h' ], debug => DEBUG, libpath => '/lib64 /usr/lib64', not_execute => 1, function => join("\n", map { s/^\s+//; $_ } split("\n", q{ #ifndef RPC_CSTR typedef unsigned char* RPC_CSTR; #define UuidCreateSequential(x) UuidCreate(x) #endif int i; UUID u,uu; RPC_CSTR cs; RPC_STATUS st; i = UuidCompare(&u,&uu,&st); st = UuidCreate(&u); st = UuidCreateNil(&uu); st = UuidCreateSequential(&uu); i = UuidEqual(&u,&uu,&st); st = UuidToString(&u,&cs); i = UuidIsNil(&u,&st); st = UuidFromString(cs,&u); return 0; })), )}; if ($@) { my $L = length $@; warn "# ===> Err($L): \"$@\"\n" if DEBUG; return 0 } push @$defs, '-DPERL__UUID__WIN_INT'; push @$libs, "-l$tlib"; warn "# ===> Found!\n" if DEBUG; warn "#\n" if DEBUG; return 1; } sub get_struct_size { my ( $hdrs, $libs ) = @_; my $rv; warn "# ===> Checking binary struct size\n" if DEBUG; ( my $lib = $libs->[0] ) =~ s/-l//; check_lib( lib => $lib, header => $hdrs, debug => DEBUG, libpath => '/lib64 /usr/lib64', function => ( $lib =~ /ossp/ ) ? qq{ return 16; } : qq{ return sizeof(uuid_t); }, ); $rv = $? >> 8; warn "# ===> $rv\n" if DEBUG; warn "#\n" if DEBUG; return $rv; } my $size = get_struct_size( $header, $libs ) || bail( "Impossible struct size." ); push @$defs, "-DPERL__UUID__STRUCT_SZ=$size"; ($header = '-DPERL__UUID__'. uc $header ) =~ y{/.}{__}; push @$defs, $header; warn "# ===> Writing Makefile\n" if DEBUG; my $EX_version = 0; # Exporter my $DL_version = 0; # DynaLoader my $EUMM_version = '6.64'; # ExtUtils::MakeMaker my $DCL_version = '1.14'; # Devel::CheckLib my $TM_version = 0; # Test::More my $UUID_version = get_uuidpm_version(); sub get_uuidpm_version { open my $fh, '<', 'UUID.pm' or die "open: UUID.pm: $!"; while (<$fh>) { # $VERSION = '0.30_02'; return $1 if /^\$VERSION = '([\d\.\_]+)';$/; } return undef; } 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' => '', 'NO_MYMETA' => 1, 'PREREQ_PM' => { 'DynaLoader' => $DL_version, 'Exporter' => $EX_version, }, 'CONFIGURE_REQUIRES' => { 'Devel::CheckLib' => $DCL_version, 'ExtUtils::MakeMaker' => $EUMM_version, }, 'BUILD_REQUIRES' => { 'ExtUtils::MakeMaker' => $EUMM_version, }, 'TEST_REQUIRES' => { 'DynaLoader' => $DL_version, 'Exporter' => $EX_version, 'Test::More' => $TM_version, 'warnings' => 0, 'strict' => 0, 'CPAN::Meta' => 0, 'ExtUtils::Manifest' => 0, 'lib' => 0, }, 'META_MERGE' => { 'dynamic_config' => 0, 'provides' => { 'UUID' => { 'file' => 'UUID.pm', 'version' => $UUID_version, }, }, }, ); 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{TEST_REQUIRES} if $eumm_version < 6.64; 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{NO_MYMETA} if $eumm_version < 6.58; delete $params{AUTHOR} if $] < 5.005; delete $params{ABSTRACT_FROM} if $] < 5.005; delete $params{BINARY_LOCATION} if $] < 5.005; WriteMakefile(%params); } sub bail { my $msg = shift; # need some explanatory text here for missing system libs warn join '', " ####################################################################### # # Bailing out. Can't continue. # # ** $msg ", ( DEBUG ? '' : "# # It's likely the UUID prerequisite library isn't installed. # # On some platforms you can use your package manager to install these. # In particular, the uuid-dev, libuuid-devel, or uuid-devel packages # on Linux. # # More information about this failure can be found with the UUID_DEBUG # flag. # # perl Makefile.PL UUID_DEBUG=1 " ), "# ####################################################################### "; exit 0; # used in Devel::CheckLib::check_lib_or_exit() exit 255; # same as die() which is suggested in CPAN::Authors FAQ } package MY; # add distlicense and distreadme prereqs. # silence manicopy step during config. sub distdir { my $t = shift->SUPER::distdir(@_); $t =~ s{^(distdir :.*?)\s*$}{$1 distlicense distreadme}m; $t =~ s{PERLRUN}{NOECHO) \$(PERLRUN}; $t; } # remove metafile comments in manifest. # make metafiles authoritative to cpan. sub distmeta { my $t = <<'EOS'; distmeta : create_distdir metafile $(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'exit unless -e q{META.yml};' \ -e 'eval { maniadd({ q{META.yml} => q{} }) }' \ -e ' or die "Could not add META.yml to MANIFEST: $${'\''@'\''}"' -- $(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'exit unless -f q{META.json};' \ -e 'eval { maniadd({ q{META.json} => q{} }) }' \ -e ' or die "Could not add META.json to MANIFEST: $${'\''@'\''}"' -- EOS $t; } # add UUID_DISTTEST flag to 'make disttest' sub dist_test { my $t = shift->SUPER::dist_test(@_); $t =~ s{ test }{ test UUID_DISTTEST=1 }; $t; } # add distlicense and distreadme targets sub postamble { return <<'EOP'; license: create_distdir $(NOECHO) $(ECHO) Generating LICENSE $(NOECHO) $(RM_F) LICENSE_new $(NOECHO) $(ABSPERLRUN) -MSoftware::License::Artistic_2_0 \ -e 'print Software::License::Artistic_2_0->new({holder => q{Rick Myers}, year => sprintf(qq{2014-%04d}, 1900+(localtime(time))[5])})->fulltext' \ > LICENSE_new $(NOECHO) $(MV) LICENSE_new $(DISTVNAME)/LICENSE distlicense: create_distdir license $(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'exit unless -e q{LICENSE};' \ -e 'eval { maniadd({ q{LICENSE} => q{} }) }' \ -e ' or die "Could not add LICENSE to MANIFEST: $${'\''@'\''}"' -- $(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -e 'print sort <>' MANIFEST > MANIFEST_new $(NOECHO) $(MV) $(DISTVNAME)/MANIFEST_new $(DISTVNAME)/MANIFEST readme: create_distdir $(NOECHO) $(ECHO) Generating README $(NOECHO) $(RM_F) README_new $(NOECHO) pod2text UUID.pm README_new $(NOECHO) $(ABSPERLRUN) -i -pe's{\*(\S+)\*}{\1}g' README_new $(NOECHO) $(MV) README_new $(DISTVNAME)/README distreadme: create_distdir readme $(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'exit unless -e q{README};' \ -e 'eval { maniadd({ q{README} => q{} }) }' \ -e ' or die "Could not add README to MANIFEST: $${'\''@'\''}"' -- $(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -e 'print sort <>' MANIFEST > MANIFEST_new $(NOECHO) $(MV) $(DISTVNAME)/MANIFEST_new $(DISTVNAME)/MANIFEST EOP } UUID-0.31/META.json0000644000175000017500000000270114522341001011750 0ustar rikrik{ "abstract" : "DCE compatible Universally Unique Identifier library for Perl", "author" : [ "Rick Myers " ], "dynamic_config" : 0, "generated_by" : "ExtUtils::MakeMaker version 7.70, CPAN::Meta::Converter version 2.150010", "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" : "6.64" } }, "configure" : { "requires" : { "Devel::CheckLib" : "1.14", "ExtUtils::MakeMaker" : "6.64" } }, "runtime" : { "requires" : { "DynaLoader" : "0", "Exporter" : "0", "perl" : "5.005" } }, "test" : { "requires" : { "CPAN::Meta" : "0", "DynaLoader" : "0", "Exporter" : "0", "ExtUtils::Manifest" : "0", "Test::More" : "0", "lib" : "0", "strict" : "0", "warnings" : "0" } } }, "provides" : { "UUID" : { "file" : "UUID.pm", "version" : "0.31" } }, "release_status" : "stable", "version" : "0.31", "x_serialization_backend" : "JSON::PP version 4.16" } UUID-0.31/Changes0000644000175000017500000001760314522340443011642 0ustar rikrikRevision history for Perl extension UUID. ToDo: - Bump dev version. - Bump release version and fixup Changes. 0.31 Mon Nov 6 23:43:58 EST 2023 - Strip leading whitespace from assertlib files. - Use not_execute during configure. - Remove double quote area in Makefile.PL. - Remove placeholder files in repo. - Manifest tidy. - Add tests for generated files. - Remove old README_new file first. Make generation required. - Generate license file and test. - Skip 0gen test except in disttest. (UUID_DISTTEST=1) - Make 0gen tests fail for empty files. - OCD manifest tweak. - Add comments to Makefile modifications. - Silence manicopy call in configure. - Make generated metafiles authoritative. - Thanks to twata. [rt.cpan.org #150311] - Test metafiles for authority. - Bump dev version. - Add DynaLoader and Exporter to PREREQ_PM. - Add comments for other prereqs. - Move VERSION closer to top. - Remove NO_MYMETA if EUMM < 6.58. - Re-enable warnings. - Remove forced debug. - Bump dev version. - Rename License to LICENSE, per Kwalitee. - Add check for copyright year in disttest. - Add 'provides' info to metafiles, per Kwalitee. - Move dynamic_config to WriteMakefile(). - Tweak copyright test. - Bump dev version. - Make sure generated files are in manifest. - Fix wayward LICENSE. - Add test deps, per Kwalitee. - Bump dev version. - Check copyright date in LICENSE. - Bump release version. 0.30 Tue Oct 31 17:16:50 EDT 2023 - Make all devel version use UUID_DEBUG=1. - Bump ExtUtils::MakeMaker prereq to 6.64 (first version supporting TEST_REQUIRES). - Add debug message to show current Devel::CheckLib::VERSION. - Add debug message to show current ExtUtils::MakeMaker::VERSION. - Reorder configure tests for win32. - Add RPC_CSTR typedef for older Win32. - Define UuidCreateSequential() for older Win32. - Make META.json and META.yml placeholders. Generate during distdir. - Make README a placeholder. Generate during distdir. - Fix trivial build warning. 0.29 Wed Oct 25 01:15:57 EDT 2023 - Bump prereq version for Devel::CheckLib to 1.14 to fix problems with Strawberry versions 5.18 to 5.28. Earlier Strawberry did not ship Devel::CheckLib. Newer versions shipped 1.14 or later. - Thanks to twata. [rt.cpan.org #143841] 0.28 Sat Dec 29 00:59:25 EST 2018 - Add OSSP variant of libuuid. CentOS7 (and presumably other RedHat derivatives) have packages for both OSSP and e2fs. Favor e2fs, if found, since our implementation of OSSP is probably slower. - Thanks to Greg Cox. [rt.cpan.org #128122] 0.27 Fri Sep 23 01:52:00 EDT 2016 - Update SYNOPSIS to remove ":all". Indiscriminate exports could cause problems with other modules, such as File::Copy::copy(). - Thanks to Slaven Rezic. [rt.cpan.org #118033] 0.26 Sat May 7 02:32:52 EDT 2016 - Fix broken @ARGV handling in Makefile.PL regarding debug flag. - Also changed DEBUG flag to UUID_DEBUG - Thanks to gregor herrmann. [rt.cpan.org #114213] 0.25 Mon Mar 14 10:15:55 EDT 2016 - Changed all prints in Makefile.PL to warns and made both unbuffered to match Devel::CheckLib - Remove uuid_unparse_lower/upper() calls which don't exist on SunOS - Ignore TEST_REQUIRES on EUMM < 6.64 - Try to find correct link lib (-lrpcrt4, -luuid, -lc, in order) - Make string argument a char** for uuid_to_string() - Add note on Linux UUID packages - Moved test.pl to t/test.t and updated to Test::More - Changed debug() to emit to stderr to match Devel::CheckLib - Removed Makefile.PL verbosity - Added switch to Makefile.PL to incite verbosity - Become verbose for smokers only on dev releases - Added build notice for missing header/libraries - Bail out of build if uuid_t size == 0 - Reorganized header/library search to find wayward OSX - Thanks to David Wheeler and William Faulk for pointers and lots of patience in testing. [rt.cpan.org #104394] 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.31/UUID.pm0000644000175000017500000001555314522340321011450 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); $VERSION = '0.31'; # 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'}} ); bootstrap UUID $VERSION; # Preloaded methods go here. 1; __END__ =head1 NAME UUID - DCE compatible Universally Unique Identifier library for Perl =head1 SYNOPSIS use UUID 'uuid'; $string = uuid(); # generate stringified UUID UUID::generate($uuid); # new binary UUID; prefer random UUID::generate_random($uuid); # new binary UUID; use random UUID::generate_time($uuid); # new binary UUID; use time UUID::unparse($uuid, $string); # stringify $uuid; system casing UUID::unparse_lower($uuid, $string); # force lowercase stringify UUID::unparse_upper($uuid, $string); # force uppercase stringify $rc = UUID::parse($string, $uuid); # map string to UUID; -1 on error UUID::copy($dst, $src); # copy binary UUID from $src to $dst UUID::compare($uuid1, $uuid2); # compare binary UUIDs UUID::clear( $uuid ); # set binary UUID to NULL UUID::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 UUID LIBRARY On some systems external packages will need to be installed first. Notably, uuid-dev, libuuid-devel, or uuid-devel, depending on your platform. Some may also have more than one package available. It should be safe to install all variations. The UUID installer will then opt towards the older, faster library. =head1 EXPORTS None by default. 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-2023 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 CONTRIBUTORS David E. Wheeler William Faulk gregor herrmann Slaven Rezic twata =head1 SEE ALSO B, B, B, B, B, B, B, B, B. =cut UUID-0.31/README0000644000175000017500000001433714522341002011220 0ustar rikrikNAME UUID - DCE compatible Universally Unique Identifier library for Perl SYNOPSIS use UUID 'uuid'; $string = uuid(); # generate stringified UUID UUID::generate($uuid); # new binary UUID; prefer random UUID::generate_random($uuid); # new binary UUID; use random UUID::generate_time($uuid); # new binary UUID; use time UUID::unparse($uuid, $string); # stringify $uuid; system casing UUID::unparse_lower($uuid, $string); # force lowercase stringify UUID::unparse_upper($uuid, $string); # force uppercase stringify $rc = UUID::parse($string, $uuid); # map string to UUID; -1 on error UUID::copy($dst, $src); # copy binary UUID from $src to $dst UUID::compare($uuid1, $uuid2); # compare binary UUIDs UUID::clear( $uuid ); # set binary UUID to NULL UUID::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. UUID LIBRARY On some systems external packages will need to be installed first. Notably, uuid-dev, libuuid-devel, or uuid-devel, depending on your platform. Some may also have more than one package available. It should be safe to install all variations. The UUID installer will then opt towards the older, faster library. EXPORTS None by default. 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-2023 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 CONTRIBUTORS David E. Wheeler William Faulk gregor herrmann Slaven Rezic twata 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.31/MANIFEST0000644000175000017500000000034714522341002011465 0ustar rikrikChanges LICENSE MANIFEST META.json META.yml Makefile.PL README UUID.pm UUID.xs t/0gen.t t/test.t UUID-0.31/t/0000755000175000017500000000000014522341000010571 5ustar rikrikUUID-0.31/t/0gen.t0000644000175000017500000000356214522340036011625 0ustar rikrikuse strict; use warnings; use Test::More; use CPAN::Meta (); use ExtUtils::Manifest 'maniread'; use lib 'blib/lib'; require 'UUID.pm'; if ( -e '.git' ) { plan skip_all => 'in repo'; } elsif ( $ENV{UUID_DISTTEST} ) { plan tests => 19; } else { plan skip_all => 'in release'; } ok -e 'LICENSE', 'LICENSE exists'; ok -e 'META.json', 'META.json exists'; ok -e 'META.yml', 'META.yml exists'; ok -e 'README', 'README exists'; ok -s 'LICENSE', 'LICENSE not empty'; ok -s 'META.json', 'META.json not empty'; ok -s 'META.yml', 'META.yml not empty'; ok -s 'README', 'README not empty'; my $manifest = maniread; ok exists($manifest->{'LICENSE'}), 'LICENSE in manifest'; ok exists($manifest->{'META.json'}), 'META.json in manifest'; ok exists($manifest->{'META.yml'}), 'META.yml in manifest'; ok exists($manifest->{'README'}), 'README in manifest'; ok test_dynamic('META.json'), 'META.json authoritative'; ok test_dynamic('META.yml'), 'META.yml authoritative'; sub test_dynamic { my $f = shift; open my $fh, '<', $f or die "open: $!"; while (<$fh>) { return 1 if m/dynamic_config.*?0/; } return 0; } ok test_copyright('LICENSE'), 'LICENSE copyright date valid'; ok test_copyright('README'), 'README copyright date valid'; ok test_copyright('UUID.pm'), 'UUID.pm copyright date valid'; sub test_copyright { my $f = shift; my $n = 1900 + (localtime(time))[5]; open my $fh, '<', $f or die 'open: ', $f, ': ', $!; while (<$fh>) { if (/2014-(\d+)/) { my $end = $1; return 1 if $end == $n; } } return 0; } is provided_version('META.json'), $UUID::VERSION, 'META.json version'; is provided_version('META.yml'), $UUID::VERSION, 'META.yml version'; sub provided_version { my $f = shift; my $m = CPAN::Meta->load_file($f); return $m->{'provides'}{'UUID'}{'version'}; } exit 0; UUID-0.31/t/test.t0000644000175000017500000000476314522340036011757 0ustar rikrikuse warnings; use Test::More tests => 38; use UUID 'uuid'; UUID::debug() if $ENV{TEST_VERBOSE}; UUID::generate( $bin ); is length $bin, 16; UUID::generate_random( $bin ); is length $bin, 16; UUID::generate_time( $bin ); is length $bin, 16; UUID::unparse( $bin, $str ); is length $str, 36; like $str, qr{^[-0-9a-f]+$}i; $rc = UUID::parse( $str, $bin2 ); is $rc, 0; is $bin, $bin2; UUID::unparse_lower( $bin, $str ); UUID::unparse_upper( $bin, $str2 ); is length( $str ), 36; like $str, qr/^[-a-f0-9]+$/; is 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 ); is $rc, -1; is $bin, $bin2; UUID::generate( $bin ); $rc = UUID::is_null( $bin ); is $rc, 0; UUID::clear( $bin ); is length( $bin ), 16; is UUID::is_null( $bin ), 1; # does copy work? UUID::clear( $bin1 ); is UUID::is_null( $bin1 ), 1; UUID::copy( $bin2, $bin1 ); is UUID::is_null( $bin2 ), 1; $bin = 'bogus value'; is UUID::is_null( $bin ), 0; # != the null uuid, right? $bin = '1234567890123456'; is UUID::is_null( $bin ), 0; # still not null # make sure compare operands sane UUID::generate( $bin1 ); $bin2 = 'x'; is abs(UUID::compare( $bin1, $bin2 )), 1; is abs(UUID::compare( $bin2, $bin1 )), 1; $bin2 = 'some silly ridulously long string that couldnt possibly be a uuid'; is abs(UUID::compare( $bin1, $bin2 )), 1; is 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 ); is $tmp1, $tmp2; is UUID::compare( $bin1, $bin2 ), -UUID::compare( $bin2, $bin1 ); $bin2 = $bin1; is 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 ); $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 ); is 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; is $save1, $save2; is $$save1, $$save2; $rc = uuid(); # make sure export works is length($rc), 36; $rc = UUID::uuid(); is length($rc), 36; exit 0; UUID-0.31/META.yml0000644000175000017500000000150514522341001011601 0ustar rikrik--- abstract: 'DCE compatible Universally Unique Identifier library for Perl' author: - 'Rick Myers ' build_requires: CPAN::Meta: '0' DynaLoader: '0' Exporter: '0' ExtUtils::MakeMaker: '6.64' ExtUtils::Manifest: '0' Test::More: '0' lib: '0' strict: '0' warnings: '0' configure_requires: Devel::CheckLib: '1.14' ExtUtils::MakeMaker: '6.64' dynamic_config: 0 generated_by: 'ExtUtils::MakeMaker version 7.70, CPAN::Meta::Converter version 2.150010' 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 provides: UUID: file: UUID.pm version: '0.31' requires: DynaLoader: '0' Exporter: '0' perl: '5.005' version: '0.31' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' UUID-0.31/UUID.xs0000644000175000017500000003504514522340036011467 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 PERL__UUID__WIN_INT #ifndef RPC_CSTR typedef unsigned char* RPC_CSTR; #define UuidCreateSequential(x) UuidCreate(x) #endif #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)) #elif PERL__UUID__OSSP_INT #define UUID_T uuid_t* #define UUID2SV(u) ((char*)&u) #define SV2UUID(s) ((uuid_t*)SvGROW(s, UUID_LEN_STR+1)) #endif #define SV2STR(s) (SvGROW(s, UUID_BUF_SZ()+1)) #ifdef PERL__UUID__OSSP_INT void croak_ossp(uuid_rc_t st) { croak("%s", uuid_error(st)); } #endif 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); #elif PERL__UUID__OSSP_INT char *s = NULL; size_t len = 0; uuid_rc_t st; if ((st = uuid_create(&uuid)) != UUID_RC_OK) croak_ossp(st); if ((st = uuid_make(uuid,UUID_MAKE_V1|UUID_MAKE_MC)) != UUID_RC_OK) croak_ossp(st); if ((st = uuid_export(uuid, UUID_FMT_BIN, &s, &len)) != UUID_RC_OK) croak_ossp(st); if ((st = uuid_destroy(uuid)) != UUID_RC_OK) croak_ossp(st); sv_setpvn(str, s, len); return; #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); #elif PERL__UUID__OSSP_INT char *s = NULL; size_t len = 0; uuid_rc_t st; if ((st = uuid_create(&uuid)) != UUID_RC_OK) croak_ossp(st); if ((st = uuid_make(uuid,UUID_MAKE_V4)) != UUID_RC_OK) croak_ossp(st); if ((st = uuid_export(uuid, UUID_FMT_BIN, &s, &len)) != UUID_RC_OK) croak_ossp(st); if ((st = uuid_destroy(uuid)) != UUID_RC_OK) croak_ossp(st); sv_setpvn(str, s, len); return; #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); #elif PERL__UUID__OSSP_INT char *s = NULL; size_t len = 0; uuid_rc_t st; if ((st = uuid_create(&uuid)) != UUID_RC_OK) croak_ossp(st); if ((st = uuid_make(uuid,UUID_MAKE_V1)) != UUID_RC_OK) croak_ossp(st); if ((st = uuid_export(uuid, UUID_FMT_BIN, &s, &len)) != UUID_RC_OK) croak_ossp(st); if ((st = uuid_destroy(uuid)) != UUID_RC_OK) croak_ossp(st); sv_setpvn(str, s, len); return; (void)st; #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); #elif PERL__UUID__OSSP_INT UUID_T uuid; char *str = NULL; size_t len = UUID_LEN_STR; uuid_rc_t st; if ((st = uuid_create(&uuid)) != UUID_RC_OK) croak_ossp(st); if ((st = uuid_import(uuid, UUID_FMT_BIN, SV2UUID(in), UUID_LEN_BIN)) != UUID_RC_OK) croak_ossp(st); if ((st = uuid_export(uuid, UUID_FMT_STR, &str, &len)) != UUID_RC_OK) croak_ossp(st); if ((st = uuid_destroy(uuid)) != UUID_RC_OK) croak_ossp(st); sv_setpvn(out, str, len-1); free(str); (void)st; #endif } void do_unparse_lower(SV *in, SV * out) { #ifdef PERL__UUID__E2FS_INT char *p, str[UUID_BUF_SZ()]; /* uuid_unparse_lower(SV2UUID(in), str); */ /* not on SunOS */ uuid_unparse(SV2UUID(in), str); for(p=str; *p; ++p) *p = tolower(*p); 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); #elif PERL__UUID__OSSP_INT UUID_T uuid; char *p; char *str = NULL; uuid_rc_t st; if ((st = uuid_create(&uuid)) != UUID_RC_OK) croak_ossp(st); if ((st = uuid_import(uuid, UUID_FMT_BIN, SV2UUID(in), UUID_BUF_SZ()-1)) != UUID_RC_OK) croak_ossp(st); if ((st = uuid_export(SV2UUID(in), UUID_FMT_STR, &str, NULL)) != UUID_RC_OK) croak_ossp(st); if ((st = uuid_destroy(uuid)) != UUID_RC_OK) croak_ossp(st); for(p=str; *p; ++p) *p = tolower(*p); sv_setpv(out, str); free(str); (void)st; #endif } void do_unparse_upper(SV *in, SV * out) { #ifdef PERL__UUID__E2FS_INT char *p, str[UUID_BUF_SZ()]; /* uuid_unparse_upper(SV2UUID(in), str); */ /* not on SunOS */ uuid_unparse(SV2UUID(in), str); for(p=str; *p; ++p) *p = toupper(*p); 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); #elif PERL__UUID__OSSP_INT UUID_T uuid; char *p; char *str = NULL; uuid_rc_t st; if ((st = uuid_create(&uuid)) != UUID_RC_OK) croak_ossp(st); if ((st = uuid_import(uuid, UUID_FMT_BIN, SV2UUID(in), UUID_BUF_SZ()-1)) != UUID_RC_OK) croak_ossp(st); if ((st = uuid_export(SV2UUID(in), UUID_FMT_STR, &str, NULL)) != UUID_RC_OK) croak_ossp(st); if ((st = uuid_destroy(uuid)) != UUID_RC_OK) croak_ossp(st); for(p=str; *p; ++p) *p = toupper(*p); sv_setpv(out, str); free(str); (void)st; #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; #elif PERL__UUID__OSSP_INT char *str = NULL; if (uuid_create(&uuid) != UUID_RC_OK) return -1; if (uuid_import(uuid, UUID_FMT_STR, SV2STR(in), UUID_LEN_STR) != UUID_RC_OK) { uuid_destroy(uuid); return -1; } if (uuid_export(uuid, UUID_FMT_BIN, &str, NULL) != UUID_RC_OK) { uuid_destroy(uuid); return -1; } uuid_destroy(uuid); sv_setpvn(out, str, UUID_LEN_BIN); free(str); return 0; #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); #elif PERL__UUID__OSSP_INT char *str = NULL; size_t len = UUID_LEN_BIN; uuid_rc_t st; if ((st = uuid_create(&uuid)) != UUID_RC_OK) croak_ossp(st); if ((st = uuid_load(uuid, "nil")) != UUID_RC_OK) croak_ossp(st); if ((st = uuid_export(uuid, UUID_FMT_BIN, &str, &len)) != UUID_RC_OK) croak_ossp(st); if ((st = uuid_destroy(uuid)) != UUID_RC_OK) croak_ossp(st); sv_setpvn(in, str, len); return; #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; #elif PERL__UUID__OSSP_INT UUID_T uuid; int i; uuid_rc_t st; if ((st = uuid_create(&uuid)) != UUID_RC_OK) croak_ossp(st); if ((st = uuid_import(uuid, UUID_FMT_BIN, SV2STR(in), UUID_BUF_SZ()-1)) != UUID_RC_OK) croak_ossp(st); if ((st = uuid_isnil(uuid, &i)) != UUID_RC_OK) croak_ossp(st); if ((st = uuid_destroy(uuid)) != UUID_RC_OK) croak_ossp(st); return i ? 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 #elif PERL__UUID__OSSP_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)); #elif PERL__UUID__OSSP_INT size_t len = SvCUR(src); if ( len != UUID_LEN_BIN ) { char *str = NULL; len = 0; uuid_rc_t st; if ((st = uuid_create(&uuid)) != UUID_RC_OK) croak_ossp(st); if ((st = uuid_export(uuid, UUID_FMT_BIN, &str, &len)) != UUID_RC_OK) croak_ossp(st); if ((st = uuid_destroy(uuid)) != UUID_RC_OK) croak_ossp(st); sv_setpvn(dst, str, len); free(str); return; } sv_copypv(dst, src); return; #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; #elif PERL__UUID__OSSP_INT SV *rv; char *str = NULL; size_t len = UUID_LEN_STR; uuid_rc_t st; if ((st = uuid_create(&uuid)) != UUID_RC_OK) croak_ossp(st); if ((st = uuid_make(uuid, UUID_MAKE_V1|UUID_MAKE_MC)) != UUID_RC_OK) croak_ossp(st); if ((st = uuid_export(uuid, UUID_FMT_STR, &str, &len)) != UUID_RC_OK) croak_ossp(st); if ((st = uuid_destroy(uuid)) != UUID_RC_OK) croak_ossp(st); rv = newSVpvn(str, len-1); free(str); return rv; #endif } void do_debug() { SV *bmsg, *smsg; #ifdef PERL__UUID__UUID_UUID_H PerlIO_puts(PerlIO_stderr(), "# Header: uuid/uuid.h\n"); #elif PERL__UUID__UUID_H PerlIO_puts(PerlIO_stderr(), "# Header: uuid.h\n"); #elif PERL__UUID__RPC_H PerlIO_puts(PerlIO_stderr(), "# Header: rpc.h\n"); #endif #ifdef PERL__UUID__E2FS_INT PerlIO_puts(PerlIO_stderr(), "# Interface: e2fs\n"); #elif PERL__UUID__RPC_INT PerlIO_puts(PerlIO_stderr(), "# Interface: rpc\n"); #elif PERL__UUID__WIN_INT PerlIO_puts(PerlIO_stderr(), "# Interface: win\n"); #elif PERL__UUID__OSSP_INT PerlIO_puts(PerlIO_stderr(), "# Interface: ossp\n"); #endif bmsg = mess("# Buffer size: %i\n", UUID_BUF_SZ()); PerlIO_puts(PerlIO_stderr(), SvPVX(bmsg)); smsg = mess("# Struct size: %i\n", PERL__UUID__STRUCT_SZ); PerlIO_puts(PerlIO_stderr(), 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();