File Coverage

blib/lib/GD/Barcode.pm
Criterion Covered Total %
statement 39 54 72.2
branch 7 12 58.3
condition n/a
subroutine 8 9 88.8
pod 2 4 50.0
total 56 79 70.8


line stmt bran cond sub pod time code
1             package GD::Barcode;
2 13     13   2176314 use parent qw(Exporter);
  13         4248  
  13         74  
3 13     13   756 use strict;
  13         33  
  13         231  
4 13     13   62 use warnings;
  13         25  
  13         369  
5              
6 13     13   62 use vars qw( @ISA $errStr);
  13         28  
  13         571  
7 13     13   71 use parent qw(Exporter);
  13         23  
  13         47  
8             our $VERSION = '1.99_03';
9              
10             sub new {
11 11     11 1 808 my ( $sClass, $sType, $sTxt, $rhPrm ) = @_;
12 11         33 my $oThis = {};
13 11         39 my $module = "GD::Barcode::$sType";
14 11         680 eval "require $module;";
15 11 100       89 if ($@) {
16 1         6 $errStr = "Can't load $sType : $@";
17 1         7 return;
18             }
19 10         50 bless $oThis, $module;
20 10 50       53 return if ( $errStr = $oThis->init( $sTxt, $rhPrm ) );
21 10         51 return $oThis;
22             }
23              
24             sub barPtn {
25 62     62 0 125 my ( $bar, $table ) = @_;
26 62         75 my $sRes;
27              
28 62         78 $sRes = '';
29 62         135 foreach my $sWk ( split( //, $bar ) ) {
30 62         124 $sRes .= $table->{$sWk};
31             }
32 62         189 return $sRes;
33             }
34              
35             sub dumpCode {
36 16     16 0 34 my ($sCode) = @_;
37 16         21 my ( $sRes, $sClr );
38              
39             #Init
40 16         20 $sRes = '';
41 16         20 $sClr = '1'; # 1: Black, 0:White
42              
43 16         38 foreach my $sWk ( split( //, $sCode ) ) {
44 142 100       224 $sRes .= ( $sWk eq '1' ) ? $sClr x 3 : $sClr; #3 times or Normal
45 142 100       222 $sClr = ( $sClr eq '0' ) ? '1' : '0';
46             }
47 16         50 return $sRes;
48             }
49              
50             sub plot {
51 0     0 1   my ( $sBarcode, $iWidth, $iHeight, $fH, $iStart ) = @_;
52              
53             #Create Image
54 0           my ( $gdNew, $cWhite, $cBlack );
55 0           eval {
56 0           $gdNew = GD::Image->new( $iWidth, $iHeight );
57 0           $cWhite = $gdNew->colorAllocate( 255, 255, 255 );
58 0           $cBlack = $gdNew->colorAllocate( 0, 0, 0 );
59 0           $gdNew->filledRectangle( 0, 0, $iWidth, $iHeight, $cWhite );
60              
61 0           my $iPos = $iStart;
62 0           foreach my $cWk ( split( //, $sBarcode ) ) {
63 0 0         if ( $cWk eq '0' ) {
    0          
64 0           $gdNew->line( $iPos, 0, $iPos, $iHeight - $fH, $cWhite );
65             }
66             elsif ( $cWk eq 'G' ) {
67 0           $gdNew->line( $iPos, 0, $iPos, $iHeight - 2 * ( $fH / 3 ),
68             $cBlack );
69             }
70             else { #$cWk eq "1" etc.
71 0           $gdNew->line( $iPos, 0, $iPos, $iHeight - $fH, $cBlack );
72             }
73 0           $iPos++;
74             }
75             };
76 0           return ( $gdNew, $cBlack );
77             }
78             1;
79             __END__