view release on metacpan or  search on metacpan

lib/Inline/Struct.pm  view on Meta::CPAN

    CODE:
        RETVAL = newAV();
        INLINE_STRUCT_KEYS(object, RETVAL, $struct);
    OUTPUT:
        RETVAL

END

        my $i=1;
	for my $field (@{$parser->{data}{struct}{$struct}{fields}}) {
	    my $flen = length $field;
	    my $type = $parser->{data}{struct}{$struct}{field}{$field};
	    my $q = ($i == 1 ? 'if' : 'else if');
	    my $t =
	      typeconv($o, "_IS_targ->$field",
			   "val",
			   $type,
			   "input_expr",
			   1,
			   '_KEYS',
			  );
	    my $s =
	      typeconv($o, "_IS_src->$field",
			   "tmp",
			   $type,
			   "output_expr",
			   1,
			   '_KEYS',
			  );
	    $INITL .=
	      (typeconv($o, "_IS_targ->$field",
			    "ST($i)",
			    $type,
			    "input_expr",
			    1,
			    '_KEYS',
			   ) .
	       "; \\\n");
	    $HASH .= (qq{{\\\n\tSV*tmp=newSViv(0);\\\n$s \\
\thv_store(_IS_targ, "$field", $flen, tmp, 0); \\\n}} .
		      ($i == $maxi ? "" : "\\") .
		      "\n"
		     );
	    $ARRAY .= (qq{{\\\n\tSV*tmp=newSViv(0);\\\n$s \\
\tav_push(_IS_targ, tmp); \\\n}} .
		       ($i == $maxi ? "" : "\\") .
		       "\n"
		      );
	    $KEYS .= (qq{av_push(_IS_targ, newSVpv("$field", 0));} .
		      ($i == $maxi ? "" : "\\") .
		      "\n"
		     );
	    my $is_sv = $type =~ /^SV\s*\*$/;
	    $o->{STRUCT}{'.xs'} .= <<EOF;
void
$field(object, ...)
	$cname *object
    PREINIT:
	SV *retval = newSViv(0);
	int mortalise_retval = 0;
    PPCODE:
	ENTER;
	SAVETMPS;
	if (items == 1) {
	    @{[typeconv($o, "object->$field", "retval", $type, "output_expr", undef, $field)]}
	    @{[
	    # mortalise if not an SV *
	    $is_sv ? '' : 'mortalise_retval = 1;'
	    ]}
	}
	else {
	    @{[
	    $is_sv ?
		qq{if (object->$field && SvOK(object->$field)) {
		    SvREFCNT_dec(object->$field);
		}} : ""
	    ]}
	    @{[typeconv($o, "object->$field", "ST(1)", $type, "input_expr", undef, $field)]};
	    @{[
	    $is_sv ?
		qq{if (object->$field && SvOK(object->$field)) {
		    SvREFCNT_inc(object->$field);
		}} : ""
	    ]}
	    @{[typeconv($o, "object", "retval", "$cname *", "output_expr", undef, $field)]};
	    mortalise_retval = 1;
	}
	FREETMPS;
	LEAVE;
	if (mortalise_retval) sv_2mortal(retval);
	XPUSHs(retval);

EOF
            $i++;
	}
	$INITL .= "}\n";

	$o->{STRUCT}{'.macros'} .= <<END;
$NEW
$FIELDS
$INITL
$HASH
$ARRAY
$KEYS
END

    }

    # Write a typemap file containing typemaps for each thingy
    write_typemap($o);
}

sub write_typemap {
    my $o = shift;
    my $data = $o->{STRUCT}{'.parser'}{data};

    my ($TYPEMAP, $INPUT, $OUTPUT);
    for my $struct (@{$data->{structs}}) {
	my $type = "O_OBJECT_$struct";
	my @ctypes = grep { $data->{typeconv}{type_kind}{$_} eq $type }
	   keys %{$data->{typeconv}{type_kind}};