File Coverage

blib/lib/PDF/Builder/Resource/XObject/Form/BarCode/code3of9.pm
Criterion Covered Total %
statement 46 48 95.8
branch 9 14 64.2
condition 3 9 33.3
subroutine 7 7 100.0
pod 1 4 25.0
total 66 82 80.4


line stmt bran cond sub pod time code
1             package PDF::Builder::Resource::XObject::Form::BarCode::code3of9;
2              
3 2     2   1396 use base 'PDF::Builder::Resource::XObject::Form::BarCode';
  2         6  
  2         234  
4              
5 2     2   14 use strict;
  2         6  
  2         44  
6 2     2   10 use warnings;
  2         4  
  2         1772  
7              
8             our $VERSION = '3.025'; # VERSION
9             our $LAST_UPDATE = '3.024'; # manually update whenever code is changed
10              
11             =head1 NAME
12              
13             PDF::Builder::Resource::XObject::Form::BarCode::code3of9 - specific information for 3-of-9 bar codes. Inherits from L
14              
15             =cut
16              
17             sub new {
18 2     2 1 11 my ($class, $pdf, %options) = @_;
19             # copy dashed option names to preferred undashed names
20 2 50 33     15 if (defined $options{'-code'} && !defined $options{'code'}) { $options{'code'} = delete($options{'-code'}); }
  2         7  
21 2 50 33     7 if (defined $options{'-chk'} && !defined $options{'chk'}) { $options{'chk'} = delete($options{'-chk'}); }
  0         0  
22 2 50 33     8 if (defined $options{'-ext'} && !defined $options{'ext'}) { $options{'ext'} = delete($options{'-ext'}); }
  0         0  
23              
24 2         17 my $self = $class->SUPER::new($pdf, %options);
25             my @bars = encode_3of9($options{'code'},
26             $options{'chk'}? 1: 0,
27 2 50       15 $options{'ext'}? 1: 0);
    50          
28              
29 2         19 $self->drawbar([@bars], $options{'caption'});
30              
31 2         45 return $self;
32             }
33              
34             # allowed alphabet and bar widths
35             my $code3of9 = q(0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-. $/+%*);
36              
37             my @bar3of9 = qw(
38             1112212111 2112111121 1122111121 2122111111
39             1112211121 2112211111 1122211111 1112112121
40             2112112111 1122112111 2111121121 1121121121
41             2121121111 1111221121 2111221111 1121221111
42             1111122121 2111122111 1121122111 1111222111
43             2111111221 1121111221 2121111211 1111211221
44             2111211211 1121211211 1111112221 2111112211
45             1121112211 1111212211 2211111121 1221111121
46             2221111111 1211211121 2211211111 1221211111
47             1211112121 2211112111 1221112111 1212121111
48             1212111211 1211121211 1112121211 abaababaa1
49             );
50              
51             my @extended_map = (
52             '%U', '$A', '$B', '$C', '$D', '$E', '$F', '$G', '$H', '$I',
53             '$J', '$K', '$L', '$M', '$N', '$O', '$P', '$Q', '$R', '$S',
54             '$T', '$U', '$V', '$W', '$X', '$Y', '$Z', '%A', '%B', '%C',
55             '%D', '$E', ' ', '/A', '/B', '/C', '/D', '/E', '/F', '/G',
56             '/H', '/I', '/J', '/K', '/L', '-', '.', '/O', '0', '1',
57             '2', '3', '4', '5', '6', '7', '8', '9', '/Z', '%F',
58             '%G', '%H', '%I', '%J', '%V', 'A', 'B', 'C', 'D', 'E',
59             'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O',
60             'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y',
61             'Z', '%K', '%L', '%M', '%N', '%O', '%W', '+A', '+B', '+C',
62             '+D', '+E', '+F', '+G', '+H', '+I', '+J', '+K', '+L', '+M',
63             '+N', '+O', '+P', '+Q', '+R', '+S', '+T', '+U', '+V', '+W',
64             '+X', '+Y', '+Z', '%P', '%Q', '%R', '%S', '%T'
65             );
66              
67             sub encode_3of9_char {
68 36     36 0 60 my $character = shift;
69            
70 36         82 return $bar3of9[index($code3of9, $character)];
71             }
72              
73             sub encode_3of9_string {
74 6     6 0 13 my ($string, $is_mod43) = @_;
75              
76 6         12 my $bar;
77 6         11 my $checksum = 0;
78 6         21 foreach my $char (split //, $string) {
79 24         39 $bar .= encode_3of9_char($char);
80 24         50 $checksum += index($code3of9, $char);
81             }
82              
83 6 100       19 if ($is_mod43) {
84 2         4 $checksum %= 43;
85 2         8 $bar .= $bar3of9[$checksum];
86             }
87              
88 6         19 return $bar;
89             }
90              
91             # Note: encode_3of9_string_w_chk now encode_3of9_string(*, 1)
92              
93             sub encode_3of9 {
94 6     6 0 2689 my ($string, $is_mod43, $is_extended) = @_;
95              
96 6         13 my $display;
97 6 100       20 unless ($is_extended) {
98 4         12 $string = uc($string);
99 4         15 $string =~ s/[^0-9A-Z\-\.\ \$\/\+\%]+//g;
100 4         9 $display = $string;
101             } else {
102             # Extended Code39 supports all 7-bit ASCII characters
103 2         11 $string =~ s/[^\x00-\x7f]//g;
104 2         5 $display = $string;
105              
106             # Encode, but don't display, non-printable characters
107 2         5 $display =~ s/[[:cntrl:]]//g;
108              
109 2         8 $string = join('', map { $extended_map[ord($_)] } split(//, $string));
  8         22  
110             }
111              
112 6         14 my @bars;
113 6         14 push @bars, encode_3of9_char('*');
114 6         17 push @bars, [ encode_3of9_string($string, $is_mod43), $display ];
115 6         15 push @bars, encode_3of9_char('*');
116              
117 6         22 return @bars;
118             }
119              
120             # Note: encode_3of9_w_chk now encode_3of9(*, 1, 0)
121             # Note: encode_3of9_ext now encode_3of9(*, 0, 1)
122             # Note: encode_3of9_ext_w_chk now encode_3of9(*, 1, 1)
123              
124             1;