File Coverage

blib/lib/PDF/Builder/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::Builder::Resource::XObject::Form::BarCode::int2of5;
2              
3 2     2   1036 use base 'PDF::Builder::Resource::XObject::Form::BarCode';
  2         5  
  2         257  
4              
5 2     2   15 use strict;
  2         4  
  2         56  
6 2     2   10 use warnings;
  2         4  
  2         800  
7              
8             our $VERSION = '3.023'; # VERSION
9             our $LAST_UPDATE = '3.004'; # 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              
26 1         8 my $self = $class->SUPER::new($pdf,%options);
27              
28 1         4 my @bars = $self->encode($options{'-code'});
29              
30 1         8 $self->drawbar([@bars], $options{'caption'});
31              
32 1         10 return $self;
33             }
34              
35             my @bar25interleaved = qw(11221 21112 12112 22111 11212 21211 12211 11122 21121 12121);
36              
37             sub encode {
38 2     2 0 488 my ($self, $string) = @_;
39              
40             # Remove any character that isn't a digit
41 2         9 $string =~ s/[^0-9]//g;
42              
43             # Prepend a 0 if there are an odd number of digits
44 2 100       11 $string = '0' . $string if length($string) % 2;
45              
46             # Start Code
47 2         6 my @bars = ('aaaa');
48              
49             # Encode pairs of digits
50 2         5 my ($c1, $c2, $s1, $s2, $pair);
51 2         7 while (length($string)) {
52 6         17 ($c1, $c2, $string) = split(//, $string, 3);
53              
54 6         14 $s1 = $bar25interleaved[$c1];
55 6         9 $s2 = $bar25interleaved[$c2];
56 6         9 $pair = '';
57 6         15 foreach my $i (0 .. 4) {
58 30         36 $pair .= substr($s1, $i, 1);
59 30         42 $pair .= substr($s2, $i, 1);
60             }
61 6         19 push @bars, [$pair, ($c1 . $c2)];
62             }
63              
64             # Stop Code
65 2         4 push @bars, 'baaa';
66              
67 2         7 return @bars;
68             }
69              
70             1;