split into input / qrcode

8 files changed, 233 insertions, 192 deletions

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);