File Coverage

blib/lib/PDF/Builder/Resource/XObject/Form/BarCode/codabar.pm
Criterion Covered Total %
statement 19 19 100.0
branch 1 2 50.0
condition 1 3 33.3
subroutine 5 5 100.0
pod 1 2 50.0
total 27 31 87.1


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;