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