lib/Data/QRCode.pm


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86

package Data::QRCode; 
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 
 
has error_correction_level => (
    is => 'ro',
    isa => QRCodeEC,
    coerce => 1,
    default => Data::QRCode::Input::ECLEVEL_M,
);
 
has mode => (
    is => 'ro',
    isa => QRCodeMode,
    coerce => 1,
    default => Data::QRCode::Input::MODE_8,
);
 
has version => (
    is => 'rwp',
    isa => Int,
    default => 0,
);
 
has input_data => (
    is => 'ro',
    required => 1,
    isa => Str,
);
 
around BUILDARGS => sub {
    my ($orig,$class,@args) = @_;
 
    return { input_data => $args[0] }
        if @args == 1 && !ref $args[0];
 
    return $class->$orig(@args);
};
 
has _result => (
    is => 'lazy',
    init_arg => undef,
    handles => [ qw(width data_at) ],
);
 
sub _build__result {
    my ($self) = @_;
 
    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);
 
    my $ret = Data::QRCode::Result->new($input);
    $self->_set_version($ret->version);
 
    return $ret;
}
 
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;