File Coverage

blib/lib/PDF/Builder/Resource/XObject/Form/BarCode/int2of5.pm
Criterion Covered Total %
statement 32 32 100.0
branch 3 4 75.0
condition 1 3 33.3
subroutine 5 5 100.0
pod 1 2 50.0
total 42 46 91.3


line stmt bran cond sub pod time code
1             package PDF::Builder::Resource::XObject::Form::BarCode::int2of5;
2              
3 2     2   850 use base 'PDF::Builder::Resource::XObject::Form::BarCode';
  2         4  
  2         180  
4              
5 2     2   16 use strict;
  2         4  
  2         34  
6 2     2   8 use warnings;
  2         4  
  2         727  
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::int2of5 - specific information for int 2-of-5 bar codes. Inherits from L
14              
15             =cut
16              
17             # Interleaved 2 of 5 Barcodes
18              
19             # Pairs of digits are encoded; the first digit is represented by five
20             # bars, and the second digit is represented by five spaces interleaved
21             # with the bars.
22              
23             sub new {
24 1     1 1 4 my ($class, $pdf, %options) = @_;
25             # copy dashed option names to preferred undashed names
26 1 50 33     6 if (defined $options{'-code'} && !defined $options{'code'}) { $options{'code'} = delete($options{'-code'}); }
  1         2  
27              
28 1         8 my $self = $class->SUPER::new($pdf,%options);
29              
30 1         3 my @bars = $self->encode($options{'code'});
31              
32 1         9 $self->drawbar([@bars], $options{'caption'});
33              
34 1         5 return $self;
35             }
36              
37             my @bar25interleaved = qw(11221 21112 12112 22111 11212 21211 12211 11122 21121 12121);
38              
39             sub encode {
40 2     2 0 470 my ($self, $string) = @_;
41              
42             # Remove any character that isn't a digit
43 2         8 $string =~ s/[^0-9]//g;
44              
45             # Prepend a 0 if there are an odd number of digits
46 2 100       9 $string = '0' . $string if length($string) % 2;
47              
48             # Start Code
49 2         5 my @bars = ('aaaa');
50              
51             # Encode pairs of digits
52 2         4 my ($c1, $c2, $s1, $s2, $pair);
53 2         7 while (length($string)) {
54 6         18 ($c1, $c2, $string) = split(//, $string, 3);
55              
56 6         10 $s1 = $bar25interleaved[$c1];
57 6         11 $s2 = $bar25interleaved[$c2];
58 6         7 $pair = '';
59 6         33 foreach my $i (0 .. 4) {
60 30         36 $pair .= substr($s1, $i, 1);
61 30         44 $pair .= substr($s2, $i, 1);
62             }
63 6         35 push @bars, [$pair, ($c1 . $c2)];
64             }
65              
66             # Stop Code
67 2         7 push @bars, 'baaa';
68              
69 2         16 return @bars;
70             }
71              
72             1;