File Coverage

blib/lib/GD/Barcode/ITF.pm
Criterion Covered Total %
statement 49 62 79.0
branch 11 18 61.1
condition n/a
subroutine 9 10 90.0
pod 3 5 60.0
total 72 95 75.7


line stmt bran cond sub pod time code
1             package GD::Barcode::ITF;
2 1     1   227126 use strict;
  1         7  
  1         30  
3 1     1   5 use warnings;
  1         2  
  1         23  
4              
5 1     1   400 use GD::Barcode;
  1         2  
  1         48  
6 1     1   7 use parent qw(Exporter);
  1         2  
  1         3  
7 1     1   49 use vars qw($VERSION @ISA $errStr);
  1         2  
  1         700  
8             @ISA = qw(GD::Barcode Exporter);
9             our $VERSION = '1.99_03';
10              
11             sub new {
12 2     2 1 100 my ( $sClass, $sTxt ) = @_;
13 2         5 $errStr = '';
14 2         8 my $oThis = {};
15 2         4 bless $oThis, $sClass;
16 2 50       5 return if ( $errStr = $oThis->init($sTxt) );
17 2         7 return $oThis;
18             }
19              
20             sub init {
21 2     2 0 5 my ( $oThis, $sTxt ) = @_;
22              
23             #Check
24 2 50       9 return 'Invalid Characters' if ( $sTxt =~ /[^0-9]/ );
25              
26             #Not Set Chec
27 2 100       10 if ( length($sTxt) % 2 ) {
28 1         4 $sTxt .= calcITFCD($sTxt);
29             }
30 2         11 $oThis->{text} = $sTxt;
31 2         8 return '';
32             }
33              
34             sub calcITFCD {
35 1     1 0 2 my ($sTxt) = @_;
36 1         2 my ( $i, $iSum );
37              
38 1         2 $iSum = 0;
39 1         4 for ( $i = 0 ; $i < length($sTxt) ; $i++ ) {
40 13 100       36 $iSum += substr( $sTxt, $i, 1 ) * ( ( $i % 2 ) ? 1 : 3 );
41             }
42 1         2 $iSum %= 10;
43 1 50       4 $iSum = ( $iSum == 0 ) ? 0 : ( 10 - $iSum );
44 1         5 return "$iSum";
45             }
46              
47             sub barcode {
48 2     2 1 3 my ($oThis) = @_;
49 2         5 my ( $i, $sRes );
50 2         4 my $sTxt = $oThis->{text};
51 2         13 my $rhPtn = {
52             '0' => '00110',
53             '1' => '10001',
54             '2' => '01001',
55             '3' => '11000',
56             '4' => '00101',
57             '5' => '10100',
58             '6' => '01100',
59             '7' => '00011',
60             '8' => '10010',
61             '9' => '01010'
62             };
63              
64 2         4 $sRes = '';
65 2         5 $sRes .= '1010'; #START
66 2         6 for ( $i = 0 ; $i < length($sTxt) ; $i += 2 ) {
67 14         23 my $sBlack = $rhPtn->{ substr( $sTxt, $i, 1 ) };
68 14         23 my $sWhite = $rhPtn->{ substr( $sTxt, $i + 1, 1 ) };
69 14         26 for ( my $j = 0 ; $j < length($sBlack) ; $j++ ) {
70 70 100       106 $sRes .= ( substr( $sBlack, $j, 1 ) eq '1' ) ? '1' x 3 : '1';
71 70 100       167 $sRes .= ( substr( $sWhite, $j, 1 ) eq '1' ) ? '0' x 3 : '0';
72             }
73             }
74 2         4 $sRes .= '1' x 3 . '01'; #STOP
75 2         12 return $sRes;
76             }
77              
78             sub plot {
79 0     0 1   my ( $oThis, %hParam ) = @_;
80              
81 0           my $sTxtWk = $oThis->{text};
82 0           my $sPtn = $oThis->barcode();
83              
84             #Create Image
85 0           require GD;
86 0 0         my $iHeight = ( $hParam{Height} ) ? $hParam{Height} : 50;
87 0           my ( $oGd, $cBlack );
88 0 0         if ( $hParam{NoText} ) {
89 0           ( $oGd, $cBlack ) =
90             GD::Barcode::plot( $sPtn, length($sPtn), $iHeight, 0, 0 );
91             }
92             else {
93 0           my ( $fW, $fH ) = ( GD::Font->Small->width, GD::Font->Small->height );
94 0           my $iWidth = length($sPtn);
95              
96             #Bar Image
97 0           ( $oGd, $cBlack ) =
98             GD::Barcode::plot( $sPtn, $iWidth, $iHeight, $fH, 0 );
99              
100             #String
101 0           $oGd->string(
102             GD::Font->Small,
103             ( length($sPtn) - $fW * ( length($sTxtWk) ) ) / 2,
104             $iHeight - $fH,
105             $sTxtWk, $cBlack
106             );
107             }
108 0           return $oGd;
109             }
110             1;
111             __END__