—

              
package GD::Barcode::EAN13;
use strict;
use GD;
use GD::Barcode;
require Exporter;
use vars qw($VERSION @ISA $errStr);
@ISA = qw(GD::Barcode Exporter);
$VERSION=1.10;
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 $rightBar = {
 '0' => '1110010',
 '1' => '1100110',
 '2' => '1101100',
 '3' => '1000010',
 '4' => '1011100',
 '5' => '1001110',
 '6' => '1010000',
 '7' => '1000100',
 '8' => '1001000',
 '9' => '1110100'
};
my $guardBar = 'G0G';
my $centerBar = '0G0G0';
my $oddEven4EAN = {
 0 => 'OOOOOO',
 1 => 'OOEOEE',
 2 => 'OOEEOE',
 3 => 'OOEEEO',
 4 => 'OEOOEE',
 5 => 'OEEOOE',
 6 => 'OEEEOO',
 7 => 'OEOEOE',
 8 => 'OEOEEO',
 9 => 'OEEOEO'
};
#------------------------------------------------------------------------------
# new (for GD::Barcode::EAN13)
#------------------------------------------------------------------------------
sub new($$) {
  my($sClass, $sTxt) = @_;
  $errStr ='';
  my $oThis = {};
  bless $oThis;
  return undef if($errStr = $oThis->init($sTxt));
  return $oThis;
}
#------------------------------------------------------------------------------
# init (for GD::Barcode::EAN13)
#------------------------------------------------------------------------------
sub init($$){
        my($oThis, $sTxt) =@_;
#Check
    return 'Invalid Characters' if($sTxt =~ /[^0-9]/);
#CalcCd
        if( length($sTxt) == 12 ) {
                $sTxt .= calcEAN13CD( $sTxt ) ;
        }
        elsif(length($sTxt) == 13) {
                ;
        }
        else {
                return 'Invalid Length';
        }
        $oThis->{text} = $sTxt;
        return '';
}
#==================================================================
# Check digit for EAN13
#==================================================================
sub calcEAN13CD($) {
  my( $sTxt ) =@_;
  my( $i, $iSum);
  my @aWeight = (1, 3, 1, 3, 1, 3, 1, 3, 1, 3, 1, 3);
  $iSum = 0;
  for( $i = 0; $i < 12; $i++ ){
      $iSum += substr($sTxt, $i, 1)  * $aWeight[$i];
  }
  $iSum %= 10;
  $iSum = ($iSum == 0)? 0: (10 - $iSum);
  return "$iSum";
}
#------------------------------------------------------------------------------
# barcode (for GD::Barcode::EAN13)
#------------------------------------------------------------------------------
sub barcode($) {
  my ($oThis) = @_;
  my ($sTxt);
  my ($oddEven, $i, $sBar);
  my ($sRes);
#(1)Init
  $sTxt = $oThis->{text};
  $sRes = $guardBar;            #GUARD
#(2)Left 7 letters
  $oddEven = $oddEven4EAN->{substr($sTxt, 0, 1)};
  for( $i = 1; $i < 7; $i++ ) {
          $sBar = ( substr($oddEven, $i-1, 1) eq 'O')?
                        $leftOddBar : $leftEvenBar;
          $sRes .= GD::Barcode::barPtn(
                                substr($sTxt, $i, 1), $sBar);
  }
#(4)Center
  $sRes .= $centerBar;
#(5)Right
    for( $i = 7; $i < 13; $i++ ) {
          $sRes .= GD::Barcode::barPtn( substr($sTxt, $i, 1), $rightBar );
    }
#(6)GUARD
  $sRes .= $guardBar;
  return $sRes;
}
#------------------------------------------------------------------------------
# plot (for GD::Barcode::EAN13)
#------------------------------------------------------------------------------
sub plot($;%) {
  my($oThis, %hParam) = @_;
#Barcode Pattern
  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)+$fW+1;
        ($oGd, $cBlack) = GD::Barcode::plot($sPtn, $iWidth, $iHeight, $fH, $fW+1);
        $oGd->string(gdSmallFont,       0, $iHeight - $fH, substr($oThis->{text}, 0, 1), $cBlack);
        $oGd->string(gdSmallFont, $fW +8 , $iHeight - $fH, substr($oThis->{text}, 1, 6), $cBlack);
        $oGd->string(gdSmallFont, $fW +55, $iHeight - $fH, substr($oThis->{text}, 7, 6), $cBlack);
  }
  return $oGd;
}
1;
__END__
HideShow 80 lines of Pod
=head1 NAME
GD::Barcode::EAN13 - Create EAN13(JAN13) barcode image with GD
=head1 SYNOPSIS
I<ex. CGI>
  use GD::Barcode::EAN13;
  binmode(STDOUT);
  print "Content-Type: image/png\n\n";
  print GD::Barcode::EAN13->new('123456789012')->plot->png;
I<with Error Check>
  my $oGdBar = GD::Barcode::EAN13->new('123456789');
  die $GD::Barcode::EAN13::errStr unless($oGdBar);      #Invalid Length
=head1 DESCRIPTION
GD::Barcode::EAN13 is a subclass of GD::Barcode and allows you to
create EAN13(JAN13) barcode image with GD.
=head2 new
I<$oGdBar> = GD::Barcode::EAN13->new(I<$sTxt>);
Constructor. 
Creates a GD::Barcode::EAN13 object for I<$sTxt>.
I<$sTxt> has 12 or 13 numeric characters([0-9]).
If I<$sTxt> has 12 characters, this module calacurates 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::EAN13->new('123456789012');
  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::EAN13->new('123456789012');
  my $sPtn = $oGdB->barcode();
  # $sPtn = '';
=head2 $errStr
$GD::Barcode::EAN13::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