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   1139 use base 'PDF::API2::Resource::XObject::Form::Hybrid';
  2         5  
  2         243  
4              
5 2     2   14 use strict;
  2         4  
  2         41  
6 2     2   9 use warnings;
  2         4  
  2         83  
7              
8             our $VERSION = '2.043'; # VERSION
9              
10 2     2   11 use PDF::API2::Util;
  2         5  
  2         325  
11 2     2   14 use PDF::API2::Basic::PDF::Utils;
  2         5  
  2         2584  
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 20 my ($class, $pdf, %options) = @_;
29 6         26 my $self = $class->SUPER::new($pdf);
30              
31 6         16 $self->{' bfont'} = $options{'-font'};
32              
33 6   50     32 $self->{' umzn'} = $options{'-umzn'} || 0; # (u)pper (m)ending (z)o(n)e
34 6   100     22 $self->{' lmzn'} = $options{'-lmzn'} || 0; # (l)ower (m)ending (z)o(n)e
35 6   100     26 $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     19 $self->{' ofwt'} = $options{'-ofwt'} || 0.01; # (o)ver(f)low (w)id(t)h
38 6         10 $self->{' fnsz'} = $options{'-fnsz'}; # (f)o(n)t(s)i(z)e
39 6   50     21 $self->{' spcr'} = $options{'-spcr'} || ''; # (sp)a(c)e(r) between chars in label
40 6   50     18 $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     21 $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 2006 my ($self, $string) = @_;
61 2         10 my @bars = map { [ $self->encode_string($_), $_ ] } split //, $string;
  17         33  
62 2         13 return @bars;
63             }
64              
65             sub encode_string {
66 17     17 0 35 my ($self, $string) = @_;
67              
68 17         19 my $bar;
69 17         39 foreach my $character (split //, $string) {
70 17         37 $bar .= $self->encode_char($character);
71             }
72 17         52 return $bar;
73             }
74              
75             sub drawbar {
76 6     6 0 11 my $self = shift();
77 6         9 my @sets = @{shift()};
  6         15  
78 6         19 my $caption = shift();
79              
80 6         38 $self->fillcolor($self->{' color'});
81 6         38 $self->strokecolor($self->{' color'});
82 6         40 $self->linedash();
83              
84 6         12 my $x = $self->{' quzn'};
85 6         24 my $is_space_next = 0;
86 6         18 my $wdt_factor = $self->{' mils'} / 1000 * 72;
87 6         14 foreach my $set (@sets) {
88 30         49 my ($code, $label);
89 30 100       68 if (ref($set)) {
90 18         26 ($code, $label) = @{$set};
  18         44  
91             }
92             else {
93 12         17 $code = $set;
94 12         22 $label = undef;
95             }
96              
97 30         42 my $code_width = 0;
98 30         47 my ($font_size, $y_label);
99 30         97 foreach my $bar (split //, $code) {
100 172         317 my $bar_width = $bar_widths{$bar} * $wdt_factor;
101              
102 172         270 my ($y0, $y1);
103 172 100       494 if ($bar =~ /[0-9]/) {
    50          
    0          
104 115         207 $y0 = $self->{' quzn'} + $self->{' lmzn'};
105 115         186 $y1 = $self->{' quzn'} + $self->{' lmzn'} + $self->{' zone'} + $self->{' umzn'};
106 115         170 $y_label = $self->{' quzn'};
107 115 50 66     274 if ($self->{' fnsz'} and $self->{' lmzn'} < $self->{' fnsz'}) {
108 0         0 $y_label -= $self->{' fnsz'} * 0.8 - $self->{' lmzn'};
109             }
110 115   66     304 $font_size = $self->{' fnsz'} || $self->{' lmzn'};
111             }
112             elsif ($bar =~ /[a-z]/) {
113 57         102 $y0 = $self->{' quzn'};
114 57         96 $y1 = $self->{' quzn'} + $self->{' lmzn'} + $self->{' zone'} + $self->{' umzn'};
115 57         104 $y_label = $self->{' quzn'} + $self->{' lmzn'} + $self->{' zone'} + $self->{' umzn'} + 2;
116 57   66     154 $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     429 unless ($is_space_next or $bar eq '0') {
132 86         321 $self->linewidth($bar_width - $self->{' ofwt'});
133 86         322 $self->move($x + $code_width + $bar_width / 2, $y0);
134 86         338 $self->line($x + $code_width + $bar_width / 2, $y1);
135 86         228 $self->stroke();
136             }
137 172         265 $is_space_next = not $is_space_next;
138              
139 172         306 $code_width += $bar_width;
140             }
141              
142 30 100 100     107 if (defined($label) and $self->{' lmzn'}) {
143 1         14 $label = join($self->{' spcr'}, split //, $label);
144 1         15 $self->textstart();
145 1         18 $self->translate($x + ($code_width / 2), $y_label);
146 1         10 $self->font($self->{' bfont'}, $font_size);
147 1         9 $self->text_center($label);
148 1         8 $self->textend();
149             }
150              
151 30         59 $x += $code_width;
152             }
153              
154 6         30 $x += $self->{' quzn'};
155              
156 6 50       14 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         21 $self->{' w'} = $x;
167 6         41 $self->{' h'} = 2 * $self->{' quzn'} + $self->{' lmzn'} + $self->{' zone'} + $self->{' umzn'};
168 6         52 $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;