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__ |