From ea6a8a0658d1ba354a43d57f626c04951ac48e98 Mon Sep 17 00:00:00 2001 From: dakkar Date: Thu, 10 Nov 2016 12:49:46 +0000 Subject: try using more magic --- dist.ini | 6 +++ lib/Data/QRCode/XS.pm | 43 +++++++++----------- typemap | 107 ++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 131 insertions(+), 25 deletions(-) create mode 100644 typemap diff --git a/dist.ini b/dist.ini index 2c9422e..2e5472f 100644 --- a/dist.ini +++ b/dist.ini @@ -31,6 +31,12 @@ first_version = 0.0.1 [AutoPrereqs] +[Prereqs / BuildRequires] +Alien::QREncode = 0 + +[Prereqs / Requires] +Alien::QREncode = 0 + [OurPkgVersion] [ManifestSkip] diff --git a/lib/Data/QRCode/XS.pm b/lib/Data/QRCode/XS.pm index f46cba6..aa8597a 100644 --- a/lib/Data/QRCode/XS.pm +++ b/lib/Data/QRCode/XS.pm @@ -3,52 +3,45 @@ use strict; use warnings; # ABSTRACT: qrcodes in C # VERSION -use Alien::QREncode; -use Data::QRCode::XS::Inline C => ( ); +use Data::QRCode::XS::Inline with => 'Alien::QREncode'; +use Data::QRCode::XS::Inline C => ( + 'DATA', + autowrap => 1, + typemaps => 'typemap', +); 1; __DATA__ - __C__ -#include "qrencode.h" - int ECLEVEL_L() { return QR_ECLEVEL_L; } int ECLEVEL_M() { return QR_ECLEVEL_M; } int ECLEVEL_Q() { return QR_ECLEVEL_Q; } int ECLEVEL_H() { return QR_ECLEVEL_H; } -SV* _build(const char* class, SV* data, int level, int version ) { +#define CLASS "Data::QRCode" + +QRcode* _build(const char* class, SV* data, int level, int version ) { unsigned char * str; STRLEN len; - SV * qrsv; SV* self; - QRcode* qr_code; str = SvPVutf8(data,len); - qr_code = QRcode_encodeData(len,str,version,(QRecLevel)level); - qrsv = newSViv((IV)qr_code); - self = newRV_noinc(qrsv); - sv_bless(self, gv_stashpv(class, GV_ADD)); - SvREADONLY_on(qrsv); - - return self; + return QRcode_encodeData(len,str,version,(QRecLevel)level); } -int version(SV* self) { - return ((QRcode*)SvIV(SvRV(self)))->version; +int version(QRcode* self) { + return self->version; } -int width(SV* self) { - return ((QRcode*)SvIV(SvRV(self)))->width; +int width(QRcode* self) { + return self->width; } -void DESTROY(SV* self) { - QRcode* qr_code = (QRcode*)SvIV(SvRV(self)); - QRcode_free(qr_code); +void DESTROY(QRcode* self) { + QRcode_free(self); } -int _data_at(SV* self, int x, int y) { - QRcode* qr_code = (QRcode*)SvIV(SvRV(self)); - return qr_code->data[x+y*qr_code->width]; +int _data_at(QRcode* self, int x, int y) { + return self->data[x+y*self->width]; } diff --git a/typemap b/typemap new file mode 100644 index 0000000..feb91b3 --- /dev/null +++ b/typemap @@ -0,0 +1,107 @@ +# "perlobject.map" Dean Roehrich, version 19960302 +# +# TYPEMAPs +# +# HV * -> unblessed Perl HV object. +# AV * -> unblessed Perl AV object. +# +# INPUT/OUTPUT maps +# +# O_* -> opaque blessed objects +# T_* -> opaque blessed or unblessed objects +# +# O_OBJECT -> link an opaque C or C++ object to a blessed Perl object. +# T_OBJECT -> link an opaque C or C++ object to an unblessed Perl object. +# O_HvRV -> a blessed Perl HV object. +# T_HvRV -> an unblessed Perl HV object. +# O_AvRV -> a blessed Perl AV object. +# T_AvRV -> an unblessed Perl AV object. + +TYPEMAP + +HV * T_HvRV +AV * T_AvRV + +QRcode * O_OBJECT + +###################################################################### +OUTPUT + +# The Perl object is blessed into 'CLASS', which should be a +# char* having the name of the package for the blessing. +O_OBJECT + sv_setref_pv( $arg, CLASS, (void*)$var ); + +T_OBJECT + sv_setref_pv( $arg, Nullch, (void*)$var ); + +# Cannot use sv_setref_pv() because that will destroy +# the HV-ness of the object. Remember that newRV() will increment +# the refcount. +O_HvRV + $arg = sv_bless( newRV((SV*)$var), gv_stashpv(CLASS,1) ); + +T_HvRV + $arg = newRV((SV*)$var); + +# Cannot use sv_setref_pv() because that will destroy +# the AV-ness of the object. Remember that newRV() will increment +# the refcount. +O_AvRV + $arg = sv_bless( newRV((SV*)$var), gv_stashpv(CLASS,1) ); + +T_AvRV + $arg = newRV((SV*)$var); + + +###################################################################### +INPUT + +O_OBJECT + if( sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVMG) ) + $var = ($type)SvIV((SV*)SvRV( $arg )); + else{ + warn( \"${Package}::$func_name() -- $var is not a blessed SV reference\" ); + XSRETURN_UNDEF; + } + +T_OBJECT + if( SvROK($arg) ) + $var = ($type)SvIV((SV*)SvRV( $arg )); + else{ + warn( \"${Package}::$func_name() -- $var is not an SV reference\" ); + XSRETURN_UNDEF; + } + +O_HvRV + if( sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVHV) ) + $var = (HV*)SvRV( $arg ); + else { + warn( \"${Package}::$func_name() -- $var is not a blessed HV reference\" ); + XSRETURN_UNDEF; + } + +T_HvRV + if( SvROK($arg) && (SvTYPE(SvRV($arg)) == SVt_PVHV) ) + $var = (HV*)SvRV( $arg ); + else { + warn( \"${Package}::$func_name() -- $var is not an HV reference\" ); + XSRETURN_UNDEF; + } + +O_AvRV + if( sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVAV) ) + $var = (AV*)SvRV( $arg ); + else { + warn( \"${Package}::$func_name() -- $var is not a blessed AV reference\" ); + XSRETURN_UNDEF; + } + +T_AvRV + if( SvROK($arg) && (SvTYPE(SvRV($arg)) == SVt_PVAV) ) + $var = (AV*)SvRV( $arg ); + else { + warn( \"${Package}::$func_name() -- $var is not an AV reference\" ); + XSRETURN_UNDEF; + } + -- cgit v1.2.3