write_typemap( File::Spec->catfile(
'xs'
,
'typemap'
) );
write_magic_file( File::Spec->catfile(
'xs'
,
'mg-xs.inc'
) );
sub
write_magic_file {
my
$file
=
shift
;
open
my
$fh
,
'>'
,
$file
or
die
"Could not open objects file $file: $!"
;
print
$fh
<<EOM;
STATIC_INLINE
int
PerlZMQ_mg_free(pTHX_ SV * const sv, MAGIC *const mg ) {
PERL_UNUSED_VAR(sv);
Safefree(mg->mg_ptr);
return 0;
}
STATIC_INLINE
int
PerlZMQ_mg_dup(pTHX_ MAGIC* const mg, CLONE_PARAMS* const param) {
PERL_UNUSED_VAR(mg);
PERL_UNUSED_VAR(param);
return 0;
}
EOM
my
$file
=
"xs/perl_libzmq4.xs"
;
open
my
$src
,
'<'
,
$file
or
die
"Failed to open $file: $!"
;
my
@perl_types
=
qw(
ZMQ::LibZMQ4::Context
ZMQ::LibZMQ4::Socket
ZMQ::LibZMQ4::Message
)
;
foreach
my
$perl_type
(
@perl_types
) {
my
$c_type
=
$perl_type
;
$c_type
=~ s/::/_/g;
$c_type
=~ s/^ZMQ_LibZMQ4/P5ZMQ4/;
my
$vtablename
=
sprintf
'%s_vtbl'
,
$c_type
;
my
(
$has_free
,
$has_dup
);
seek
(
$src
, 0, 0);
while
(<
$src
>) {
$has_free
++
if
/^${c_type}_mg_free\b/;
$has_dup
++
if
/^${c_type}_mg_dup\b/;
}
my
$free
=
$has_free
?
"${c_type}_mg_free"
:
"PerlZMQ_mg_free"
;
my
$dup
=
$has_dup
?
"${c_type}_mg_dup"
:
"PerlZMQ_mg_dup"
;
print
$fh
<<EOM
#ifdef MGf_LOCAL
P5ZMQ4_DECL_VTBL($c_type, 0, 0, 0, 0, $free, 0, $dup, 0);
#else
P5ZMQ4_DECL_VTBL($c_type, 0, 0, 0, 0, $free, 0, $dup);
#endif
EOM
}
}
sub
write_typemap {
my
$file
=
shift
;
my
@perl_types
=
qw(
ZMQ::LibZMQ4::Context
ZMQ::LibZMQ4::Socket
ZMQ::LibZMQ4::Message
)
;
open
(
my
$out
,
'>'
,
$file
) or
die
"Could not open $file for writing: $!"
;
my
(
@decl
,
@input
,
@output
);
push
@decl
,
"uint64_t T_UV"
;
push
@decl
,
"int64_t T_IV"
;
foreach
my
$perl_type
(
@perl_types
) {
my
$c_type
=
$perl_type
;
$c_type
=~ s/::/_/g;
$c_type
=~ s/^ZMQ_LibZMQ4_/P5ZMQ4_/;
my
$typemap_type
=
'T_'
.
uc
$c_type
;
my
$closed_error
=
$c_type
=~ /Socket/ ?
"ENOTSOCK"
:
"EFAULT"
;
push
@decl
,
"$c_type* $typemap_type"
;
push
@input
,
<<EOM;
$typemap_type
P5ZMQ4_SV2STRUCT(\$arg, \$var, $perl_type, $c_type, $closed_error);
EOM
push
@output
,
<<EOM;
$typemap_type
P5ZMQ4_STRUCT2SV(\$arg, \$var, $perl_type, $c_type);
EOM
}
print
$out
"# Do NOT edit this file! This file was automatically generated\n"
,
"# by Makefile.PL on @{[scalar localtime]}. If you want to\n"
,
"# regenerate it, remove this file and re-run Makefile.PL\n"
,
"\n"
;
print
$out
join
(
"\n"
,
"TYPEMAP\n"
,
join
(
"\n"
,
@decl
),
"\n"
,
"INPUT\n"
,
join
(
"\n"
,
@input
),
"\n"
,
"OUTPUT\n"
,
join
(
"\n"
,
@output
),
"\n"
,
);
close
$out
;
}