package GD::Barcode::UPCE;
use strict;
use GD;
use GD::Barcode;
require Exporter;
use vars qw($VERSION @ISA $errStr);
@ISA = qw(GD::Barcode Exporter);
$VERSION=1.10;
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';
#------------------------------------------------------------------------------
# new (for Spreadsheet::ParseExcel)
#------------------------------------------------------------------------------
sub new($$) {
  my($sClass, $sTxt) = @_;
  $errStr ='';
  my $oThis = {};
  bless $oThis;
  return undef if($errStr = $oThis->init($sTxt));
  return $oThis;
}
#------------------------------------------------------------------------------
# init (for Spreadsheet::ParseExcel)
#------------------------------------------------------------------------------
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 '';
}
#------------------------------------------------------------------------------
# calcUPCACD (for GD::Barcode::UPCE)
#------------------------------------------------------------------------------
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";
}
#------------------------------------------------------------------------------
# calcUPCECD (for GD::Barcode::UPCE)
#------------------------------------------------------------------------------
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 );
}
#------------------------------------------------------------------------------
# barcode (for GD::Barcode::UPCE)
#------------------------------------------------------------------------------
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;

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

#Create Image
  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) = (gdSmallFont->width, gdSmallFont->height);
  	my $iWidth = length($sPtn)+ 2*($fW+1);
	#Bar Image
  	($oGd, $cBlack) = GD::Barcode::plot($sPtn, $iWidth, $iHeight, $fH, $fW+1);
	#String
  	$oGd->string(gdSmallFont,        0, $iHeight - $fH, substr($sTxt, 0, 1), $cBlack);
  	$oGd->string(gdSmallFont, $fW +  8, $iHeight - $fH, substr($sTxt, 1, 6), $cBlack);
  	$oGd->string(gdSmallFont, $fW + 54, $iHeight - $fH, substr($sTxt, 7, 1), $cBlack);
  }
  return $oGd;

  return $oGd;
}
1;
__END__


=head1 NAME

GD::Barcode::UPCE - Create UPC-E barcode image with GD

=head1 SYNOPSIS

I<ex. CGI>

  use GD::Barcode::UPCE;
  binmode(STDOUT);
  print "Content-Type: image/png\n\n";
  print GD::Barcode::UPCE->new('123456')->plot->png;

I<with Error Check>

  my $oGdBar = GD::Barcode::UPCE->new('123456789');
  die $GD::Barcode::UPCE::errStr unless($oGdBar);	#Invalid Length

=head1 DESCRIPTION

GD::Barcode::UPCE is a subclass of GD::Barcode and allows you to
create UPC-E barcode image with GD.

=head2 new

I<$oGdBar> = GD::Barcode::UPCE->new(I<$sTxt>);

Constructor. 
Creates a GD::Barcode::UPCE object for I<$sTxt>.
I<$sTxt> has 6 or 7 or 8 numeric characters([0-9]).
If I<$sTxt> has 6 characters, this module adds '0' at the front of I<$sTxt>.
and calculates CD for you.
If I<$sTxt> has 7 characters, this module calaculates CD for you.

=head2 plot()

I<$oGd> = $oGdBar->plot([Height => I<$iHeight>, NoText => I<0 | 1>]);

creates GD object with barcode image for the I<$sTxt> specified at L<new> method.
I<$iHeight> is height of the image. If I<NoText> is 1, the image has no text image of I<$sTxt>.

 ex.
  my $oGdB = GD::Barcode::UPCE->new('123456');
  my $oGD = $oGdB->plot(NoText=>1, Height => 20);
  # $sGD is a GD image with Height=>20 pixels, with no text.

=head2 barcode()

I<$sPtn> = $oGdBar->barcode();

returns a barcode pattern in string with '1', 'G' and '0'. 
'1' means black, 'G' also means black but little bit long, 
'0' means white.

 ex.
  my $oGdB = GD::Barcode::UPCE->new('123456');
  my $sPtn = $oGdB->barcode();
  # $sPtn = '';

=head2 $errStr

$GD::Barcode::UPCE::errStr

has error message.

=head2 $text

$oGdBar->{$text}

has barcode text based on I<$sTxt> specified in L<new> method.

=head1 AUTHOR

Kawai Takanori GCD00051@nifty.ne.jp

=head1 SEE ALSO

GD::Barcode

=cut
