File Coverage

lib/ExtUtils/Typemaps/STL/List.pm

Criterion	Covered	Total	%
statement	35	35	100.0
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod	1	1	100.0
total	40	40	100.0

package ExtUtils::Typemaps::STL::List;

use strict;
use warnings;
use ExtUtils::Typemaps;

our $VERSION = '1.05';

our @ISA = qw(ExtUtils::Typemaps);

=head1 NAME

ExtUtils::Typemaps::STL::List - A set of typemaps for STL std::lists

=head1 SYNOPSIS

  use ExtUtils::Typemaps::STL::List;
  # First, read my own type maps:
  my $private_map = ExtUtils::Typemaps->new(file => 'my.map');

  # Then, get the object map set and merge it into my maps
  $private_map->merge(typemap => ExtUtils::Typemaps::STL::List->new);

  # Now, write the combined map to an output file
  $private_map->write(file => 'typemap');

=head1 DESCRIPTION

C is an C
subclass that provides a set of mappings for C++ STL lists.
These are:

  TYPEMAP
  std::list		T_STD_LIST_DOUBLE
  std::list*		T_STD_LIST_DOUBLE_PTR

  std::list		T_STD_LIST_INT
  std::list*		T_STD_LIST_INT_PTR

  std::list	T_STD_LIST_UINT
  std::list*	T_STD_LIST_UINT_PTR

  std::list	T_STD_LIST_STD_STRING
  std::list*	T_STD_LIST_STD_STRING_PTR

  std::list		T_STD_LIST_CSTRING
  std::list*		T_STD_LIST_CSTRING_PTR

All of these mean that the lists are converted to references
to Perl arrays and vice versa.

=head1 METHODS

These are the overridden methods:

=head2 new

Creates a new C object.
It acts as any other C object, except that
it has the list type maps initialized.

=cut

