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   1073 use base 'PDF::Builder::Resource::XObject::Form::BarCode';
  2         5  
  2         916  
4              
5 2     2   15 use strict;
  2         4  
  2         70  
6 2     2   8 use warnings;
  2         3  
  2         591  
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::codabar - Specific information for CodaBar 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::codabar->new()
22              
23             =over
24              
25             Create a Codabar bar code object. Note that it is invoked from the Builder.pm
26             level method!
27              
28             =back
29              
30             =cut
31              
32             # TBD document code, caption options
33              
34             sub new {
35 1     1 1 5 my ($class, $pdf, %options) = @_;
36             # copy dashed option names to preferred undashed names
37 1 50 33     11 if (defined $options{'-code'} && !defined $options{'code'}) { $options{'code'} = delete($options{'-code'}); }
  1         3  
38              
39 1         10 my $self = $class->SUPER::new($pdf, %options);
40              
41 1         9 my @bars = $self->encode($options{'code'});
42              
43 1         8 $self->drawbar([@bars], $options{'caption'});
44              
45 1         7 return $self;
46             }
47              
48             # allowed alphabet and translation to bar widths
49             my $codabar = q|0123456789-$:/.+ABCD|;
50              
51             my @barcodabar = qw(
52             11111221 11112211 11121121 22111111 11211211
53             21111211 12111121 12112111 12211111 21121111
54             11122111 11221111 21112121 21211121 21212111
55             11212121 aabbabaa ababaaba ababaaba aaabbbaa
56             );
57              
58             sub encode_char {
59 17     17 0 28 my $self = shift;
60 17         22 my $char = uc(shift());
61              
62 17         35 return $barcodabar[index($codabar, $char)];
63             }
64              
65             1;