Perl Name-based UUID Generator

uuid-v3.pl

#!/usr/bin/env perl

use strict;
use warnings;

use Digest::MD5 qw( md5 );

# based on UUID::Tiny
sub uuid_v3 {
        my ( $namespace, $name ) = @_;

        $namespace =~ tr/\-//d;
        $namespace = pack 'H*', $namespace;

        my $uuid = md5( $namespace . $name );
        # set version 3 (MD5 name-based) UUID
        substr $uuid, 6, 1, chr( ord( substr $uuid, 6, 1 ) & 0x0f | 0x30 );
        # set RFC 4122 variant
        substr $uuid, 8, 1, chr( ord( substr $uuid, 8, 1 ) & 0x3f | 0x80 );

        return  join '-',
                map { unpack 'H*', $_ }
                map { substr $uuid, 0, $_, '' }
                ( 4, 2, 2, 2, 6 );
}

print uuid_v3( $ARGV[0], $ARGV[1] ), "\n";