File Coverage

blib/lib/PDF/Builder/Resource/XObject/Form/BarCode/ean13.pm
Criterion Covered Total %
statement 30 40 75.0
branch 2 6 33.3
condition n/a
subroutine 5 6 83.3
pod 1 3 33.3
total 38 55 69.0


line stmt bran cond sub pod time code
1             package PDF::Builder::Resource::XObject::Form::BarCode::ean13;
2              
3 2     2   1064 use base 'PDF::Builder::Resource::XObject::Form::BarCode';
  2         6  
  2         260  
4              
5 2     2   14 use strict;
  2         4  
  2         54  
6 2     2   11 use warnings;
  2         6  
  2         1044  
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::ean13 - specific information for EAN-13 bar codes. Inherits from L
14              
15             =cut
16              
17             sub new {
18 1     1 1 5 my ($class, $pdf, %options) = @_;
19              
20 1         11 my $self = $class->SUPER::new($pdf, %options);
21              
22 1         3 my @bars = $self->encode($options{'-code'});
23              
24 1         10 $self->drawbar([@bars], $options{'caption'});
25              
26 1         19 return $self;
27             }
28              
29             my @ean_code_odd = qw(3211 2221 2122 1411 1132 1231 1114 1312 1213 3112);
30             my @ean_code_even = qw(1123 1222 2212 1141 2311 1321 4111 2131 3121 2113);
31             my @parity = qw(OOOOOO OOEOEE OOEEOE OOEEEO OEOOEE OEEOOE OEEEOO OEOEOE OEOEEO OEEOEO);
32              
33             sub encode {
34 11     11 0 5189 my ($self, $string) = @_;
35              
36 11         57 my @digits = split(//, $string);
37              
38             # The first digit determines the even/odd pattern of the next six
39             # digits, and is printed to the left of the barcode
40 11         25 my $first = shift(@digits);
41 11         29 my @bars = (['07', $first]);
42              
43             # Start Guard
44 11         20 push @bars, 'a1a';
45              
46             # Digits 2-7
47 11         23 foreach my $i (0 .. 5) {
48 66         100 my $digit = shift(@digits);
49 66 100       118 if (substr($parity[$first], $i, 1) eq 'O') {
50 39         85 push @bars, [$ean_code_odd[$digit], $digit];
51             } else {
52 27         58 push @bars, [$ean_code_even[$digit], $digit];
53             }
54             }
55              
56             # Center Guard
57 11         17 push @bars, '1a1a1';
58              
59             # Digits 8-13
60 11         35 for (0..5) {
61 66         89 my $digit = shift @digits;
62 66         130 push @bars, [$ean_code_odd[$digit], $digit];
63             }
64              
65             # Right Guard
66 11         18 push @bars, 'a1a';
67              
68 11         39 return @bars;
69             }
70              
71             sub calculate_check_digit {
72 0     0 0   my ($self, $string) = @_;
73              
74 0           my @digits = split(//, $string);
75 0           my $weight = 1;
76 0           my $checksum = 0;
77 0           foreach my $i (0..11) {
78 0           $checksum += $digits[$i] * $weight;
79 0 0         $weight = $weight == 1? 3: 1;
80             }
81              
82 0           $checksum = $checksum % 10;
83 0 0         return 0 unless $checksum;
84 0           return 10 - $checksum;
85             }
86              
87             1;