File Coverage

blib/lib/GD/Barcode/UPCA.pm
Criterion Covered Total %
statement 49 72 68.0
branch 5 14 35.7
condition n/a
subroutine 8 10 80.0
pod 3 5 60.0
total 65 101 64.3


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