home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / EAN13.pm < prev    next >
Encoding:
Perl POD Document  |  2003-06-02  |  6.5 KB  |  254 lines
  1. package GD::Barcode::EAN13;
  2. use strict;
  3. BEGIN { eval{require 'GD.pm';}; };
  4. use GD::Barcode;
  5. require Exporter;
  6. use vars qw($VERSION @ISA $errStr);
  7. @ISA = qw(GD::Barcode Exporter);
  8. $VERSION=1.10;
  9. my $leftOddBar ={
  10.  '0' => '0001101',
  11.  '1' => '0011001',
  12.  '2' => '0010011',
  13.  '3' => '0111101',
  14.  '4' => '0100011',
  15.  '5' => '0110001',
  16.  '6' => '0101111',
  17.  '7' => '0111011',
  18.  '8' => '0110111',
  19.  '9' => '0001011'
  20. };
  21. my $leftEvenBar = {
  22.  '0' => '0100111',
  23.  '1' => '0110011',
  24.  '2' => '0011011',
  25.  '3' => '0100001',
  26.  '4' => '0011101',
  27.  '5' => '0111001',
  28.  '6' => '0000101',
  29.  '7' => '0010001',
  30.  '8' => '0001001',
  31.  '9' => '0010111'
  32. };
  33. my $rightBar = {
  34.  '0' => '1110010',
  35.  '1' => '1100110',
  36.  '2' => '1101100',
  37.  '3' => '1000010',
  38.  '4' => '1011100',
  39.  '5' => '1001110',
  40.  '6' => '1010000',
  41.  '7' => '1000100',
  42.  '8' => '1001000',
  43.  '9' => '1110100'
  44. };
  45. my $guardBar = 'G0G';
  46. my $centerBar = '0G0G0';
  47. my $oddEven4EAN = {
  48.  0 => 'OOOOOO',
  49.  1 => 'OOEOEE',
  50.  2 => 'OOEEOE',
  51.  3 => 'OOEEEO',
  52.  4 => 'OEOOEE',
  53.  5 => 'OEEOOE',
  54.  6 => 'OEEEOO',
  55.  7 => 'OEOEOE',
  56.  8 => 'OEOEEO',
  57.  9 => 'OEEOEO'
  58. };
  59. #------------------------------------------------------------------------------
  60. # new (for GD::Barcode::EAN13)
  61. #------------------------------------------------------------------------------
  62. sub new($$) {
  63.   my($sClass, $sTxt) = @_;
  64.   $errStr ='';
  65.   my $oThis = {};
  66.   bless $oThis;
  67.   return undef if($errStr = $oThis->init($sTxt));
  68.   return $oThis;
  69. }
  70. #------------------------------------------------------------------------------
  71. # init (for GD::Barcode::EAN13)
  72. #------------------------------------------------------------------------------
  73. sub init($$){
  74.         my($oThis, $sTxt) =@_;
  75. #Check
  76.     return 'Invalid Characters' if($sTxt =~ /[^0-9]/);
  77. #CalcCd
  78.         if( length($sTxt) == 12 ) {
  79.                 $sTxt .= calcEAN13CD( $sTxt ) ;
  80.         }
  81.         elsif(length($sTxt) == 13) {
  82.                 ;
  83.         }
  84.         else {
  85.                 return 'Invalid Length';
  86.         }
  87.         $oThis->{text} = $sTxt;
  88.         return '';
  89. }
  90. #==================================================================
  91. # Check digit for EAN13
  92. #==================================================================
  93. sub calcEAN13CD($) {
  94.   my( $sTxt ) =@_;
  95.   my( $i, $iSum);
  96.   my @aWeight = (1, 3, 1, 3, 1, 3, 1, 3, 1, 3, 1, 3);
  97.   $iSum = 0;
  98.   for( $i = 0; $i < 12; $i++ ){
  99.       $iSum += substr($sTxt, $i, 1)  * $aWeight[$i];
  100.   }
  101.   $iSum %= 10;
  102.   $iSum = ($iSum == 0)? 0: (10 - $iSum);
  103.   return "$iSum";
  104. }
  105. #------------------------------------------------------------------------------
  106. # barcode (for GD::Barcode::EAN13)
  107. #------------------------------------------------------------------------------
  108. sub barcode($) {
  109.   my ($oThis) = @_;
  110.   my ($sTxt);
  111.   my ($oddEven, $i, $sBar);
  112.   my ($sRes);
  113.  
  114. #(1)Init
  115.   $sTxt = $oThis->{text};
  116.   $sRes = $guardBar;            #GUARD
  117.  
  118. #(2)Left 7 letters
  119.   $oddEven = $oddEven4EAN->{substr($sTxt, 0, 1)};
  120.   for( $i = 1; $i < 7; $i++ ) {
  121.           $sBar = ( substr($oddEven, $i-1, 1) eq 'O')?
  122.                         $leftOddBar : $leftEvenBar;
  123.           $sRes .= GD::Barcode::barPtn(
  124.                                 substr($sTxt, $i, 1), $sBar);
  125.   }
  126. #(4)Center
  127.   $sRes .= $centerBar;
  128.  
  129. #(5)Right
  130.     for( $i = 7; $i < 13; $i++ ) {
  131.           $sRes .= GD::Barcode::barPtn( substr($sTxt, $i, 1), $rightBar );
  132.     }
  133. #(6)GUARD
  134.   $sRes .= $guardBar;
  135.   return $sRes;
  136. }
  137. #------------------------------------------------------------------------------
  138. # plot (for GD::Barcode::EAN13)
  139. #------------------------------------------------------------------------------
  140. sub plot($;%) {
  141.   my($oThis, %hParam) = @_;
  142.  
  143. #Barcode Pattern
  144.   my $sPtn = $oThis->barcode();
  145.  
  146. #Create Image
  147.   my $iHeight = ($hParam{Height})? $hParam{Height} : 50;
  148.   my($oGd, $cBlack);
  149.   if($hParam{NoText}) {
  150.         ($oGd, $cBlack) = GD::Barcode::plot($sPtn, length($sPtn), $iHeight, 0, 0);
  151.   }
  152.   else {
  153.         my($fW,$fH) = (GD::Font->Small->width,GD::Font->Small->height);
  154.         my $iWidth = length($sPtn)+$fW+1;
  155.         ($oGd, $cBlack) = GD::Barcode::plot($sPtn, $iWidth, $iHeight, $fH, $fW+1);
  156.         $oGd->string(GD::Font->Small,       0, $iHeight - $fH, substr($oThis->{text}, 0, 1), $cBlack);
  157.         $oGd->string(GD::Font->Small, $fW +8 , $iHeight - $fH, substr($oThis->{text}, 1, 6), $cBlack);
  158.         $oGd->string(GD::Font->Small, $fW +55, $iHeight - $fH, substr($oThis->{text}, 7, 6), $cBlack);
  159.   }
  160.   return $oGd;
  161. }
  162. 1;
  163. __END__
  164.  
  165.  
  166. =head1 NAME
  167.  
  168. GD::Barcode::EAN13 - Create EAN13(JAN13) barcode image with GD
  169.  
  170. =head1 SYNOPSIS
  171.  
  172. I<ex. CGI>
  173.  
  174.   use GD::Barcode::EAN13;
  175.   binmode(STDOUT);
  176.   print "Content-Type: image/png\n\n";
  177.   print GD::Barcode::EAN13->new('123456789012')->plot->png;
  178.  
  179. I<with Error Check>
  180.  
  181.   my $oGdBar = GD::Barcode::EAN13->new('123456789');
  182.   die $GD::Barcode::EAN13::errStr unless($oGdBar);      #Invalid Length
  183.  
  184.  
  185. =head1 DESCRIPTION
  186.  
  187. GD::Barcode::EAN13 is a subclass of GD::Barcode and allows you to
  188. create EAN13(JAN13) barcode image with GD.
  189. This module based on "Generate Barcode Ver 1.02 By Shisei Hanai 97/08/22".
  190.  
  191. =head2 new
  192.  
  193. I<$oGdBar> = GD::Barcode::EAN13->new(I<$sTxt>);
  194.  
  195. Constructor.
  196. Creates a GD::Barcode::EAN13 object for I<$sTxt>.
  197. I<$sTxt> has 12 or 13 numeric characters([0-9]).
  198. If I<$sTxt> has 12 characters, this module calacurates CD for you.
  199.  
  200. =head2 plot()
  201.  
  202. I<$oGd> = $oGdBar->plot([Height => I<$iHeight>, NoText => I<0 | 1>]);
  203.  
  204. creates GD object with barcode image for the I<$sTxt> specified at L<new> method.
  205. I<$iHeight> is height of the image. If I<NoText> is 1, the image has no text image of I<$sTxt>.
  206.  
  207.  ex.
  208.   my $oGdB = GD::Barcode::EAN13->new('123456789012');
  209.   my $oGD = $oGdB->plot(NoText=>1, Height => 20);
  210.   # $sGD is a GD image with Height=>20 pixels, with no text.
  211.  
  212. =head2 barcode()
  213.  
  214. I<$sPtn> = $oGdBar->barcode();
  215.  
  216. returns a barcode pattern in string with '1', 'G' and '0'.
  217. '1' means black, 'G' also means black but little bit long,
  218. '0' means white.
  219.  
  220.  ex.
  221.   my $oGdB = GD::Barcode::EAN13->new('123456789012');
  222.   my $sPtn = $oGdB->barcode();
  223.   # $sPtn = '';
  224.  
  225. =head2 $errStr
  226.  
  227. $GD::Barcode::EAN13::errStr
  228.  
  229. has error message.
  230.  
  231. =head2 $text
  232.  
  233. $oGdBar->{$text}
  234.  
  235. has barcode text based on I<$sTxt> specified in L<new> method.
  236.  
  237. =head1 AUTHOR
  238.  
  239. Kawai Takanori GCD00051@nifty.ne.jp
  240.  
  241. =head1 COPYRIGHT
  242.  
  243. The GD::Barocde::EAN13 module is Copyright (c) 2000 Kawai Takanori. Japan.
  244. All rights reserved.
  245.  
  246. You may distribute under the terms of either the GNU General Public
  247. License or the Artistic License, as specified in the Perl README file.
  248.  
  249. =head1 SEE ALSO
  250.  
  251. GD::Barcode
  252.  
  253. =cut
  254.