File Coverage

blib/lib/PDF/Builder/Resource/XObject/Form/BarCode/ean13.pm
Criterion Covered Total %
statement 32 42 76.1
branch 3 8 37.5
condition 1 3 33.3
subroutine 5 6 83.3
pod 1 3 33.3
total 42 62 67.7


line stmt bran cond sub pod time code
1             package PDF::Builder::Resource::XObject::Form::BarCode::ean13;
2              
3 2     2   998 use base 'PDF::Builder::Resource::XObject::Form::BarCode';
  2         4  
  2         303  
4              
5 2     2   17 use strict;
  2         5  
  2         94  
6 2     2   13 use warnings;
  2         6  
  2         1326  
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::ean13 - Specific information for EAN-13 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::ean13->new()
22              
23             =over
24              
25             Create an EAN-13 bar code object. Note that it is invoked from the Builder.pm
26             level method!
27              
28             =back
29              
30             =cut
31              
32             sub new {
33 1     1 1 6 my ($class, $pdf, %options) = @_;
34             # copy dashed option names to preferred undashed names
35 1 50 33     9 if (defined $options{'-code'} && !defined $options{'code'}) { $options{'code'} = delete($options{'-code'}); }
  1         4  
36              
37 1         11 my $self = $class->SUPER::new($pdf, %options);
38              
39 1         5 my @bars = $self->encode($options{'code'});
40              
41 1         32 $self->drawbar([@bars], $options{'caption'});
42              
43 1         16 return $self;
44             }
45              
46             my @ean_code_odd = qw(3211 2221 2122 1411 1132 1231 1114 1312 1213 3112);
47             my @ean_code_even = qw(1123 1222 2212 1141 2311 1321 4111 2131 3121 2113);
48             my @parity = qw(OOOOOO OOEOEE OOEEOE OOEEEO OEOOEE OEEOOE OEEEOO OEOEOE OEOEEO OEEOEO);
49              
50             sub encode {
51 11     11 0 9594 my ($self, $string) = @_;
52              
53 11         53 my @digits = split(//, $string);
54              
55             # The first digit determines the even/odd pattern of the next six
56             # digits, and is printed to the left of the barcode
57 11         26 my $first = shift(@digits);
58 11         32 my @bars = (['07', $first]);
59              
60             # Start Guard
61 11         24 push @bars, 'a1a';
62              
63             # Digits 2-7
64 11         28 foreach my $i (0 .. 5) {
65 66         98 my $digit = shift(@digits);
66 66 100       143 if (substr($parity[$first], $i, 1) eq 'O') {
67 39         105 push @bars, [$ean_code_odd[$digit], $digit];
68             } else {
69 27         57 push @bars, [$ean_code_even[$digit], $digit];
70             }
71             }
72              
73             # Center Guard
74 11         21 push @bars, '1a1a1';
75              
76             # Digits 8-13
77 11         26 for (0..5) {
78 66         90 my $digit = shift @digits;
79 66         133 push @bars, [$ean_code_odd[$digit], $digit];
80             }
81              
82             # Right Guard
83 11         19 push @bars, 'a1a';
84              
85 11         56 return @bars;
86             }
87              
88             sub calculate_check_digit {
89 0     0 0   my ($self, $string) = @_;
90              
91 0           my @digits = split(//, $string);
92 0           my $weight = 1;
93 0           my $checksum = 0;
94 0           foreach my $i (0..11) {
95 0           $checksum += $digits[$i] * $weight;
96 0 0         $weight = $weight == 1? 3: 1;
97             }
98              
99 0           $checksum = $checksum % 10;
100 0 0         return 0 unless $checksum;
101 0           return 10 - $checksum;
102             }
103              
104             1;