The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package ExtUtils::XSpp::Plugin::TestArgumentPlugin;

use strict;
use warnings;

sub new { return bless { directives => [] }, $_[0] }

sub register_plugin {
    my( $class, $parser ) = @_;
    my $inst = $class->new;

    $parser->add_method_tag_plugin( plugin => $inst, tag => 'MyWrap' );
    $parser->add_argument_tag_plugin( plugin => $inst, tag => 'MyWrap' );
}

sub handle_method_tag {
    my( $self, $method, $any_tag, %args ) = @_;

    $method->set_ret_typemap( _wrap_typemap( $method->ret_typemap, 'ret' ) );

    return 1;
}

sub handle_argument_tag {
    my( $self, $argument, $any_tag, %args ) = @_;
    my $function = $argument->function;

    $function->set_arg_typemap
        ( $argument->index, _wrap_typemap( $function->arg_typemap( $argument->index ), $argument->index ) );

    return 1;
}

sub _wrap_typemap {
    my( $typemap, $description ) = @_;

    return ExtUtils::XSpp::Plugin::TestArgumentPlugin::Wrapper->new
               ( typemap => $typemap, description => $description );
}

package ExtUtils::XSpp::Plugin::TestArgumentPlugin::Wrapper;

use strict;
use warnings;
use base 'ExtUtils::XSpp::Typemap::wrapper';

sub init {
    my( $self, %args ) = @_;
    $self->SUPER::init( %args );

    $self->{DESCRIPTION} = $args{description};
}

sub precall_code {
    my( $self, $pvar, $cvar ) = @_;
    my $code = $self->typemap->precall_code( $pvar, $cvar );
    my $add = '// wrapped typemap ' . $self->{DESCRIPTION};

    return $code ? "$code\n$add" : $add;
}

sub cleanup_code {
    my( $self, $pvar, $cvar ) = @_;
    my $code = $self->typemap->cleanup_code( $pvar, $cvar );
    my $add = '// wrapped typemap ' . $self->{DESCRIPTION};

    return $code ? "$code\n$add" : $add;
}

1;