File Coverage

blib/lib/PDF/Builder/Resource/XObject/Form/BarCode.pm
Criterion Covered Total %
statement 89 108 82.4
branch 10 14 71.4
condition 20 37 54.0
subroutine 9 11 81.8
pod 3 6 50.0
total 131 176 74.4


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