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 --- lib/Data/QRCode.pm | 106 +++++++++++++++++++++++++++------------------- lib/Data/QRCode/Result.pm | 63 +++++++++++++++++++++++++++ lib/Data/QRCode/Types.pm | 57 +++++++++++++++++++++++++ 3 files changed, 182 insertions(+), 44 deletions(-) create mode 100644 lib/Data/QRCode/Result.pm create mode 100644 lib/Data/QRCode/Types.pm (limited to 'lib') 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; + -- cgit v1.2.3