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