File Coverage

blib/lib/FFI/C/Util.pm

Criterion	Covered	Total	%
statement	75	78	96.1
branch	31	42	73.8
condition	5	9	55.5
subroutine	14	14	100.0
pod	6	6	100.0
total	131	149	87.9

package FFI::C::Util;

use strict;
use warnings;
use 5.008001;
use Ref::Util qw( is_blessed_ref is_plain_arrayref is_plain_hashref is_ref is_blessed_hashref );
use Sub::Identify 0.05 ();
use Carp ();
use Class::Inspector;
use base qw( Exporter );

our @EXPORT_OK = qw( perl_to_c c_to_perl take owned set_array_count addressof );

# ABSTRACT: Utility functions for dealing with structured C data
our $VERSION = '0.15'; # VERSION


sub perl_to_c ($$)
{
  my($inst, $values) = @_;
  if(is_blessed_ref $inst && $inst->isa('FFI::C::Array'))
  {
    Carp::croak("Tried to initalize a @{[ ref $inst ]} with something other than an array reference")
      unless is_plain_arrayref $values;
    &perl_to_c($inst->get($_), $values->[$_]) for 0..$#$values;
  }
  elsif(is_blessed_ref $inst)
  {
    Carp::croak("Tried to initalize a @{[ ref $inst ]} with something other than an hash reference")
      unless is_plain_hashref $values;
    foreach my $name (keys %$values)
    {
      my $value = $values->{$name};
      $inst->$name($value);
    }
  }
  else
  {
    Carp::croak("Not an object");
  }
}


sub c_to_perl ($)
{
  my $inst = shift;
  Carp::croak("Not an object") unless is_blessed_ref($inst);
  if($inst->isa("FFI::C::Array"))
  {
    return [map { &c_to_perl($_) } @$inst]
  }
  elsif($inst->isa("FFI::C::Struct"))
  {
    my $def = $inst->{def};

    my %h;
    foreach my $key (keys %{ $def->{members} })
    {
      next if $key =~ /^:/;
      my $value = $inst->$key;
      $value = &c_to_perl($value) if is_blessed_ref $value;
      $value = [@$value] if is_plain_arrayref $value;
      $h{$key} = $value;
    }

    return \%h;
  }
  else
  {
    my %h;
    my $df = $INC{'FFI/C/StructDef.pm'};
    foreach my $key (@{ Class::Inspector->methods(ref $inst) })
    {
      next if $key =~ /^(new|DESTROY)$/;

      # we only want to recurse on generated methods.
      my ($file) = Sub::Identify::get_code_location( $inst->can($key) );
      next unless $file eq $df;

      # get the value;
      my $value = $inst->$key;
      $value = &c_to_perl($value) if is_blessed_hashref $value;
      $value = [@$value] if is_plain_arrayref $value;
      $h{$key} = $value;
    }

    return \%h;
  }
}


sub owned ($)
{
  my $inst = shift;
  !!($inst->{ptr} && !$inst->{owner});
}


sub take ($)
{
  my $inst = shift;
  Carp::croak("Not an object") unless is_blessed_ref $inst;
  Carp::croak("Object is owned by someone else") if $inst->{owner};
  my $ptr = delete $inst->{ptr};
  Carp::croak("Object pointer went away") unless $ptr;
  $ptr;
}


sub addressof ($)
{
  my $inst = shift;
  Carp::croak("Not an object") unless is_blessed_ref $inst;
  my $ptr = $inst->{ptr};
  Carp::croak("Object pointer went away") unless $ptr;
  $ptr;
}


sub set_array_count ($$)
{
  my($inst, $count) = @_;
  Carp::croak("Not a FFI::C::Array")
    unless is_blessed_ref $inst && $inst->isa('FFI::C::Array');
  Carp::croak("This array already has a size")
    if $inst->{count};
  $inst->{count} = $count;
}

1;

__END__