File Coverage

blib/lib/PDF/API2/Resource/XObject/Form/BarCode.pm
Criterion Covered Total %
statement 89 109 81.6
branch 11 16 68.7
condition 22 40 55.0
subroutine 9 11 81.8
pod 3 6 50.0
total 134 182 73.6


line stmt bran cond sub pod time code
1             package PDF::API2::Resource::XObject::Form::BarCode;
2              
3 2     2   1015 use base 'PDF::API2::Resource::XObject::Form::Hybrid';
  2         5  
  2         247  
4              
5 2     2   12 use strict;
  2         4  
  2         47  
6 2     2   10 use warnings;
  2         5  
  2         81  
7              
8             our $VERSION = '2.044'; # VERSION
9              
10 2     2   11 use PDF::API2::Util;
  2         4  
  2         296  
11 2     2   16 use PDF::API2::Basic::PDF::Utils;
  2         3  
  2         2528  
12              
13             =head1 NAME
14              
15             PDF::API2::Resource::XObject::Form::BarCode - Base class for one-dimensional barcodes
16              
17             =head1 METHODS
18              
19             =over
20              
21             =item $barcode = PDF::API2::Resource::XObject::Form::BarCode->new($pdf, %options)
22              
23             Creates a barcode form resource.
24              
25             =cut
26              
27             sub new {
28 6     6 1 21 my ($class, $pdf, %options) = @_;
29 6         27 my $self = $class->SUPER::new($pdf);
30              
31 6         17 $self->{' bfont'} = $options{'-font'};
32              
33 6   50     26 $self->{' umzn'} = $options{'-umzn'} || 0; # (u)pper (m)ending (z)o(n)e
34 6   100     20 $self->{' lmzn'} = $options{'-lmzn'} || 0; # (l)ower (m)ending (z)o(n)e
35 6   100     31 $self->{' zone'} = $options{'-zone'} || 0; # barcode height
36 6   50     20 $self->{' quzn'} = $options{'-quzn'} || 0; # (qu)iet (z)o(n)e
37 6   50     28 $self->{' ofwt'} = $options{'-ofwt'} || 0.01; # (o)ver(f)low (w)id(t)h
38 6         14 $self->{' fnsz'} = $options{'-fnsz'}; # (f)o(n)t(s)i(z)e
39 6   50     22 $self->{' spcr'} = $options{'-spcr'} || ''; # (sp)a(c)e(r) between chars in label
40 6   50     20 $self->{' mils'} = $options{'-mils'} || 1000/72; # single barcode unit width. 1 mil = 1/1000 of one inch. 1000/72 - for backward compatibility
41 6   50     22 $self->{' color'} = $options{'-color'} || 'black'; # barcode color
42              
43 6         21 return $self;
44             }
45              
46             my %bar_widths = (
47             0 => 0,
48             1 => 1, 'a' => 1, 'A' => 1,
49             2 => 2, 'b' => 2, 'B' => 2,
50             3 => 3, 'c' => 3, 'C' => 3,
51             4 => 4, 'd' => 4, 'D' => 4,
52             5 => 5, 'e' => 5, 'E' => 5,
53             6 => 6, 'f' => 6, 'F' => 6,
54             7 => 7, 'g' => 7, 'G' => 7,
55             8 => 8, 'h' => 8, 'H' => 8,
56             9 => 9, 'i' => 9, 'I' => 9,
57             );
58              
59             sub encode {
60 2     2 0 2029 my ($self, $string) = @_;
61 2         9 my @bars = map { [ $self->encode_string($_), $_ ] } split //, $string;
  17         35  
62 2         17 return @bars;
63             }
64              
65             sub encode_string {
66 17     17 0 29 my ($self, $string) = @_;
67              
68 17         23 my $bar;
69 17         36 foreach my $character (split //, $string) {
70 17         39 $bar .= $self->encode_char($character);
71             }
72 17         59 return $bar;
73             }
74              
75             sub drawbar {
76 6     6 0 14 my $self = shift();
77 6         11 my @sets = @{shift()};
  6         16  
78 6         17 my $caption = shift();
79              
80 6         44 $self->fillcolor($self->{' color'});
81 6         39 $self->strokecolor($self->{' color'});
82 6         40 $self->linedash();
83              
84 6         10 my $x = $self->{' quzn'};
85 6         12 my $is_space_next = 0;
86 6         19 my $wdt_factor = $self->{' mils'} / 1000 * 72;
87 6         16 foreach my $set (@sets) {
88 30         47 my ($code, $label);
89 30 100       61 if (ref($set)) {
90 18         28 ($code, $label) = @{$set};
  18         39  
91             }
92             else {
93 12         22 $code = $set;
94 12         18 $label = undef;
95             }
96              
97 30         50 my $code_width = 0;
98 30         41 my ($font_size, $y_label);
99 30         103 foreach my $bar (split //, $code) {
100 172         317 my $bar_width = $bar_widths{$bar} * $wdt_factor;
101              
102 172         247 my ($y0, $y1);
103 172 100       488 if ($bar =~ /[0-9]/) {
    50          
    0          
104 115         209 $y0 = $self->{' quzn'} + $self->{' lmzn'};
105 115         198 $y1 = $self->{' quzn'} + $self->{' lmzn'} + $self->{' zone'} + $self->{' umzn'};
106 115         161 $y_label = $self->{' quzn'};
107 115 50 66     256 if ($self->{' fnsz'} and $self->{' lmzn'} < $self->{' fnsz'}) {
108 0         0 $y_label -= $self->{' fnsz'} * 0.8 - $self->{' lmzn'};
109             }
110 115   66     329 $font_size = $self->{' fnsz'} || $self->{' lmzn'};
111             }
112             elsif ($bar =~ /[a-z]/) {
113 57         97 $y0 = $self->{' quzn'};
114 57         103 $y1 = $self->{' quzn'} + $self->{' lmzn'} + $self->{' zone'} + $self->{' umzn'};
115 57         111 $y_label = $self->{' quzn'} + $self->{' lmzn'} + $self->{' zone'} + $self->{' umzn'} + 2;
116 57   66     187 $font_size = $self->{' fnsz'} || $self->{' umzn'};
117             }
118             elsif ($bar =~ /[A-Z]/) {
119 0         0 $y0 = $self->{' quzn'};
120 0         0 $y1 = $self->{' quzn'} + $self->{' lmzn'} + $self->{' zone'};
121 0   0     0 $font_size = $self->{' fnsz'} || $self->{' umzn'};
122 0         0 $y_label = $self->{' quzn'} + $self->{' lmzn'} + $self->{' zone'} + $self->{' umzn'} - $font_size;
123             }
124             else {
125 0         0 $y0 = $self->{' quzn'} + $self->{' lmzn'};
126 0         0 $y1 = $self->{' quzn'} + $self->{' lmzn'} + $self->{' zone'} + $self->{' umzn'};
127 0         0 $y_label = $self->{' quzn'};
128 0   0     0 $font_size = $self->{' fnsz'} || $self->{' lmzn'};
129             }
130              
131 172 100 100     439 unless ($is_space_next or $bar eq '0') {
132 86         322 $self->linewidth($bar_width - $self->{' ofwt'});
133 86         354 $self->move($x + $code_width + $bar_width / 2, $y0);
134 86         335 $self->line($x + $code_width + $bar_width / 2, $y1);
135 86         224 $self->stroke();
136             }
137 172         302 $is_space_next = not $is_space_next;
138              
139 172         314 $code_width += $bar_width;
140             }
141              
142 30 100 100     114 if (defined($label) and $self->{' lmzn'}) {
143 1         6 $label = join($self->{' spcr'}, split //, $label);
144 1         21 $self->textstart();
145 1         12 $self->translate($x + ($code_width / 2), $y_label);
146 1         10 $self->font($self->{' bfont'}, $font_size);
147 1         10 $self->text_center($label);
148 1         8 $self->textend();
149             }
150              
151 30         61 $x += $code_width;
152             }
153              
154 6         13 $x += $self->{' quzn'};
155              
156 6 50       15 if (defined $caption) {
157 0   0     0 my $font_size = $self->{' fnsz'} || $self->{' lmzn'};
158 0         0 my $y_caption = $self->{' quzn'} - $font_size;
159 0         0 $self->textstart();
160 0         0 $self->translate($x / 2, $y_caption);
161 0         0 $self->font($self->{' bfont'}, $font_size);
162 0         0 $self->text_center($caption);
163 0         0 $self->textend();
164             }
165              
166 6         12 $self->{' w'} = $x;
167 6         21 $self->{' h'} = 2 * $self->{' quzn'} + $self->{' lmzn'} + $self->{' zone'} + $self->{' umzn'};
168 6         69 $self->bbox(0, 0, $self->{' w'}, $self->{' h'});
169             }
170              
171             =item $width = $barcode->width()
172              
173             =cut
174              
175             sub width {
176 0     0 1   my $self = shift();
177 0           return $self->{' w'};
178             }
179              
180             =item $height = $barcode->height()
181              
182             =cut
183              
184             sub height {
185 0     0 1   my $self = shift();
186 0           return $self->{' h'};
187             }
188              
189             =back
190              
191             =cut
192              
193             1;