From 3db58a4fe8a121093bc5c5287eb808f71de87441 Mon Sep 17 00:00:00 2001 From: dakkar Date: Thu, 10 Nov 2016 14:26:47 +0000 Subject: move QRcode* to ::Result, wrap in Moo --- dist.ini | 2 +- lib/Data/QRCode.pm | 106 +++++++++++++++++++++++++++------------------- lib/Data/QRCode/Result.pm | 63 +++++++++++++++++++++++++++ lib/Data/QRCode/Types.pm | 57 +++++++++++++++++++++++++ t/qrcode.t | 50 ++++++++-------------- t/result.t | 68 +++++++++++++++++++++++++++++ typemap | 6 +-- 7 files changed, 271 insertions(+), 81 deletions(-) create mode 100644 lib/Data/QRCode/Result.pm create mode 100644 lib/Data/QRCode/Types.pm create mode 100644 t/result.t 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); -- cgit v1.2.3