line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package PDF::Builder::Resource::XObject::Form::BarCode::codabar; |
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
863
|
use base 'PDF::Builder::Resource::XObject::Form::BarCode'; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
547
|
|
4
|
|
|
|
|
|
|
|
5
|
2
|
|
|
2
|
|
13
|
use strict; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
33
|
|
6
|
2
|
|
|
2
|
|
8
|
use warnings; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
380
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
our $VERSION = '3.024'; # 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::codabar - specific information for CodaBar bar codes. Inherits from L |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
=cut |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
# TBD document code, caption options |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
sub new { |
20
|
1
|
|
|
1
|
1
|
4
|
my ($class, $pdf, %options) = @_; |
21
|
|
|
|
|
|
|
# copy dashed option names to preferred undashed names |
22
|
1
|
50
|
33
|
|
|
7
|
if (defined $options{'-code'} && !defined $options{'code'}) { $options{'code'} = delete($options{'-code'}); } |
|
1
|
|
|
|
|
3
|
|
23
|
|
|
|
|
|
|
|
24
|
1
|
|
|
|
|
7
|
my $self = $class->SUPER::new($pdf, %options); |
25
|
|
|
|
|
|
|
|
26
|
1
|
|
|
|
|
6
|
my @bars = $self->encode($options{'code'}); |
27
|
|
|
|
|
|
|
|
28
|
1
|
|
|
|
|
8
|
$self->drawbar([@bars], $options{'caption'}); |
29
|
|
|
|
|
|
|
|
30
|
1
|
|
|
|
|
5
|
return $self; |
31
|
|
|
|
|
|
|
} |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
# allowed alphabet and translation to bar widths |
34
|
|
|
|
|
|
|
my $codabar = q|0123456789-$:/.+ABCD|; |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
my @barcodabar = qw( |
37
|
|
|
|
|
|
|
11111221 11112211 11121121 22111111 11211211 |
38
|
|
|
|
|
|
|
21111211 12111121 12112111 12211111 21121111 |
39
|
|
|
|
|
|
|
11122111 11221111 21112121 21211121 21212111 |
40
|
|
|
|
|
|
|
11212121 aabbabaa ababaaba ababaaba aaabbbaa |
41
|
|
|
|
|
|
|
); |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
sub encode_char { |
44
|
17
|
|
|
17
|
0
|
22
|
my $self = shift; |
45
|
17
|
|
|
|
|
26
|
my $char = uc(shift()); |
46
|
|
|
|
|
|
|
|
47
|
17
|
|
|
|
|
50
|
return $barcodabar[index($codabar, $char)]; |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
1; |