File Coverage

blib/lib/GD/Barcode/Matrix2of5.pm
Criterion Covered Total %
statement 37 56 66.0
branch 5 12 41.6
condition n/a
subroutine 8 10 80.0
pod 3 5 60.0
total 53 83 63.8


line stmt bran cond sub pod time code
1             package GD::Barcode::Matrix2of5;
2 1     1   7 use strict;
  1         2  
  1         31  
3 1     1   5 use warnings;
  1         2  
  1         24  
4              
5 1     1   5 use GD::Barcode;
  1         2  
  1         41  
6 1     1   6 use parent qw(Exporter);
  1         2  
  1         5  
7 1     1   67 use vars qw($VERSION @ISA $errStr);
  1         10  
  1         658  
8             @ISA = qw(GD::Barcode Exporter);
9             our $VERSION = '2.00';
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 3 my ( $oThis, $sTxt ) = @_;
22              
23             #Check
24 1 50       5 return 'Invalid Characters' if ( $sTxt =~ /[^0-9]/ );
25              
26 1         7 $oThis->{text} = $sTxt;
27 1         5 return '';
28             }
29              
30             sub barcodeWk {
31 11     11 0 18 my ($sPtn) = @_;
32 11         13 my $sRes = '';
33 11         13 my $sClr = '1';
34 11         21 for ( my $i = 0 ; $i < length($sPtn) ; $i++ ) {
35 55 100       92 $sRes .= ( substr( $sPtn, $i, 1 ) eq '1' ) ? $sClr x 3 : $sClr;
36 55 100       111 $sClr = ( $sClr eq '1' ) ? '0' : '1';
37             }
38 11         24 return $sRes;
39             }
40              
41             sub barcode {
42 1     1 1 3 my ($oThis) = @_;
43 1         2 my $i;
44             my $sRes;
45 1         2 my $sTxt = $oThis->{text};
46 1         9 my $rhPtn = {
47             'START' => '10000',
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' => '10000',
59             };
60 1         3 $sRes = barcodeWk( $rhPtn->{START} );
61 1         3 for ( $i = 0 ; $i < length($sTxt) ; $i++ ) {
62 9         12 $sRes .= '0'; #GAP
63 9         18 $sRes .= barcodeWk( $rhPtn->{ substr( $sTxt, $i, 1 ) } );
64             }
65 1         2 $sRes .= '0'; #GAP
66 1         3 $sRes .= barcodeWk( $rhPtn->{STOP} );
67 1         9 return $sRes;
68             }
69              
70             sub plot {
71 0     0 1   my ( $oThis, %hParam ) = @_;
72              
73 0           my $sTxtWk = $oThis->{text};
74 0           my $sPtn = $oThis->barcode();
75              
76             #Create Image
77 0 0         my $iHeight = ( $hParam{Height} ) ? $hParam{Height} : 50;
78 0           my ( $oGd, $cBlack );
79 0 0         if ( $hParam{NoText} ) {
80 0           ( $oGd, $cBlack ) =
81             GD::Barcode::plot( $sPtn, length($sPtn), $iHeight, 0, 0 );
82             }
83             else {
84 0           require GD;
85 0           my ( $fW, $fH ) = ( GD::Font->Small->width, GD::Font->Small->height );
86 0           my $iWidth = length($sPtn);
87              
88             #Bar Image
89 0           ( $oGd, $cBlack ) =
90             GD::Barcode::plot( $sPtn, $iWidth, $iHeight, $fH, 0 );
91              
92             #String
93 0           $oGd->string(
94             GD::Font->Small,
95             ( length($sPtn) - $fW * ( length($sTxtWk) ) ) / 2,
96             $iHeight - $fH,
97             $sTxtWk, $cBlack
98             );
99             }
100 0           return $oGd;
101             }
102             1;
103             __END__