Re: [Perldl] A suggestion on an old required module? Update 2

[Sisyphus]

----- Original Message ----- 
From: "Fabio D'Alfonso" <fabio.dalfo...@fabiodalfonso.com>
To: "David Mertens" <dcmertens.p...@gmail.com>
Cc: <perldl@jach.hawaii.edu>
Sent: Wednesday, April 18, 2012 7:21 PM
Subject: Re: [Perldl] A suggestion on an old required module? Update 2

Hi,
I did not get an answer from the maintainers, yet.
Meanwhile I made some more step:

 1.. I contacted David Golden, to ask on some suggestion, and realized why

 2.. Made a deeper look at the stuff and found that, although the tree is 
that  ~800 objects, the module is use only in the main one, to implement 
this:
 #Method to generate UUIDs.
 sub _get_uuid{
     my ($uuid, $string);
     UUID::generate($uuid);
     UUID::unparse($uuid, $string);
     return $string;
 }

Can you use the following (plagiarised from Win32::Guidgen) instead of 
David's implementation:

###############################
use warnings;
use Win32::API;

$uuid= _get_uuid();
print $uuid;

sub _get_uuid {
   my $UuidCreate = new Win32::API('rpcrt4', 'UuidCreate', 'P', 'N');
   die 'Could not load UuidCreate from rpcrt4.dll' unless $UuidCreate;

   my $UuidToString = new Win32::API('rpcrt4', 'UuidToString', 'PP', 'N');
   die 'Could not load UuidToString from rpcrt4.dll' unless $UuidToString;

   my $RpcStringFree = new Win32::API('rpcrt4', 'RpcStringFree', 'P', 'N');
   die 'Could not load RpcStringFree from rpcrt4.dll' unless 
$RpcStringFree;

   my $uuid = "*" x 16; # Allocate enough space to store the uuid structure

   my $ret = $UuidCreate->Call( $uuid );
   die "UuidCreate failed with error: $ret" unless $ret == 0;

   my $ptr_str = pack("P",0);
   $ret = $UuidToString->Call( $uuid, $ptr_str );
   die "UuidToString failed with error: $ret" unless $ret == 0;

   my $guid_str = unpack( "p", $ptr_str );

   $ret = $RpcStringFree->Call( $ptr_str );
   die "RpcStringFree failed with error: $ret" unless $ret == 0;

   return '{' . uc($guid_str) . '}';
}
###############################

For me, that outputs strings like:
{AB73026A-1A00-4A0D-9734-67741D7539C1}

Is that  right ? Or does it need some adjustment ?

I could probably rewrite it as an XSub and stick it in a separate module 
(without too much trouble), if necessary.

Cheers,
Rob 


_______________________________________________
Perldl mailing list
Perldl@jach.hawaii.edu
http://mailman.jach.hawaii.edu/mailman/listinfo/perldl