File Coverage

blib/lib/FFI/Platypus/Type/Enum.pm

Criterion	Covered	Total	%
statement	67	68	98.5
branch	44	46	95.6
condition	9	11	81.8
subroutine	11	11	100.0
pod	0	1	0.0
total	131	137	95.6

package FFI::Platypus::Type::Enum;

use strict;
use warnings;
use constant 1.32 ();
use 5.008001;
use Ref::Util qw( is_plain_arrayref is_plain_hashref is_ref );
use Scalar::Util qw( dualvar );
use Carp qw( croak );

# ABSTRACT: Custom platypus type for dealing with C enumerated types
our $VERSION = '0.06'; # VERSION


our @CARP_NOT = qw( FFI::Platypus );

sub ffi_custom_type_api_1
{
  my %config = defined $_[2] && is_plain_hashref $_[2]
    ? %{ splice(@_, 2, 1) }
    : ();
  my(undef, undef, @values) = @_;

  my $index = 0;
  my %str_lookup;
  my %int_lookup;
  my $prefix = defined $config{prefix} ? $config{prefix} : '';
  $config{rev} ||= 'str';
  ($config{rev} =~ /^(int|str|dualvar)$/) or croak("rev must be either 'int', 'str', or 'dualvar'");

  $config{casing} ||= 'upper';
  ($config{casing} =~ /^(upper|keep)$/) or croak("casing must be either 'upper' or 'keep'");

  foreach my $value (@values)
  {
    my $name;
    my @aliases;

    if(is_plain_arrayref $value)
    {
      my %opt;
      if(@$value % 2)
      {
        ($name,%opt) = @$value;
      }
      else
      {
        ($name,$index,%opt) = @$value;
      }
      @aliases = @{ delete $opt{alias} || [] };
      croak("unrecognized options: @{[ sort keys %opt ]}") if %opt;
    }
    elsif(!is_ref $value)
    {
      $name = $value;
    }
    else
    {
      croak("not a array ref or scalar: $value");
    }

    if($index < 0)
    {
      $config{type} ||= 'senum';
    }

    if(my $packages = $config{package})
    {
      foreach my $package (is_plain_arrayref $packages ? @$packages : $packages)
      {
        foreach my $name ($name,@aliases)
        {
          my $full = join '::', $package, $prefix . ( $config{casing} eq 'upper' ? uc($name) : $name );
          constant->import($full, $index);
        }
      }
    }

    croak("$name declared twice") if exists $str_lookup{$name};

    $int_lookup{$index} = $name unless exists $int_lookup{$index};
    $str_lookup{$_}     = $index for @aliases;
    $str_lookup{$name}  = $index++;
  }

  $config{type} ||= 'enum';

  if(defined $config{maps})
  {
    if(is_plain_arrayref $config{maps})
    {
      @{ $config{maps} } = (\%str_lookup, \%int_lookup, $config{type});
    }
    else
    {
      croak("maps is not an array reference");
    }
  }

  my %type = (
    native_type    => $config{type},
    perl_to_native => sub {
      exists $str_lookup{$_[0]}
        ? $str_lookup{$_[0]}
        : exists $int_lookup{$_[0]}
          ? $_[0]
          : croak("illegal enum value $_[0]");
    },
  );

  if($config{rev} eq 'str')
  {
    $type{native_to_perl} = sub {
      exists $int_lookup{$_[0]}
        ? $int_lookup{$_[0]}
        : $_[0];
    }
  }
  elsif($config{rev} eq 'dualvar')
  {
    $type{native_to_perl} = sub {
      exists $int_lookup{$_[0]}
        ? dualvar( $_[0], $int_lookup{$_[0]} )
        : $_[0];
    };
  }

  \%type;
}

1;

__END__