File Coverage

blib/lib/GD/Barcode/UPCE.pm
Criterion Covered Total %
statement 47 72 65.2
branch 13 24 54.1
condition n/a
subroutine 8 10 80.0
pod 3 6 50.0
total 71 112 63.3


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