File Coverage

blib/lib/GD/Barcode/UPCE.pm

Criterion	Covered	Total	%
statement	47	72	65.2
branch	13	24	54.1
condition			n/a
subroutine	8	10	80.0
pod	3	6	50.0
total	71	112	63.3

package GD::Barcode::UPCE;
use strict;

use GD::Barcode;
use parent qw(Exporter);
use vars qw($VERSION @ISA $errStr);
@ISA     = qw(GD::Barcode Exporter);
$VERSION = '2.00';
my $oddEven4UPCE = {
    0 => 'EEEOOO',
    1 => 'EEOEOO',
    2 => 'EEOOEO',
    3 => 'EEOOOE',
    4 => 'EOEEOO',
    5 => 'EOOEEO',
    6 => 'EOOOEE',
    7 => 'EOEOEO',
    8 => 'EOEOOE',
    9 => 'EOOEOE'
};
my $leftOddBar = {
    '0' => '0001101',
    '1' => '0011001',
    '2' => '0010011',
    '3' => '0111101',
    '4' => '0100011',
    '5' => '0110001',
    '6' => '0101111',
    '7' => '0111011',
    '8' => '0110111',
    '9' => '0001011'
};
my $leftEvenBar = {
    '0' => '0100111',
    '1' => '0110011',
    '2' => '0011011',
    '3' => '0100001',
    '4' => '0011101',
    '5' => '0111001',
    '6' => '0000101',
    '7' => '0010001',
    '8' => '0001001',
    '9' => '0010111'
};
my $guardBar         = 'G0G';
my $UPCrightGuardBar = '0G0G0G';

sub new {
    my ( $sClass, $sTxt ) = @_;
    $errStr = '';
    my $oThis = {};
    bless $oThis, $sClass;
    return if ( $errStr = $oThis->init($sTxt) );
    return $oThis;
}

sub init {
    my ( $oThis, $sTxt ) = @_;
    return 'Invalid characters' if ( $sTxt =~ /[^0-9]/ );

    #Check
    my $iLen = length($sTxt);
    if ( $iLen == 6 ) {
        $sTxt = '0' . $sTxt;
        $sTxt .= calcUPCECD($sTxt);
    }
    elsif ( $iLen == 7 ) {
        $sTxt .= calcUPCECD($sTxt);
    }
    elsif ( $iLen == 8 ) {
        ;
    }
    else {
        return 'Invalid Length';
    }
    $oThis->{text} = $sTxt;
    return '';
}

sub calcUPCACD {
    my ($sTxt) = @_;
    my ( $i, $iSum, @aWeight );

    @aWeight = ( 3, 1, 3, 1, 3, 1, 3, 1, 3, 1, 3 );
    $iSum = 0;
    for ( $i = 0 ; $i < 11 ; $i++ ) {
        $iSum += substr( $sTxt, $i, 1 ) * $aWeight[$i];
    }
    $iSum %= 10;
    $iSum = ( $iSum == 0 ) ? 0 : ( 10 - $iSum );
    return "$iSum";
}

sub calcUPCECD {
    my ($sTxt) = @_;
    my ($upcA);

    my $cLast = substr( $sTxt, 6, 1 );
    if ( $cLast =~ /[0-2]/ ) {    #0,1,2
        $upcA =
          substr( $sTxt, 0, 3 ) . $cLast . '0' x 4 . substr( $sTxt, 3, 3 );
    }
    elsif ( $cLast eq '3' ) {
        $upcA = substr( $sTxt, 0, 4 ) . '0' x 5 . substr( $sTxt, 4, 2 );
    }
    elsif ( $cLast eq '4' ) {
        $upcA = substr( $sTxt, 0, 5 ) . '0' x 5 . substr( $sTxt, 5, 1 );
    }
    else {                        # $cLast =~ /5-9/
        $upcA = substr( $sTxt, 0, 6 ) . '0' x 4 . $cLast;
    }
    return &calcUPCACD($upcA);
}

sub barcode {
    my ($oThis) = @_;
    my ( $topDigit, $oddEven, $c, $i );
    my ($sRes);

    #(1)Init
    my $sTxt = $oThis->{text};
    $sRes = $guardBar;                                     #GUARD
    $oddEven = $oddEven4UPCE->{ substr( $sTxt, 7, 1 ) };

    #(2)Left 6 (Skip 1 character)
    for ( $i = 1 ; $i < 7 ; $i++ ) {
        $c = substr( $sTxt, $i, 1 );
        $sRes .= GD::Barcode::barPtn( $c,
            ( substr( $oddEven, $i - 1, 1 ) eq 'O' )
            ? $leftOddBar
            : $leftEvenBar );
    }
    #
    $sRes .= $UPCrightGuardBar;
    return $sRes;

}

sub plot {
    my ( $oThis, %hParam ) = @_;
    my $sTxt = $oThis->{text};
    my $sPtn = $oThis->barcode();

    #Create Image
    require GD;
    my $iHeight = ( $hParam{Height} ) ? $hParam{Height} : 50;
    my ( $oGd, $cBlack );
    if ( $hParam{NoText} ) {
        ( $oGd, $cBlack ) =
          GD::Barcode::plot( $sPtn, length($sPtn), $iHeight, 0, 0 );
    }
    else {
        my ( $fW, $fH ) = ( GD::Font->Small->width, GD::Font->Small->height );
        my $iWidth = length($sPtn) + 2 * ( $fW + 1 );

        #Bar Image
        ( $oGd, $cBlack ) =
          GD::Barcode::plot( $sPtn, $iWidth, $iHeight, $fH, $fW + 1 );

        #String
        $oGd->string(
            GD::Font->Small, 0,
            $iHeight - $fH,
            substr( $sTxt, 0, 1 ), $cBlack
        );
        $oGd->string(
            GD::Font->Small, $fW + 8,
            $iHeight - $fH,
            substr( $sTxt, 1, 6 ), $cBlack
        );
        $oGd->string(
            GD::Font->Small, $fW + 54,
            $iHeight - $fH,
            substr( $sTxt, 7, 1 ), $cBlack
        );
    }
    return $oGd;
}
1;
__END__