view release on metacpan or  search on metacpan

lib/FFI/Platypus/Lang/Pascal.pm  view on Meta::CPAN

Types are in camel case.  For example use C<ShortInt>, not C<Shortint>
or C<SHORTINT>.

=cut

sub native_type_map
{
  {
    # Integer Types
    'Byte'     => 'uint8',
    'ShortInt' => 'sint8',
    'SmallInt' => 'sin16',
    'Word'     => 'uint16',
    'Integer'  => 'sint16',  # sint32 in Delphi or ObjFPC mode
    'Cardinal' => 'uint32',
    'LongInt'  => 'sint32',
    'LongWord' => 'uint32',
    'Int64'    => 'sint64',
    'QWord'    => 'uint64',

    # Boolean Types    
    'Boolean'  => 'sint8',
    'ByteBool' => 'sint8',
    'WordBool' => 'sint16',
    'LongBool' => 'sint32',
    
    # Floating Point Types
    # http://www.freepascal.org/docs-html/ref/refsu6.html#x28-310003.1.2
    # Real     => either 'float' or 'double'
    'Single'   => 'float',
    'Double'   => 'double',
    # Extended (size = 10
    # Comp
    # Currency
  },
}

=head2 mangler

 my $mangler = FFI::Platypus::Lang::Pascal->mangler($ffi->libs);
 # prints ADD_ADD$SMALLINT$SMALLINT$$SMALLINT
 print $mangler->("add(smallint,smallint):smallint");

Returns a subroutine reference that will "mangle" Pascal names.

=cut

sub mangler
{
  my($class, @libs) = @_;
  
  my %mangle;
  
  foreach my $libpath (@libs)
  {
    extract_symbols($libpath,
      export => sub {
        my($symbol1, $symbol2) = @_;
        return if $symbol1 =~ /^THREADVARLIST_/;
        return unless $symbol1 =~ /^[A-Z0-9_]+(\$[A-Z0-9_]+)*(\$\$[A-Z0-9_]+)?$/;
        my $symbol = $symbol1;
        my $ret = '';
        $ret = $1 if $symbol =~ s/\$\$([A-Z_]+)$//;
        my($name, @args) = split /\$/, $symbol;
        $symbol = "${name}(" . join(',', @args) . ')';
        $symbol .= ":$ret" if $ret;
        push @{ $mangle{$name} }, [ $symbol, $symbol1 ];
      },
    );
  }

  sub {
    my $symbol = $_[0];

    if($symbol =~ /^(.+)\((.*)\)$/)
    {
      my $name = uc $1;
      my @args = map { uc $_ } split /;|,/, $2;
      $name =~ s{\.}{_};
      return join '$', $name, @args;
    }
    elsif($symbol =~ /^(.+)\((.*)\):(.*)$/)
    {
      my $name = uc $1;
      my @args = map { uc $_ } split /;|,/, $2;
      my $ret = uc $3;
      $name =~ s{\.}{_};
      return join '$', $name, @args, "\$$ret";
    }
    
    my $name = uc $symbol;
    $name =~ s/\./_/;

    if($mangle{$name})
    {
      if(@{ $mangle{$name} } == 1)
      {
        return $mangle{$name}->[0]->[1];
      }
      else
      {
        croak(
          "$symbol is ambiguous.  Please specify one of: " .
          join(', ', map { $_->[0] } @{ $mangle{$name} })
        );
      }
    }
    $symbol;
  };
}

1;

=head1 EXAMPLES

See the above L</SYNOPSIS> or the C<examples> directory that came with 
this distribution.

=head1 SUPPORT