sub new {
  my $class = shift;

  my $self = $class->SUPER::new(@_);
  my $input_tmpl = <<'HERE';
!TYPENAME!
	if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVAV) {
	  AV* av = (AV*)SvRV($arg);
	  const unsigned int len = av_len(av)+1;
	  $var = std::list();
	  SV** elem;
	  for (unsigned int i = 0; i < len; i++) {
	    elem = av_fetch(av, i, 0);
	    if (elem != NULL)
	      ${var}.push_back(Sv!SHORTTYPE!V(*elem));
	    else
	      ${var}[i].push_back(!DEFAULT!);
	  }
	}
	else
	  Perl_croak(aTHX_ \"%s: %s is not an array reference\",
	             ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
	             \"$var\");

!TYPENAME!_PTR
	if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVAV) {
	  AV* av = (AV*)SvRV($arg);
	  const unsigned int len = av_len(av)+1;
	  $var = new std::list();
	  SV** elem;
	  for (unsigned int i = 0; i < len; i++) {
	    elem = av_fetch(av, i, 0);
	    if (elem != NULL)
	      (*$var).push_back(Sv!SHORTTYPE!V(*elem));
	    else
	      (*$var).push_back(!DEFAULT!);
	  }
	}
	else
	  Perl_croak(aTHX_ \"%s: %s is not an array reference\",
	             ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
	             \"$var\");

HERE

  my $output_tmpl = <<'HERE';
!TYPENAME!
	AV* av = newAV();
	$arg = newRV_noinc((SV*)av);
	const unsigned int len = $var.size(); // Technically may be linear...
	av_extend(av, len-1);
	unsigned int i = 0;
	std::list::const_iterator lend = $var.cend();
	std::list::const_iterator lit  = $var.cbegin();
	for (; lit != lend; ++lit) {
	  av_store(av, i++, newSV!SHORTTYPELC!v(*lit));
	}

!TYPENAME!_PTR
	AV* av = newAV();
	$arg = newRV_noinc((SV*)av);
	const unsigned int len = $var->size(); // Technically may be linear...
	av_extend(av, len-1);
	unsigned int i = 0;
	std::list::const_iterator lend = (*$var).cend();
	std::list::const_iterator lit  = (*$var).cbegin();
	for (; lit != lend; ++lit) {
	  av_store(av, i++, newSV!SHORTTYPELC!v(*lit));
	}

HERE

  my ($output_code, $input_code);
  # TYPENAME, TYPE, SHORTTYPE, SHORTTYPELC, DEFAULT
  foreach my $type ([qw(T_STD_LIST_DOUBLE double N n 0.)],
                    [qw(T_STD_LIST_INT int I i 0)],
                    [qw(T_STD_LIST_UINT), "unsigned int", qw(U u 0)])
  {
    my @type = @$type;
    my $otmpl = $output_tmpl;
    my $itmpl = $input_tmpl;

    for ($otmpl, $itmpl) {
      s/!TYPENAME!/$type[0]/g;
      s/!TYPE!/$type[1]/g;
      s/!SHORTTYPE!/$type[2]/g;
      s/!SHORTTYPELC!/$type[3]/g;
      s/!DEFAULT!/$type[4]/g;
    }

    $output_code .= $otmpl;
    $input_code  .= $itmpl;
  }

  # add a static part
  $output_code .= <<'END_OUTPUT';
T_STD_LIST_STD_STRING
	AV* av = newAV();
	$arg = newRV_noinc((SV*)av);
	const unsigned int len = $var.size(); // Technically may be linear...
	av_extend(av, len-1);
	unsigned int i = 0;
	std::list::const_iterator lend = $var.cend();
	std::list::const_iterator lit  = $var.cbegin();
	for (; lit != lend; ++lit) {
	  const std::string& str = *lit;
	  STRLEN len = str.length();
	  av_store(av, i++, newSVpv(str.c_str(), len));
	}

T_STD_LIST_STD_STRING_PTR
	AV* av = newAV();
	$arg = newRV_noinc((SV*)av);
	const unsigned int len = $var->size(); // Technically may be linear...
	av_extend(av, len-1);
	unsigned int i = 0;
	std::list::const_iterator lend = (*$var).cend();
	std::list::const_iterator lit  = (*$var).cbegin();
	for (; lit != lend; ++lit) {
	  const std::string& str = *lit;
	  STRLEN len = str.length();
	  av_store(av, i++, newSVpv(str.c_str(), len));
	}

T_STD_LIST_CSTRING
	AV* av = newAV();
	$arg = newRV_noinc((SV*)av);
	const unsigned int len = $var.size();
	av_extend(av, len-1);
	unsigned int i = 0;
	std::list::const_iterator lend = $var.cend();
	std::list::const_iterator lit  = $var.cbegin();
	for (; lit != lend; ++lit) {
	  av_store(av, i, newSVpv(*lit, (STRLEN)strlen(*lit)));
	}

T_STD_LIST_CSTRING_PTR
	AV* av = newAV();
	$arg = newRV_noinc((SV*)av);
	const unsigned int len = $var->size();
	av_extend(av, len-1);
	unsigned int i = 0;
	std::list::const_iterator lend = (*$var).cend();
	std::list::const_iterator lit  = (*$var).cbegin();
	for (; lit != lend; ++lit) {
	  av_store(av, i, newSVpv(*lit, (STRLEN)strlen(*lit)));
	}

END_OUTPUT

  # add a static part to input
  $input_code .= <<'END_INPUT';
T_STD_LIST_STD_STRING
	if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVAV) {
	  AV* av = (AV*)SvRV($arg);
	  const unsigned int alen = av_len(av)+1;
	  $var = std::list();
	  STRLEN len;
	  char* tmp;
	  SV** elem;
	  for (unsigned int i = 0; i < alen; i++) {
	    elem = av_fetch(av, i, 0);
	    if (elem != NULL) {
	      tmp = SvPV(*elem, len);
	      ${var}.push_back(std::string(tmp, len));
	    }
	    else
	      ${var}.push_back(std::string(\"\"));
	  }
	}
	else
	  Perl_croak(aTHX_ \"%s: %s is not an array reference\",
	             ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
	             \"$var\");

T_STD_LIST_STD_STRING_PTR
	if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVAV) {
	  AV* av = (AV*)SvRV($arg);
	  const unsigned int alen = av_len(av)+1;
	  $var = new std::list(alen);
	  STRLEN len;
	  char* tmp;
	  SV** elem;
	  for (unsigned int i = 0; i < alen; i++) {
	    elem = av_fetch(av, i, 0);
	    if (elem != NULL) {
	      tmp = SvPV(*elem, len);
	      (*$var).push_back(std::string(tmp, len));
	    }
	    else
	      (*$var).push_back(std::string(\"\"));
	  }
	}
	else
	  Perl_croak(aTHX_ \"%s: %s is not an array reference\",
	             ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
	             \"$var\");

T_STD_LIST_CSTRING
	if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVAV) {
	  AV* av = (AV*)SvRV($arg);
	  const unsigned int len = av_len(av)+1;
	  $var = std::list();
	  SV** elem;
	  for (unsigned int i = 0; i < len; i++) {
	    elem = av_fetch(av, i, 0);
	    if (elem != NULL) {
	      ${var}.push_back(SvPV_nolen(*elem));
	    else
	      ${var}.push_back(NULL);
	  }
	}
	else
	  Perl_croak(aTHX_ \"%s: %s is not an array reference\",
	             ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
	             \"$var\");

T_STD_LIST_CSTRING_PTR
	if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVAV) {
	  AV* av = (AV*)SvRV($arg);
	  const unsigned int len = av_len(av)+1;
	  $var = new std::list();
	  SV** elem;
	  for (unsigned int i = 0; i < len; i++) {
	    elem = av_fetch(av, i, 0);
	    if (elem != NULL) {
	      (*$var).push_back(SvPV_nolen(*elem));
	    else
	      (*$var).push_back(NULL);
	  }
	}
	else
	  Perl_croak(aTHX_ \"%s: %s is not an array reference\",
	             ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
	             \"$var\");
END_INPUT

  my $typemap_code = <<'END_TYPEMAP';
TYPEMAP
std::list*		T_STD_LIST_DOUBLE_PTR
std::list		T_STD_LIST_DOUBLE
std::list*			T_STD_LIST_INT_PTR
std::list			T_STD_LIST_INT
std::list*	T_STD_LIST_UINT_PTR
std::list		T_STD_LIST_UINT
std::list		T_STD_LIST_STD_STRING
std::list*		T_STD_LIST_STD_STRING_PTR
std::list		T_STD_LIST_STD_STRING
std::list*		T_STD_LIST_STD_STRING_PTR
std::list		T_STD_LIST_CSTRING
std::list*		T_STD_LIST_CSTRING_PTR
list*			T_STD_LIST_DOUBLE_PTR
list			T_STD_LIST_DOUBLE
list*			T_STD_LIST_INT_PTR
list			T_STD_LIST_INT
list*		T_STD_LIST_UINT_PTR
list		T_STD_LIST_UINT
list		T_STD_LIST_STD_STRING
list*		T_STD_LIST_STD_STRING_PTR
list			T_STD_LIST_STD_STRING
list*			T_STD_LIST_STD_STRING_PTR
list			T_STD_LIST_CSTRING
list*			T_STD_LIST_CSTRING_PTR

INPUT
END_TYPEMAP
  $typemap_code .= $input_code;
  $typemap_code .= "\nOUTPUT\n";
  $typemap_code .= $output_code;
  $typemap_code .= "\n";

  $self->add_string(string => $typemap_code);

  return $self;
}

1;

__END__