File Coverage

blib/lib/GD/Barcode/EAN13.pm
Criterion Covered Total %
statement 45 66 68.1
branch 5 16 31.2
condition n/a
subroutine 8 10 80.0
pod 3 5 60.0
total 61 97 62.8


line stmt bran cond sub pod time code
1             package GD::Barcode::EAN13;
2              
3 1     1   8 use strict;
  1         2  
  1         32  
4 1     1   5 use warnings;
  1         7  
  1         29  
5              
6 1     1   5 use GD::Barcode;
  1         2  
  1         56  
7              
8             our $VERSION = '2.00';
9 1     1   6 use parent qw(Exporter);
  1         2  
  1         6  
10 1     1   57 use vars qw($VERSION @ISA $errStr);
  1         25  
  1         884  
11             @ISA = qw(GD::Barcode Exporter);
12             my $leftOddBar = {
13             '0' => '0001101',
14             '1' => '0011001',
15             '2' => '0010011',
16             '3' => '0111101',
17             '4' => '0100011',
18             '5' => '0110001',
19             '6' => '0101111',
20             '7' => '0111011',
21             '8' => '0110111',
22             '9' => '0001011'
23             };
24             my $leftEvenBar = {
25             '0' => '0100111',
26             '1' => '0110011',
27             '2' => '0011011',
28             '3' => '0100001',
29             '4' => '0011101',
30             '5' => '0111001',
31             '6' => '0000101',
32             '7' => '0010001',
33             '8' => '0001001',
34             '9' => '0010111'
35             };
36             my $rightBar = {
37             '0' => '1110010',
38             '1' => '1100110',
39             '2' => '1101100',
40             '3' => '1000010',
41             '4' => '1011100',
42             '5' => '1001110',
43             '6' => '1010000',
44             '7' => '1000100',
45             '8' => '1001000',
46             '9' => '1110100'
47             };
48             my $guardBar = 'G0G';
49             my $centerBar = '0G0G0';
50             my $oddEven4EAN = {
51             0 => 'OOOOOO',
52             1 => 'OOEOEE',
53             2 => 'OOEEOE',
54             3 => 'OOEEEO',
55             4 => 'OEOOEE',
56             5 => 'OEEOOE',
57             6 => 'OEEEOO',
58             7 => 'OEOEOE',
59             8 => 'OEOEEO',
60             9 => 'OEEOEO'
61             };
62              
63             sub new {
64 0     0 1 0 my ( $sClass, $sTxt ) = @_;
65 0         0 $errStr = '';
66 0         0 my $oThis = {};
67 0         0 bless $oThis, $sClass;
68 0 0       0 return if ( $errStr = $oThis->init($sTxt) );
69 0         0 return $oThis;
70             }
71              
72             sub init {
73 1     1 0 4 my ( $oThis, $sTxt ) = @_;
74              
75             #Check
76 1 50       4 return 'Invalid Characters' if ( $sTxt =~ /[^0-9]/ );
77              
78             #CalcCd
79 1 50       4 if ( length($sTxt) == 12 ) {
    0          
80 1         3 $sTxt .= calcEAN13CD($sTxt);
81             }
82             elsif ( length($sTxt) == 13 ) {
83             ;
84             }
85             else {
86 0         0 return 'Invalid Length';
87             }
88 1         8 $oThis->{text} = $sTxt;
89 1         4 return '';
90             }
91              
92             sub calcEAN13CD {
93 1     1 0 2 my ($sTxt) = @_;
94 1         1 my ( $i, $iSum );
95 1         3 my @aWeight = ( 1, 3, 1, 3, 1, 3, 1, 3, 1, 3, 1, 3 );
96 1         2 $iSum = 0;
97 1         4 for ( $i = 0 ; $i < 12 ; $i++ ) {
98 12         25 $iSum += substr( $sTxt, $i, 1 ) * $aWeight[$i];
99             }
100 1         6 $iSum %= 10;
101 1 50       4 $iSum = ( $iSum == 0 ) ? 0 : ( 10 - $iSum );
102 1         4 return "$iSum";
103             }
104              
105             sub barcode {
106 1     1 1 2 my ($oThis) = @_;
107 1         1 my ($sTxt);
108 1         3 my ( $oddEven, $i, $sBar );
109 1         0 my ($sRes);
110              
111             #(1)Init
112 1         3 $sTxt = $oThis->{text};
113 1         2 $sRes = $guardBar; #GUARD
114              
115             #(2)Left 7 letters
116 1         3 $oddEven = $oddEven4EAN->{ substr( $sTxt, 0, 1 ) };
117 1         4 for ( $i = 1 ; $i < 7 ; $i++ ) {
118 6 100       13 $sBar =
119             ( substr( $oddEven, $i - 1, 1 ) eq 'O' ) ? $leftOddBar : $leftEvenBar;
120 6         20 $sRes .= GD::Barcode::barPtn( substr( $sTxt, $i, 1 ), $sBar );
121             }
122              
123             #(4)Center
124 1         2 $sRes .= $centerBar;
125              
126             #(5)Right
127 1         4 for ( $i = 7 ; $i < 13 ; $i++ ) {
128 6         15 $sRes .= GD::Barcode::barPtn( substr( $sTxt, $i, 1 ), $rightBar );
129             }
130              
131             #(6)GUARD
132 1         2 $sRes .= $guardBar;
133 1         6 return $sRes;
134             }
135              
136             sub plot {
137 0     0 1   my ( $oThis, %hParam ) = @_;
138              
139             #Barcode Pattern
140 0           my $sPtn = $oThis->barcode();
141              
142             #Create Image
143 0           require GD;
144 0 0         my $iHeight = ( $hParam{Height} ) ? $hParam{Height} : 50;
145 0           my ( $oGd, $cBlack );
146 0 0         if ( $hParam{NoText} ) {
147 0           ( $oGd, $cBlack ) =
148             GD::Barcode::plot( $sPtn, length($sPtn), $iHeight, 0, 0 );
149             }
150             else {
151 0           my ( $fW, $fH ) = ( GD::Font->Small->width, GD::Font->Small->height );
152 0           my $iWidth = length($sPtn) + $fW + 1;
153 0           ( $oGd, $cBlack ) =
154             GD::Barcode::plot( $sPtn, $iWidth, $iHeight, $fH, $fW + 1 );
155             $oGd->string(
156             GD::Font->Small, 0,
157             $iHeight - $fH,
158 0           substr( $oThis->{text}, 0, 1 ), $cBlack
159             );
160             $oGd->string(
161             GD::Font->Small, $fW + 8,
162             $iHeight - $fH,
163 0           substr( $oThis->{text}, 1, 6 ), $cBlack
164             );
165             $oGd->string(
166             GD::Font->Small, $fW + 55,
167             $iHeight - $fH,
168 0           substr( $oThis->{text}, 7, 6 ), $cBlack
169             );
170             }
171 0           return $oGd;
172             }
173             1;
174             __END__