File Coverage

blib/lib/PDF/API2/Resource/XObject/Form/BarCode/qrcode.pm
Criterion Covered Total %
statement 12 45 26.6
branch 0 10 0.0
condition 0 8 0.0
subroutine 4 6 66.6
pod 2 2 100.0
total 18 71 25.3


line stmt bran cond sub pod time code
1             package PDF::API2::Resource::XObject::Form::BarCode::qrcode;
2              
3 1     1   1520 use base 'PDF::API2::Resource::XObject::Form::BarCode';
  1         3  
  1         107  
4              
5 1     1   6 use strict;
  1         3  
  1         19  
6 1     1   5 use warnings;
  1         2  
  1         39  
7              
8             our $VERSION = '2.044'; # VERSION
9              
10 1     1   5 use Carp;
  1         2  
  1         618  
11              
12             our @CARP_NOT = qw(PDF::API2);
13              
14             sub new {
15 0     0 1   my ($class, $pdf, %options) = @_;
16 0           my $self = $class->SUPER::new($pdf, %options);
17              
18 0           eval {
19 0           require Text::QRCode;
20             };
21 0 0         if ($@) {
22 0           croak "Error loading Text::QRCode: $@";
23             }
24              
25 0   0       my $mode = $options{'mode'} // '8-bit';
26 0 0         $mode = 'numerical' if $mode eq 'numeric';
27 0 0         $mode = 'alpha-numerical' if $mode eq 'alphanumeric';
28 0 0         $mode = 'alpha-numerical' if $mode eq 'alpha-numeric';
29              
30             my $generator = Text::QRCode->new(
31             level => ($options{'error_correction'} // 'L'),
32             version => ($options{'version'} // 0),
33             mode => $mode,
34 0   0       casesensitive => ($options{'case_sensitive'} // 1),
      0        
      0        
35             );
36              
37 0           my $lines_ref = $generator->plot($options{'code'});
38 0           my @lines = reverse map { join('', @$_) } @$lines_ref;
  0            
39              
40 0           $self->render(@lines);
41 0           return $self;
42             }
43              
44             sub render {
45 0     0 1   my ($self, @lines) = @_;
46              
47 0           $self->fillcolor($self->{' color'});
48              
49 0           my $y = $self->{' quzn'};
50 0           my $w = $self->{' mils'} / 1000 * 72;
51 0           my $h = $self->{' zone'};
52 0           foreach my $line (@lines) {
53 0           my $x = $self->{' quzn'};
54 0           foreach my $char (split m//, $line) {
55 0 0         if ($char eq '*') {
56 0           $self->rectangle($x, $y, $x + $w, $y + $h);
57 0           $self->fill();
58             }
59 0           $x += $w;
60             }
61 0           $y += $h;
62             }
63              
64 0           $self->{' w'} = 2 * $self->{' quzn'} + length($lines[0]) * $w;
65 0           $self->{' h'} = 2 * $self->{' quzn'} + length($lines[0]) * $h;
66 0           $self->bbox(0, 0, $self->{' w'}, $self->{' h'});
67              
68 0           return $self;
69             }
70              
71             1;
72              
73             __END__