line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package GD::Barcode::COOP2of5; |
2
|
1
|
|
|
1
|
|
6
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
27
|
|
3
|
1
|
|
|
1
|
|
4
|
use warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
20
|
|
4
|
|
|
|
|
|
|
|
5
|
1
|
|
|
1
|
|
4
|
use GD::Barcode; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
36
|
|
6
|
1
|
|
|
1
|
|
4
|
use parent qw(Exporter); |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
5
|
|
7
|
1
|
|
|
1
|
|
48
|
use vars qw($VERSION @ISA $errStr); |
|
1
|
|
|
|
|
17
|
|
|
1
|
|
|
|
|
564
|
|
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
|
|
|
|
|
6
|
$oThis->{text} = $sTxt; |
27
|
1
|
|
|
|
|
4
|
return ''; |
28
|
|
|
|
|
|
|
} |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
sub barcodeWk { |
31
|
5
|
|
|
5
|
0
|
7
|
my ($sPtn) = @_; |
32
|
5
|
|
|
|
|
6
|
my $sRes = ''; |
33
|
5
|
|
|
|
|
5
|
my $sClr = '1'; |
34
|
5
|
|
|
|
|
10
|
for ( my $i = 0 ; $i < length($sPtn) ; $i++ ) { |
35
|
21
|
100
|
|
|
|
35
|
$sRes .= ( substr( $sPtn, $i, 1 ) eq '1' ) ? $sClr x 3 : $sClr; |
36
|
21
|
100
|
|
|
|
35
|
$sClr = ( $sClr eq '1' ) ? '0' : '1'; |
37
|
|
|
|
|
|
|
} |
38
|
5
|
|
|
|
|
10
|
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' => '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
|
|
|
|
|
3
|
$sRes = barcodeWk( $rhPtn->{START} ); |
61
|
1
|
|
|
|
|
2
|
for ( $i = 0 ; $i < length($sTxt) ; $i++ ) { |
62
|
3
|
|
|
|
|
4
|
$sRes .= '0'; #GAP |
63
|
3
|
|
|
|
|
5
|
$sRes .= barcodeWk( $rhPtn->{ substr( $sTxt, $i, 1 ) } ); |
64
|
|
|
|
|
|
|
} |
65
|
1
|
|
|
|
|
2
|
$sRes .= '0'; #GAP |
66
|
1
|
|
|
|
|
2
|
$sRes .= barcodeWk( $rhPtn->{STOP} ); |
67
|
1
|
|
|
|
|
6
|
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__ |