The Perl Toolchain Summit 2025 Needs You: You can help 🙏 Learn more

LEONT / ExtUtils-Typemaps-Misc-0.004 / lib / ExtUtils / Typemaps / OpaqueObj.pm 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
—
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117

              
package ExtUtils::Typemaps::OpaqueObj;
$ExtUtils::Typemaps::OpaqueObj::VERSION = '0.004';
use strict;
use warnings;
use parent 'ExtUtils::Typemaps';
sub new {
        my $class = shift;
        my $self = $class->SUPER::new(@_);
        $self->add_inputmap(xstype => 'T_OPAQUEOBJ', code => <<'END');
    {
                SV * sv = $arg;
                if (SvROK(sv) && SvPOK(SvRV(sv)) && SvCUR(SvRV(sv)) == sizeof(*$var))
                        $var = ($type)SvPV_nolen(SvRV(sv));
                else
                        croak(\"%s: %s is not of type %s\", ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]}, \"$var\", \"$ntype\");
    }
END
        $self->add_inputmap(xstype => 'T_OPAQUEOBJ_MAYBE', code => <<'END');
        {
                SV * sv = $arg;
                if (SvOK(sv)) {
                        if (SvROK(sv) && SvPOK(SvRV(sv)) && SvCUR(SvRV(sv)) == sizeof(*$var))
                                $var = ($type)SvPV_nolen(SvRV(sv));
                        else
                                croak(\"%s: %s is not of type %s\", ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]}, \"$var\", \"$ntype\");
                } else
                        $var = NULL;
        }
END
        $self->add_outputmap(xstype => 'T_OPAQUEOBJ', code => <<'END');
        {
                sv_usepvn(newSVrv($arg, \"$ntype\"), (char*)$var, sizeof(*$var));
                SvREADONLY_on(SvRV($arg));
        }
END
        $self->add_outputmap(xstype => 'T_OPAQUEOBJ_MAYBE', code => <<'END');
        if (SvOK($var)) {
                sv_usepvn(newSVrv($arg, \"$ntype\"), (char*)$var, sizeof(*$var));
                SvREADONLY_on(SvRV($arg));
        }
END
        return $self;
}
1;
# ABSTRACT: Typemap for storing objects as a string reference
__END__
=pod
=encoding UTF-8
=head1 NAME
ExtUtils::Typemaps::OpaqueObj - Typemap for storing objects as a string reference
=head1 VERSION
version 0.004
=head1 SYNOPSIS
In typemap
 Foo::Bar       T_OPAQUEOBJ
In your XS:
 typedef struct foo_bar* Foo__Bar;
  
 MODULE = Foo::Bar    PACKAGE = Foo::Bar    PREFIX = foobar_
  
 Foo::Bar foobar_new(SV* class, int argument)
 int foobar_baz(Foo::Bar self)
=head1 DESCRIPTION
C<ExtUtils::Typemaps::OpaqueObj> is an C<ExtUtils::Typemaps> subclass that stores an object inside a string reference. It is particularly suitable for objects whose entire state is helt in the struct (e.g. no pointers, handles, descriptors, …). In such cases the object will serialize and deserialize cleanly, and is safe with regards to thread cloning.
=head1 INCLUSION
To use this typemap template you need to include it into your local typemap. The easiest way to do that is to use the L<typemap> script in L<App::typemap>. E.g.
 typemap --merge ExtUtils::Typemaps::OpaqueObj
If you author using C<Dist::Zilla> you can use L<Dist::Zilla::Plugin::Typemap> instead.
Alternatively, you can include it at runtime by adding the following to your XS file:
 INCLUDE_COMMAND: $^X -MExtUtils::Typemaps::Cmd -e "print embeddable_typemap('OpaqueObj')"
That does require adding a build time dependency on this module.
=head1 AUTHOR
Leon Timmermans <fawaka@gmail.com>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2024 by Leon Timmermans.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut