wide-string-out.pl

package FFI::Platypus::Type::WideStringOut;

use strict;
use warnings;
use 5.008004;
use FFI::Platypus;
use Encode qw( decode );

use constant _incantation =>
  $^O eq 'MSWin32' && do { require Config; $Config::Config{archname} =~ /MSWin32-x64/ }
  ? 'Q'
  : 'L!';

my @stack;  # To keep buffer alive.

sub perl_to_native
{
  my($size, $ref) = @_;

  if(ref($ref) eq 'SCALAR')
  {
    $$ref = "\0" x $size unless defined $$ref;
    push @stack, $ref;
    return unpack(_incantation, pack 'P', $$ref);
  }
  else
  {
    push @stack, undef;
    return undef;
  }
}

FFI::Platypus
  ->new( api => 1, lib => [undef] )
  ->attach( wcsnlen => ['string','size_t'] => 'size_t' );

sub perl_to_native_post
{
  my $ref = pop @stack;
  return unless defined $ref;
  my $len = length $$ref;
  $len = wcsnlen($$ref, $len);
  $$ref = decode('UTF-16LE', substr($$ref, 0, $len*2));
}

sub ffi_custom_type_api_1
{
  my($class, $ffi, $size) = @_;
  $size = 1024 unless defined $size;  # default to some reasonable size.
  warn "size = $size";
  {
     native_type         => 'opaque',
     perl_to_native      => sub { perl_to_native($size, @_) },
     perl_to_native_post => \&perl_to_native_post,
  }
}

1;

package main;

{
  my $ffi = FFI::Platypus->new( api => 1, lang => 'Win32', lib => [undef] );

  # According to some random Google search max paths for Windows is 260.  Could be wrong.
  # and I _think_ that the max size of a character in UTF-16 is 4.
  $ffi->load_custom_type( '::WideStringOut', 'wide_string_out' => 260*4 );

  $ffi->attach( GetCurrentDirectoryW => ['DWORD','wide_string_out'] => 'DWORD' );
}

{
  my $dir;
  GetCurrentDirectoryW(260*4, \$dir);
  warn "dir = $dir";
}

{
  # to save memory we could also compute the exact number of bytes we need.
  my $size = GetCurrentDirectoryW(0, undef) * 2;
  my $dir = "\0" x $size;
  GetCurrentDirectoryW($size, \$dir);
  warn "dir = $dir";
}

widestring.pl

use strict;
use warnings;
use FFI::Platypus;

sub compute_wide_string_encoding
{

  my $ffi = FFI::Platypus->new( api => 1, lib => [undef] );

  my $size = eval { $ffi->sizeof('wchar_t') };
  die 'no wchar_t' if $@;

  my %orders = (
    join('', 1..$size)         => 'BE',
    join('', reverse 1..$size) => 'LE',
  );

  my $byteorder = join '', @{ $ffi->cast( "wchar_t*", "uint8[$size]", \hex(join '', map { "0$_" } 1..$size) ) };

  my $encoding;

  if($size == 2)
  {
    $encoding = 'UTF-16';
  }
  elsif($size == 4)
  {
    $encoding = 'UTF-32';
  }
  else
  {
    die "not sure what encoding to use for size $size";
  }

  if(defined $orders{$byteorder})
  {
    $encoding .= $orders{$byteorder};
  }
  else
  {
    die "odd byteorder $byteorder not (yet) supported";
  }

  return $encoding;
}

print compute_wide_string_encoding(), "\n";