From 61f964216b16b25200e2a2ac961f7444c0570daf Mon Sep 17 00:00:00 2001 From: dakkar Date: Thu, 10 Nov 2016 13:27:18 +0000 Subject: split into input / qrcode --- dist.ini | 3 +- lib/Data/QRCode.pm | 45 +++++++++++------ lib/Data/QRCode/Input.pm | 75 +++++++++++++++++++++++++++++ lib/Data/QRCode/XS.pm | 47 ------------------ t/base.t | 31 ------------ t/input.t | 33 +++++++++++++ t/qrcode.t | 68 ++++++++++++++++++++++++++ typemap | 123 ++++++++++------------------------------------- 8 files changed, 233 insertions(+), 192 deletions(-) create mode 100644 lib/Data/QRCode/Input.pm delete mode 100644 lib/Data/QRCode/XS.pm delete mode 100644 t/base.t create mode 100644 t/input.t create mode 100644 t/qrcode.t diff --git a/dist.ini b/dist.ini index 2e5472f..5267dcc 100644 --- a/dist.ini +++ b/dist.ini @@ -7,7 +7,8 @@ copyright_year = 2016 [GatherDir] [InlineModule] -module = Data::QRCode::XS +module = Data::QRCode +module = Data::QRCode::Input [PodWeaver] ; authordep Pod::Elemental::Transformer::List diff --git a/lib/Data/QRCode.pm b/lib/Data/QRCode.pm index 680e251..b7f8c4e 100644 --- a/lib/Data/QRCode.pm +++ b/lib/Data/QRCode.pm @@ -3,33 +3,27 @@ use strict; use warnings; # ABSTRACT: qrcodes in C # VERSION -use Data::QRCode::XS; - -my %levels = ( - L => Data::QRCode::XS::ECLEVEL_L(), - M => Data::QRCode::XS::ECLEVEL_M(), - Q => Data::QRCode::XS::ECLEVEL_Q(), - H => Data::QRCode::XS::ECLEVEL_H(), +use Data::QRCode::Inline with => 'Alien::QREncode'; +use Data::QRCode::Inline C => ( + 'DATA', + autowrap => 1, + typemaps => 'typemap', ); sub new { - my ($class, $data, $level, $version) = @_; - $version ||= 0; - $level = $levels{uc $level} || Data::QRCode::XS::ECLEVEL_M(); - return Data::QRCode::XS::_build($class,$data,$level,$version); + my ($class, $input) = @_; + my $self = QRcode_encodeInput($input); + bless $self, $class; + return $self; } -sub width { Data::QRCode::XS::width(@_) } - -sub version { Data::QRCode::XS::version(@_) } - sub data_at { my ($self,$x,$y) = @_; my $width = $self->width; if ($x < 0 or $x >= $width or $y < 0 or $y >= $width) { return; } - my $value = Data::QRCode::XS::_data_at($self,$x,$y); + my $value = _data_at($self,$x,$y); return { color => $value & 0x01, @@ -44,3 +38,22 @@ sub data_at { } 1; + +__DATA__ +__C__ + +QRcode *QRcode_encodeInput(QRinput *input); + +void DESTROY(QRcode *qrcode) { QRcode_free(qrcode); } + +int version(QRcode* self) { + return self->version; +} + +int width(QRcode* self) { + return self->width; +} + +int _data_at(QRcode* self, int x, int y) { + return self->data[x+y*self->width]; +} diff --git a/lib/Data/QRCode/Input.pm b/lib/Data/QRCode/Input.pm new file mode 100644 index 0000000..69fd283 --- /dev/null +++ b/lib/Data/QRCode/Input.pm @@ -0,0 +1,75 @@ +package Data::QRCode::Input; +use strict; +use warnings; +# ABSTRACT: qrcodes in C +# VERSION +use Data::QRCode::Input::Inline with => 'Alien::QREncode'; +use Data::QRCode::Input::Inline C => ( + 'DATA', + autowrap => 1, + typemaps => 'typemap', +); + +sub new { + my ($class) = @_; + + my $self = QRinput_new(); + bless $self,$class; + return $self; +} + +sub version { + my $self = shift; + if (@_) { + return QRinput_setVersion($self,shift); + } + else { + return QRinput_getVersion($self); + } +} + +sub error_correction_level { + my $self = shift; + if (@_) { + return QRinput_setErrorCorrectionLevel($self,shift); + } + else { + return QRinput_getErrorCorrectionLevel($self); + } +} + +1; + +__DATA__ +__C__ + +QRecLevel ECLEVEL_L() { return QR_ECLEVEL_L; } +QRecLevel ECLEVEL_M() { return QR_ECLEVEL_M; } +QRecLevel ECLEVEL_Q() { return QR_ECLEVEL_Q; } +QRecLevel ECLEVEL_H() { return QR_ECLEVEL_H; } + +QRencodeMode MODE_NUM() { return QR_MODE_NUM; } +QRencodeMode MODE_AN() { return QR_MODE_AN; } +QRencodeMode MODE_8() { return QR_MODE_8; } +QRencodeMode MODE_KANJI() { return QR_MODE_KANJI; } +QRencodeMode MODE_STRUCTURE() { return QR_MODE_STRUCTURE; } +QRencodeMode MODE_ECI() { return QR_MODE_ECI; } +QRencodeMode MODE_FNC1FIRST() { return QR_MODE_FNC1FIRST; } +QRencodeMode MODE_FNC1SECOND() { return QR_MODE_FNC1SECOND; } + +extern QRinput *QRinput_new(void); +void DESTROY(QRinput *input) { QRinput_free(input); } + +int append(QRinput *input, QRencodeMode mode, SV *data) { + unsigned char * str; + STRLEN len; + + str = SvPVutf8(data,len); + return QRinput_append(input,mode,len,str); +} + +extern int QRinput_getVersion(QRinput *input); +extern int QRinput_setVersion(QRinput *input, int version); + +extern QRecLevel QRinput_getErrorCorrectionLevel(QRinput *input); +extern int QRinput_setErrorCorrectionLevel(QRinput *input, QRecLevel level); diff --git a/lib/Data/QRCode/XS.pm b/lib/Data/QRCode/XS.pm deleted file mode 100644 index aa8597a..0000000 --- a/lib/Data/QRCode/XS.pm +++ /dev/null @@ -1,47 +0,0 @@ -package Data::QRCode::XS; -use strict; -use warnings; -# ABSTRACT: qrcodes in C -# VERSION -use Data::QRCode::XS::Inline with => 'Alien::QREncode'; -use Data::QRCode::XS::Inline C => ( - 'DATA', - autowrap => 1, - typemaps => 'typemap', -); - -1; - -__DATA__ -__C__ - -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; } - -#define CLASS "Data::QRCode" - -QRcode* _build(const char* class, SV* data, int level, int version ) { - unsigned char * str; - STRLEN len; - - str = SvPVutf8(data,len); - return QRcode_encodeData(len,str,version,(QRecLevel)level); -} - -int version(QRcode* self) { - return self->version; -} - -int width(QRcode* self) { - return self->width; -} - -void DESTROY(QRcode* self) { - QRcode_free(self); -} - -int _data_at(QRcode* self, int x, int y) { - return self->data[x+y*self->width]; -} diff --git a/t/base.t b/t/base.t deleted file mode 100644 index 25bda6a..0000000 --- a/t/base.t +++ /dev/null @@ -1,31 +0,0 @@ -#!perl -use strict; -use warnings; -use Test2::Bundle::Extended; -use Data::QRCode; - -my $qr = Data::QRCode->new('some words','M'); - -my $text; -for my $y (0..$qr->width-1) { - for my $x (0..$qr->width-1) { - my $data = $qr->data_at($x,$y); - $text .= ( - !$data->{color} ? ' ' : - $data->{in_data} ? 'D' : - $data->{in_format} ? 'F' : - $data->{in_version} ? 'V' : - $data->{in_timing} ? 'T' : - $data->{in_alignment} ? 'A' : - $data->{in_finder} ? 'R' : - '*' - ); - } - $text .= "\n"; -} - -note $text; - -ok($text); - -done_testing; diff --git a/t/input.t b/t/input.t new file mode 100644 index 0000000..91e8afc --- /dev/null +++ b/t/input.t @@ -0,0 +1,33 @@ +#!perl +use strict; +use warnings; +use Test2::Bundle::Extended; +use Data::QRCode::Input; + +my $input = Data::QRCode::Input->new(); + +$input->version(12); +$input->error_correction_level(Data::QRCode::Input::ECLEVEL_M); + +is( + $input->version, + 12, + 'version should round-trip', +); + +is( + $input->error_correction_level, + Data::QRCode::Input::ECLEVEL_M, + 'ec level should round-trip', +); + +is( + $input->append( + Data::QRCode::Input::MODE_8, + 'some data', + ), + 0, + 'append should work and return 0 on success', +); + +done_testing; diff --git a/t/qrcode.t b/t/qrcode.t new file mode 100644 index 0000000..f82c5ff --- /dev/null +++ b/t/qrcode.t @@ -0,0 +1,68 @@ +#!perl +use strict; +use warnings; +use Test2::Bundle::Extended; +use Data::QRCode; +use Data::QRCode::Input; + +my $input = Data::QRCode::Input->new; +$input->error_correction_level(Data::QRCode::Input::ECLEVEL_M); +$input->append(Data::QRCode::Input::MODE_8,'some words'); + +my $qr = Data::QRCode->new($input); + +is( + $qr->version, + 1, + 'version should be set', +); + +is( + $qr->width, + 21, + 'width should be set', +); + +my $text; +for my $y (0..$qr->width-1) { + for my $x (0..$qr->width-1) { + my $data = $qr->data_at($x,$y); + $text .= ( + !$data->{color} ? ' ' : + $data->{in_data} ? 'D' : + $data->{in_format} ? 'F' : + $data->{in_version} ? 'V' : + $data->{in_timing} ? 'T' : + $data->{in_alignment} ? 'A' : + $data->{in_finder} ? 'R' : + '*' + ); + } + $text .= "\n"; +} + +is($text,<<'QRCODE','data should be as expected'); +RRRRRRR F DDD RRRRRRR +R R F D R R +R RRR R D D R RRR R +R RRR R FDD R RRR R +R RRR R R RRR R +R R D R R +RRRRRRR T T T RRRRRRR + F D +F FF FTF DD F F FF + DD D DDD D DD D +D DDTD DD D D DDD +DDD D DD D D D D + D TD D D D D + * D DD D DD +RRRRRRR FD D DDD +R R F DDDD DDD D +R RRR R D D D DD +R RRR R F D D D D D +R RRR R F DD DD DD +R R DD D D D +RRRRRRR F DDD D D +QRCODE + +done_testing; diff --git a/typemap b/typemap index feb91b3..5011c4f 100644 --- a/typemap +++ b/typemap @@ -1,107 +1,36 @@ -# "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); +QRcode * T_QRCODE +QRinput * T_QRINPUT +QRencodeMode T_ENUM +QRecLevel T_ENUM -###################################################################### 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_QRCODE + if (SvROK($arg) && sv_derived_from($arg, \"Data::QRCode\")) { + IV tmp = SvIV((SV*)SvRV($arg)); + $var = INT2PTR($type,tmp); } - -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; + else + Perl_croak_nocontext(\"%s: %s is not of type %s\", + ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]}, + \"$var\", \"Data::QRCode\") + +T_QRINPUT + if (SvROK($arg) && sv_derived_from($arg, \"Data::QRCode::Input\")) { + IV tmp = SvIV((SV*)SvRV($arg)); + $var = INT2PTR($type,tmp); } + else + Perl_croak_nocontext(\"%s: %s is not of type %s\", + ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]}, + \"$var\", \"Data::QRCode::Input\") -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; - } +OUTPUT +T_QRCODE + sv_setref_pv($arg, \"Data::QRCode\", (void*)$var); +T_QRINPUT + sv_setref_pv($arg, \"Data::QRCode::Input\", (void*)$var); -- cgit v1.2.3