File Coverage

blib/lib/GD/Barcode/IATA2of5.pm
Criterion Covered Total %
statement 35 54 64.8
branch 3 10 30.0
condition n/a
subroutine 8 10 80.0
pod 3 5 60.0
total 49 79 62.0


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