File Coverage

blib/lib/PDF/API2/Resource/XObject/Form/BarCode/int2of5.pm
Criterion Covered Total %
statement 30 30 100.0
branch 2 2 100.0
condition n/a
subroutine 5 5 100.0
pod 1 2 50.0
total 38 39 97.4


line stmt bran cond sub pod time code
1             package PDF::API2::Resource::XObject::Form::BarCode::int2of5;
2              
3 2     2   1007 use base 'PDF::API2::Resource::XObject::Form::BarCode';
  2         4  
  2         229  
4              
5 2     2   15 use strict;
  2         5  
  2         48  
6 2     2   14 use warnings;
  2         4  
  2         790  
7              
8             our $VERSION = '2.045'; # VERSION
9              
10             # Interleaved 2 of 5 Barcodes
11              
12             # Pairs of digits are encoded; the first digit is represented by five
13             # bars, and the second digit is represented by five spaces interleaved
14             # with the bars.
15              
16             sub new {
17 1     1 1 4 my ($class, $pdf, %options) = @_;
18 1         8 my $self = $class->SUPER::new($pdf,%options);
19              
20 1         4 my @bars = $self->encode($options{'-code'});
21              
22 1         25 $self->drawbar([@bars], $options{'caption'});
23              
24 1         7 return $self;
25             }
26              
27             my @bar25interleaved = qw(11221 21112 12112 22111 11212 21211 12211 11122 21121 12121);
28              
29             sub encode {
30 2     2 0 690 my ($self, $string) = @_;
31              
32             # Remove any character that isn't a digit
33 2         8 $string =~ s/[^0-9]//g;
34              
35             # Prepend a 0 if there is an odd number of digits
36 2 100       10 $string = '0' . $string if length($string) % 2;
37              
38             # Start Code
39 2         9 my @bars = ('aaaa');
40              
41             # Encode pairs of digits
42 2         5 my ($c1, $c2, $s1, $s2, $pair);
43 2         8 while (length($string)) {
44 6         20 ($c1, $c2, $string) = split //, $string, 3;
45              
46 6         15 $s1 = $bar25interleaved[$c1];
47 6         14 $s2 = $bar25interleaved[$c2];
48 6         8 $pair = '';
49 6         13 foreach my $i (0 .. 4) {
50 30         47 $pair .= substr($s1, $i, 1);
51 30         46 $pair .= substr($s2, $i, 1);
52             }
53 6         24 push @bars, [$pair, ($c1 . $c2)];
54             }
55              
56             # Stop Code
57 2         5 push @bars, 'baaa';
58              
59 2         9 return @bars;
60             }
61              
62             1;