summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--dist.ini2
-rw-r--r--lib/Data/QRCode.pm106
-rw-r--r--lib/Data/QRCode/Result.pm63
-rw-r--r--lib/Data/QRCode/Types.pm57
-rw-r--r--t/qrcode.t50
-rw-r--r--t/result.t68
-rw-r--r--typemap6
7 files changed, 271 insertions, 81 deletions
diff --git a/dist.ini b/dist.ini
index 0ba7b75..ba3efb1 100644
--- a/dist.ini
+++ b/dist.ini
@@ -7,8 +7,8 @@ copyright_year = 2016
[GatherDir]
[InlineModule]
-module = Data::QRCode
module = Data::QRCode::Input
+module = Data::QRCode::Result
[PodWeaver]
; authordep Pod::Elemental::Transformer::List
diff --git a/lib/Data/QRCode.pm b/lib/Data/QRCode.pm
index b7f8c4e..74896c9 100644
--- a/lib/Data/QRCode.pm
+++ b/lib/Data/QRCode.pm
@@ -1,59 +1,77 @@
package Data::QRCode;
-use strict;
-use warnings;
+use Moo;
+use Data::QRCode::Input;
+use Data::QRCode::Result;
+use Data::QRCode::Types qw(QRCodeEC QRCodeMode);
+use Types::Standard qw(Str Int);
+use namespace::clean;
# ABSTRACT: qrcodes in C
# VERSION
-use Data::QRCode::Inline with => 'Alien::QREncode';
-use Data::QRCode::Inline C => (
- 'DATA',
- autowrap => 1,
- typemaps => 'typemap',
+
+has error_correction_level => (
+ is => 'ro',
+ isa => QRCodeEC,
+ coerce => 1,
+ default => Data::QRCode::Input::ECLEVEL_M,
);
-sub new {
- my ($class, $input) = @_;
- my $self = QRcode_encodeInput($input);
- bless $self, $class;
- return $self;
-}
+has mode => (
+ is => 'ro',
+ isa => QRCodeMode,
+ coerce => 1,
+ default => Data::QRCode::Input::MODE_8,
+);
-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_at($self,$x,$y);
-
- return {
- color => $value & 0x01,
- in_data => $value & 0x02,
- in_format => $value & 0x04,
- in_version => $value & 0x08,
- in_timing => $value & 0x10,
- in_alignment => $value & 0x20,
- in_finder => $value & 0x40,
- in_misc => $value & 0x80,
- };
-}
+has version => (
+ is => 'rwp',
+ isa => Int,
+ default => 0,
+);
-1;
+has input_data => (
+ is => 'ro',
+ required => 1,
+ isa => Str,
+);
-__DATA__
-__C__
+has _result => (
+ is => 'lazy',
+ init_arg => undef,
+ handles => [ qw(width data_at) ],
+);
-QRcode *QRcode_encodeInput(QRinput *input);
+sub _build__result {
+ my ($self) = @_;
-void DESTROY(QRcode *qrcode) { QRcode_free(qrcode); }
+ my $input = Data::QRCode::Input->new();
+ $input->error_correction_level($self->error_correction_level);
+ $input->version($self->version);
+ $input->append($self->mode,$self->input_data);
-int version(QRcode* self) {
- return self->version;
-}
+ my $ret = Data::QRCode::Result->new($input);
+ $self->_set_version($ret->version);
-int width(QRcode* self) {
- return self->width;
+ return $ret;
}
-int _data_at(QRcode* self, int x, int y) {
- return self->data[x+y*self->width];
+sub map {
+ my ($self,$code) = @_;
+
+ my $r = $self->_result;
+ my @result;
+ for my $y (0..$r->width-1) {
+ push @result,[];
+ for my $x (0..$r->width-1) {
+ # use the internal function to avoid re-checking the x/y
+ # bounds
+ my $raw_data = $r->_data_at($x,$y);
+ my $hash_data = Data::QRCode::Result::_data_hash($raw_data);
+
+ push @{$result[-1]}, $code->($hash_data,$raw_data);
+ }
+ }
+
+ return \@result;
}
+
+1;
diff --git a/lib/Data/QRCode/Result.pm b/lib/Data/QRCode/Result.pm
new file mode 100644
index 0000000..10c79d0
--- /dev/null
+++ b/lib/Data/QRCode/Result.pm
@@ -0,0 +1,63 @@
+package Data::QRCode::Result;
+use strict;
+use warnings;
+# ABSTRACT: qrcodes in C
+# VERSION
+use Data::QRCode::Result::Inline with => 'Alien::QREncode';
+use Data::QRCode::Result::Inline C => (
+ 'DATA',
+ autowrap => 1,
+ typemaps => 'typemap',
+);
+
+sub new {
+ my ($class, $input) = @_;
+ my $self = QRcode_encodeInput($input);
+ bless $self, $class;
+ return $self;
+}
+
+sub _data_hash {
+ my ($value) = @_;
+
+ return {
+ color => $value & 0x01,
+ in_data => $value & 0x02,
+ in_format => $value & 0x04,
+ in_version => $value & 0x08,
+ in_timing => $value & 0x10,
+ in_alignment => $value & 0x20,
+ in_finder => $value & 0x40,
+ in_misc => $value & 0x80,
+ };
+}
+
+sub data_at {
+ my ($self,$x,$y) = @_;
+ my $width = $self->width;
+ if ($x < 0 or $x >= $width or $y < 0 or $y >= $width) {
+ return;
+ }
+ return _data_hash($self->_data_at($x,$y));
+}
+
+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/Types.pm b/lib/Data/QRCode/Types.pm
new file mode 100644
index 0000000..3c5eec7
--- /dev/null
+++ b/lib/Data/QRCode/Types.pm
@@ -0,0 +1,57 @@
+package Data::QRCode::Types;
+use Type::Library
+ -base,
+ -declare => qw( QRCodeEC QRCodeMode );
+use Type::Utils -all;
+use Types::Standard qw(Int Str);
+use Data::QRCode::Input;
+use Carp;
+
+my %letter_for_ec = (
+ Data::QRCode::Input::ECLEVEL_L() => 'L',
+ Data::QRCode::Input::ECLEVEL_M() => 'M',
+ Data::QRCode::Input::ECLEVEL_Q() => 'Q',
+ Data::QRCode::Input::ECLEVEL_H() => 'H',
+);
+my %ec_for_letter = reverse %letter_for_ec;
+
+declare QRCodeEC,
+ as Int,
+ where { $letter_for_ec{$_} },
+ message { Int->validate($_) or "$_ is not a valid raw QR error correction level, acceptable values are @{[ sort keys %letter_for_ec ]}" };
+
+coerce QRCodeEC,
+ from Str,
+ via {
+ return $_ if /^[0-9]+$/;
+ $ec_for_letter{uc($_)}
+ || croak "$_ is not a valid simbolic QR error correction level, acceptable values are @{[ sort keys %ec_for_letter ]}";
+ };
+
+my %name_for_mode = (
+ Data::QRCode::Input::MODE_NUM() => 'NUM',
+ Data::QRCode::Input::MODE_AN() => 'AN',
+ Data::QRCode::Input::MODE_8() => '8BIT',
+ Data::QRCode::Input::MODE_KANJI() => 'KANJI',
+ Data::QRCode::Input::MODE_STRUCTURE() => 'STRUCTURE',
+ Data::QRCode::Input::MODE_ECI() => 'ECI',
+ Data::QRCode::Input::MODE_FNC1FIRST() => 'FNC1FIRST',
+ Data::QRCode::Input::MODE_FNC1SECOND() => 'FNC1SECOND',
+);
+my %mode_for_name = reverse %name_for_mode;
+
+declare QRCodeMode,
+ as Int,
+ where { $name_for_mode{$_} },
+ message { Int->validate($_) or "$_ is not a valid raw QR error data mode, acceptable values are @{[ sort keys %name_for_mode ]}" };
+
+coerce QRCodeMode,
+ from Str,
+ via {
+ return $_ if /^[0-9]+$/;
+ $mode_for_name{uc($_)}
+ || croak "$_ is not a valid simbolic QR data mode, acceptable values are @{[ sort keys %mode_for_name ]}";
+ };
+
+1;
+
diff --git a/t/qrcode.t b/t/qrcode.t
index f82c5ff..14e8bd7 100644
--- a/t/qrcode.t
+++ b/t/qrcode.t
@@ -3,43 +3,27 @@ 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_data => '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_matrix = $qr->map(
+ sub{
+ my ($data) = @_;
+ !$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' :
+ '*';
+ },
);
-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";
-}
+my $text = join "\n", map { join '',@{$_} } @{$text_matrix};
+$text .= "\n";
is($text,<<'QRCODE','data should be as expected');
RRRRRRR F DDD RRRRRRR
diff --git a/t/result.t b/t/result.t
new file mode 100644
index 0000000..c092d19
--- /dev/null
+++ b/t/result.t
@@ -0,0 +1,68 @@
+#!perl
+use strict;
+use warnings;
+use Test2::Bundle::Extended;
+use Data::QRCode::Input;
+use Data::QRCode::Result;
+
+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::Result->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 5011c4f..7dd54dc 100644
--- a/typemap
+++ b/typemap
@@ -9,14 +9,14 @@ QRecLevel T_ENUM
INPUT
T_QRCODE
- if (SvROK($arg) && sv_derived_from($arg, \"Data::QRCode\")) {
+ if (SvROK($arg) && sv_derived_from($arg, \"Data::QRCode::Result\")) {
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\")
+ \"$var\", \"Data::QRCode::Result\")
T_QRINPUT
if (SvROK($arg) && sv_derived_from($arg, \"Data::QRCode::Input\")) {
@@ -31,6 +31,6 @@ T_QRINPUT
OUTPUT
T_QRCODE
- sv_setref_pv($arg, \"Data::QRCode\", (void*)$var);
+ sv_setref_pv($arg, \"Data::QRCode::Result\", (void*)$var);
T_QRINPUT
sv_setref_pv($arg, \"Data::QRCode::Input\", (void*)$var);
generated by cgit v1.2.3 (git 2.25.1) at 2024-04-20 06:56:38 +0000