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   1707994 use parent qw(Exporter);
  13         3314  
  13         60  
3 13     13   612 use strict;
  13         23  
  13         188  
4 13     13   50 use warnings;
  13         18  
  13         282  
5              
6 13     13   52 use vars qw( @ISA $errStr);
  13         20  
  13         423  
7 13     13   58 use parent qw(Exporter);
  13         18  
  13         36  
8             our $VERSION = '1.99_04';
9              
10             sub new {
11 11     11 1 608 my ( $sClass, $sType, $sTxt, $rhPrm ) = @_;
12 11         23 my $oThis = {};
13 11         29 my $module = "GD::Barcode::$sType";
14 11         499 eval "require $module;";
15 11 100       55 if ($@) {
16 1         5 $errStr = "Can't load $sType : $@";
17 1         7 return;
18             }
19 10         27 bless $oThis, $module;
20 10 50       36 return if ( $errStr = $oThis->init( $sTxt, $rhPrm ) );
21 10         40 return $oThis;
22             }
23              
24             sub barPtn {
25 62     62 0 96 my ( $bar, $table ) = @_;
26 62         63 my $sRes;
27              
28 62         65 $sRes = '';
29 62         97 foreach my $sWk ( split( //, $bar ) ) {
30 62         129 $sRes .= $table->{$sWk};
31             }
32 62         151 return $sRes;
33             }
34              
35             sub dumpCode {
36 16     16 0 21 my ($sCode) = @_;
37 16         17 my ( $sRes, $sClr );
38              
39             #Init
40 16         16 $sRes = '';
41 16         18 $sClr = '1'; # 1: Black, 0:White
42              
43 16         35 foreach my $sWk ( split( //, $sCode ) ) {
44 142 100       204 $sRes .= ( $sWk eq '1' ) ? $sClr x 3 : $sClr; #3 times or Normal
45 142 100       192 $sClr = ( $sClr eq '0' ) ? '1' : '0';
46             }
47 16         48 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__