3.1

1 files changed, 176 insertions, 0 deletions

diff --git a/shared/ossp_uuid/perl/uuid_compat.pm b/shared/ossp_uuid/perl/uuid_compat.pm
new file mode 100644
index 00000000..fdc57125
--- /dev/null
+++ b/shared/ossp_uuid/perl/uuid_compat.pm
@@ -0,0 +1,176 @@
+##
+##  OSSP uuid - Universally Unique Identifier
+##  Copyright (c) 2004-2007 Ralf S. Engelschall <rse@engelschall.com>
+##  Copyright (c) 2004-2007 The OSSP Project <http://www.ossp.org/>
+##  Copyright (c) 2004 Piotr Roszatycki <dexter@debian.org>
+##
+##  This file is part of OSSP uuid, a library for the generation
+##  of UUIDs which can found at http://www.ossp.org/pkg/lib/uuid/
+##
+##  Permission to use, copy, modify, and distribute this software for
+##  any purpose with or without fee is hereby granted, provided that
+##  the above copyright notice and this permission notice appear in all
+##  copies.
+##
+##  THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESSED OR IMPLIED
+##  WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+##  MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+##  IN NO EVENT SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR
+##  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+##  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+##  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
+##  USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+##  ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+##  OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
+##  OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+##  SUCH DAMAGE.
+##
+##  uuid_compat.pm: Data::UUID Backward Compatibility Perl API
+##
+
+package Data::UUID;
+
+use 5.006;
+use warnings;
+use strict;
+
+use OSSP::uuid;
+use MIME::Base64 qw();
+
+require Exporter;
+
+our @ISA     = qw(Exporter);
+our @EXPORT  = qw(NameSpace_DNS NameSpace_OID NameSpace_URL NameSpace_X500);
+
+our $VERSION = do { my @v = ('1.6.2' =~ m/\d+/g); sprintf("%d.".("%02d"x$#v), @v); };
+
+sub new {
+    my $class = shift;
+    my $self = bless {}, $class;
+    return $self;
+}
+
+sub create {
+    my ($self) = @_;
+    my $uuid = OSSP::uuid->new;
+    $uuid->make('v4');
+    return $uuid->export('bin');
+}
+
+sub create_from_name {
+    my ($self, $nsid, $name) = @_;
+    my $uuid = OSSP::uuid->new;
+    my $nsiduuid = OSSP::uuid->new;
+    $nsiduuid->import('bin', $nsiduuid);
+    $uuid = OSSP::uuid->new;
+    $uuid->make('v3', $nsiduuid, $name);
+    return $uuid->export('bin');
+}
+
+sub to_string {
+    my ($self, $bin) = @_;
+    my $uuid = OSSP::uuid->new;
+    $uuid->import('bin', $bin);
+    return $uuid->export('str');
+}
+
+sub to_hexstring {
+    my ($self, $bin) = @_;
+    my $uuid = OSSP::uuid->new;
+    $uuid->import('bin', $bin);
+    (my $string = '0x' . $uuid->export('str')) =~ s/-//g;
+    return $string;
+}
+
+sub to_b64string {
+    my ($self, $bin) = @_;
+    return MIME::Base64::encode_base64($bin, '');
+}
+
+sub from_string {
+    my ($self, $str) = @_;
+    my $uuid = OSSP::uuid->new;
+    $uuid->import('str',
+          $str =~ /^0x/
+        ? join '-', unpack('x2 a8 a4 a4 a4 a12', $str)
+        : $str
+    );
+    return $uuid->export('bin');
+}
+
+sub from_hexstring {
+    my ($self, $str) = @_;
+    my $uuid = OSSP::uuid->new;
+    $uuid->import('str', join '-', unpack('x2 a8 a4 a4 a4 a12', $str));
+    return $uuid->export('bin');
+}
+
+sub from_b64string {
+    my ($self, $b64) = @_;
+    return MIME::Base64::decode_base64($b64);
+}
+
+sub compare {
+    my ($self, $bin1, $bin2) = @_;
+    my $uuid1 = OSSP::uuid->new;
+    my $uuid2 = OSSP::uuid->new;
+    $uuid1->import('bin', $bin1);
+    $uuid2->import('bin', $bin2);
+    return $uuid1->compare($uuid2);
+}
+
+my %NS = (
+    'NameSpace_DNS'  => 'ns:DNS',
+    'NameSpace_URL'  => 'ns:URL',
+    'NameSpace_OID'  => 'ns:OID',
+    'NameSpace_X500' => 'ns:X500',
+);
+
+while (my ($k, $v) = each %NS) {
+    no strict 'refs';
+    *{$k} = sub () {
+        my $uuid = OSSP::uuid->new;
+        $uuid->load($v);
+        return $uuid->export('bin');
+    };
+}
+
+sub constant {
+    my ($self, $arg) = @_;
+    my $uuid = OSSP::uuid->new;
+    $uuid->load($NS{$arg} || 'nil');
+    return $uuid->export('bin');
+}
+
+sub create_str {
+    my $self = shift;
+    return $self->to_string($self->create);
+}
+
+sub create_hex {
+    my $self = shift;
+    return $self->to_hexstring($self->create);
+}
+
+sub create_b64 {
+    my $self = shift;
+    return $self->to_b64string($self->create);
+}
+
+sub create_from_name_str {
+    my $self = shift;
+    return $self->to_string($self->create_from_name(@_));
+}
+
+sub create_from_name_hex {
+    my $self = shift;
+    return $self->to_hexstring($self->create_from_name(@_));
+}
+
+sub create_from_name_b64 {
+    my $self = shift;
+    return $self->to_b64string($self->create_from_name(@_));
+}
+
+1;
+