File Coverage

blib/lib/ExtUtils/Typemaps/MagicExt.pm

Criterion	Covered	Total	%
statement	9	16	56.2
branch			n/a
condition			n/a
subroutine	3	5	60.0
pod	1	2	50.0
total	13	23	56.5

package ExtUtils::Typemaps::MagicExt;
$ExtUtils::Typemaps::MagicExt::VERSION = '0.009';
use strict;
use warnings;

use parent 'ExtUtils::Typemaps';

sub new {
	my $class = shift;
	my $self = $class->SUPER::new(@_);

	$self->add_inputmap(xstype => 'T_MAGICEXT', code => <<'END');
	{
	SV* arg = $arg;
	MAGIC* magic = SvROK(arg) && SvMAGICAL(SvRV(arg)) ? mg_findext(SvRV(arg), PERL_MAGIC_ext, &${type}_magic) : NULL;
	if (magic)
		$var = ($type)magic->mg_ptr;
	else
		Perl_croak(aTHX_ \"%s object is lacking magic\", \"$ntype\");
	}
END
	$self->add_inputmap(xstype => 'T_MAGICEXT_BASE', code => <<'END');
	{
	SV* arg = $arg;
	MAGIC* magic = SvROK(arg) && SvMAGICAL(SvRV(arg)) ? mg_find(SvRV(arg), PERL_MAGIC_ext) : NULL;
	if (magic && magic->mg_virtual)
		$var = ($type)magic->mg_ptr;
	else
		Perl_croak(aTHX_ \"%s object is lacking magic\", \"$ntype\");
	}
END


	$self->add_outputmap(xstype => 'T_MAGICEXT', code => <<'END');
	{
	MAGIC* magic = sv_magicext(newSVrv($arg, "$ntype"), NULL, PERL_MAGIC_ext, &${type}_magic, (const char*)$var, 0);
	magic->mg_flags |= MGf_COPY|MGf_DUP;
	}
END

	return $self;
}

sub minimum_pxs {
	return '3.50';
}

1;

# ABSTRACT: Typemap for storing objects in magic pointer

__END__