File Coverage

blib/lib/GD/Barcode/COOP2of5.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::COOP2of5;
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         40  
6 1     1   6 use parent qw(Exporter);
  1         2  
  1         5  
7 1     1   58 use vars qw($VERSION @ISA $errStr);
  1         22  
  1         748  
8             @ISA = qw(GD::Barcode Exporter);
9             our $VERSION = '1.99_03';
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         6 $oThis->{text} = $sTxt;
27 1         7 return '';
28             }
29              
30             sub barcodeWk {
31 5     5 0 10 my ($sPtn) = @_;
32 5         5 my $sRes = '';
33 5         17 my $sClr = '1';
34 5         11 for ( my $i = 0 ; $i < length($sPtn) ; $i++ ) {
35 21 100       48 $sRes .= ( substr( $sPtn, $i, 1 ) eq '1' ) ? $sClr x 3 : $sClr;
36 21 100       40 $sClr = ( $sClr eq '1' ) ? '0' : '1';
37             }
38 5         12 return $sRes;
39             }
40              
41             sub barcode {
42 1     1 1 2 my ($oThis) = @_;
43 1         2 my $i;
44             my $sRes;
45 1         3 my $sTxt = $oThis->{text};
46 1         13 my $rhPtn = {
47             'START' => '101',
48             '0' => '11000',
49             '1' => '00011',
50             '2' => '00101',
51             '3' => '00110',
52             '4' => '01001',
53             '5' => '01010',
54             '6' => '01100',
55             '7' => '10001',
56             '8' => '10010',
57             '9' => '10100',
58             'STOP' => '011',
59             };
60 1         2 $sRes = barcodeWk( $rhPtn->{START} );
61 1         3 for ( $i = 0 ; $i < length($sTxt) ; $i++ ) {
62 3         5 $sRes .= '0'; #GAP
63 3         7 $sRes .= barcodeWk( $rhPtn->{ substr( $sTxt, $i, 1 ) } );
64             }
65 1         2 $sRes .= '0'; #GAP
66 1         3 $sRes .= barcodeWk( $rhPtn->{STOP} );
67 1         13 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           my ( $fW, $fH ) = ( GD::Font->Small->width, GD::Font->Small->height );
85 0           my $iWidth = length($sPtn);
86              
87             #Bar Image
88 0           ( $oGd, $cBlack ) =
89             GD::Barcode::plot( $sPtn, $iWidth, $iHeight, $fH, 0 );
90              
91             #String
92 0           require GD;
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__