File Coverage

blib/lib/PDF/Reuse/Barcode.pm

Criterion	Covered	Total	%
statement	12	350	3.4
branch	0	104	0.0
condition			n/a
subroutine	4	22	18.1
pod	12	18	66.6
total	28	494	5.6

package PDF::Reuse::Barcode;

use 5.006;
use PDF::Reuse;
use strict;
use warnings;

our $VERSION = '0.05';

my ($str, $xsize, $ysize, $height, $sPtn, @sizes, $length, $value, %default);

sub init
{  %default   = ( value           => '0000000',
                  x               => 0,
                  y               => 0,
                  size            => 1,
                  xsize           => 1,
                  ysize           => 1,
                  rotate          => 0,
                  background      => '1 1 1',
                  drawbackground  => 1,
                  text            => 'yes',
                  prolong         => 0,
                  hide_asterisk   => 0,
                  mode            => 'Type3');
   $str    = '';
   $xsize  = 1;
   $ysize  = 1;
   $height = 37;
   $sPtn   = '';
   @sizes  = ();
   $length = 0;
   $value  = ''
}


sub general1
{  $default{'xsize'} = 1 unless ($default{'xsize'} != 0);
   $default{'ysize'} = 1 unless ($default{'ysize'} != 0);
   $default{'size'}  = 1 unless ($default{'size'}  != 0);
   $xsize = $default{'xsize'} * $default{'size'};
   $ysize = $default{'ysize'} * $default{'size'};
   $str  = "q\n";
   $str .= "$xsize 0 0 $ysize $default{'x'} $default{'y'} cm\n";
   if ($default{'rotate'} != 0)
   {   my $radian = sprintf("%.6f", $default{'rotate'} / 57.2957795);    # approx.
       my $Cos    = sprintf("%.6f", cos($radian));
       my $Sin    = sprintf("%.6f", sin($radian));
       my $negSin = $Sin * -1;
       $str .= "$Cos $Sin $negSin $Cos 0 0 cm\n";
   }
}

sub general2
{  $length     = 20 + (length($sPtn) * 0.9);
   my $height  = 38;
   my $step    = 9;
   my $prolong = 0;
   if ($default{'prolong'} > 1)
   {  $prolong  = $default{'prolong'};
      $height  = 26 + ($prolong * 12);
   }
   if ($default{'drawbackground'})
   {   $str .= "$default{'background'} rg\n";
       $str .= "0 0 $length $height re\n";
       $str .= 'f*' . "\n";
       $str .= "0 0 0 rg\n";
   }

   prAdd($str);

   @sizes = prFontSize(12);

   if ($default{'mode'} eq 'Type3')
   {  prBar( 10, $step, $sPtn);
   }
   else  # graphic mode
   {  $str = Bar( 10, $step, $sPtn);
   }

   $prolong--;

   if ($prolong > 0)
   {   $sPtn =~ s/G/1/go;
       while ($prolong > 0)
       {  if ($prolong > 1)
          {   $prolong--;
              $step += 12;
          }
          else
          {   $step += (12 * $prolong);
              $prolong = 0;
          }
          if ($default{'mode'} eq 'Type3')
          {  prBar( 10, $step, $sPtn);
          }
          else   # graphic mode
          {  $str .= Bar( 10, $step, $sPtn);
          }
       }
    }
    # print the graphic mode bars
    if ($default{'mode'} ne 'Type3')
    {   $str .= "B\n";
        prAdd($str);
    }

}

sub general3
{  $str = "Q\n";
   prAdd($str);
   prFontSize($sizes[1]);
}

sub standardEnd
{  general2();

   if ($default{'text'})
   {   my @vec = prFont('C');
       prFontSize(10);
       my $textLength = length($value) * 6;
       my $start = ($length - $textLength) / 2;
       prText($start, 1.5, $value);
       prFont($vec[3]);
    }
   general3();

   1;
}

sub Bar
{  my ($x, $y, $pattern) = @_;
   my $yEnd = $y + 20;
   my $yG   = $y - 3;

   my $string = "0.92 w\n 0 0 0 RG\n";
   for (split(//, $pattern))
   {   if ($_ eq '1')
       {  $string .= "$x $yEnd m\n $x $y l\n";
       }
       elsif($_ eq 'G')
       {  $string .= "$x $yEnd m\n $x $yG l\n";
       }
       $x += 0.91;
   }
   return $string;
}

sub Code128
{  eval 'require Barcode::Code128';
   init();
   my %param = @_;
   for (keys %param)
    {   my $lc = lc($_);
        if (exists $default{$lc})
        {  $default{$lc} = $param{$_};
        }
        else
        {  print STDERR "Unknown parameter $_ , not used \n";
        }
    }
     $value = $default{'value'};

   general1();

   my $oGDBar = Barcode::Code128->new();
   if (! $oGDBar)
   {  die "The translation of $value to barcodes didn't succeed, aborts\n";
   }
   else
   {
      $sPtn = $oGDBar->barcode($value);
      $sPtn =~ tr/#/1/;
      $sPtn =~ tr/ /0/;
   }
   standardEnd();
   1;
}


sub Code39
{  eval 'require GD::Barcode::Code39';
   init();
   my %param = @_;
   for (keys %param)
    {   my $lc = lc($_);
        if (exists $default{$lc})
        {  $default{$lc} = $param{$_};
        }
        else
        {  print STDERR "Unknown parameter $_ , not used \n";
        }
    }
     $value = $default{'value'};

   general1();

   my $oGDBar = GD::Barcode::Code39->new($value);
   if (! $oGDBar)
   {  die "$GD::Barcode::Code39::errStr\n";
   }
   else
   {  $sPtn = $oGDBar->barcode();
   }
   if ($default{hide_asterisk})
   {  $value =~ s/^\*//;
      $value =~ s/\*$//;
   }
   standardEnd();
   1;
}

sub COOP2of5
{  eval 'require GD::Barcode::COOP2of5';
   init();
   my %param = @_;
   for (keys %param)
    {   my $lc = lc($_);
        if (exists $default{$lc})
        {  $default{$lc} = $param{$_};
        }
        else
        {  print STDERR "Unknown parameter $_ , not used \n";
        }
    }
     $value = $default{'value'};

   general1();

   my $oGDBar = GD::Barcode::COOP2of5->new($value);
   if (! $oGDBar)
   {  die "$GD::Barcode::COOP2of5::errStr\n";
   }
   else
   {  $sPtn = $oGDBar->barcode();
   }

   standardEnd();
   1;
}

sub IATA2of5
{  eval 'require GD::Barcode::IATA2of5';
   init();
   my %param = @_;
   for (keys %param)
    {   my $lc = lc($_);
        if (exists $default{$lc})
        {  $default{$lc} = $param{$_};
        }
        else
        {  print STDERR "Unknown parameter $_ , not used \n";
        }
    }
     $value = $default{'value'};

   general1();

   my $oGDBar = GD::Barcode::IATA2of5->new($value);
   if (! $oGDBar)
   {  die "$GD::Barcode::IATA2of5::errStr\n";
   }
   else
   {  $sPtn = $oGDBar->barcode();
   }

   standardEnd();
   1;

}

sub Industrial2of5
{  eval 'require GD::Barcode::Industrial2of5';
   init();
   my %param = @_;
   for (keys %param)
    {   my $lc = lc($_);
        if (exists $default{$lc})
        {  $default{$lc} = $param{$_};
        }
        else
        {  print STDERR "Unknown parameter $_ , not used \n";
        }
    }
     $value = $default{'value'};

   general1();

   my $oGDBar = GD::Barcode::Industrial2of5->new($value);
   if (! $oGDBar)
   {  die "$GD::Barcode::Industrial2of5::errStr\n";
   }
   else
   {  $sPtn = $oGDBar->barcode();
   }

   standardEnd();
   1;
}

sub Matrix2of5
{  eval 'require GD::Barcode::Matrix2of5';
   init();
   my %param = @_;
   for (keys %param)
    {   my $lc = lc($_);
        if (exists $default{$lc})
        {  $default{$lc} = $param{$_};
        }
        else
        {  print STDERR "Unknown parameter $_ , not used \n";
        }
    }
     $value = $default{'value'};

   general1();

   my $oGDBar = GD::Barcode::Matrix2of5->new($value);
   if (! $oGDBar)
   {  die "$GD::Barcode::Matrix2of5::errStr\n";
   }
   else
   {  $sPtn = $oGDBar->barcode();
   }

   standardEnd();
   1;
}

sub NW7
{  eval 'require GD::Barcode::NW7';
   init();
   my %param = @_;
   for (keys %param)
    {   my $lc = lc($_);
        if (exists $default{$lc})
        {  $default{$lc} = $param{$_};
        }
        else
        {  print STDERR "Unknown parameter $_ , not used \n";
        }
    }
     $value = $default{'value'};

   general1();

   my $oGDBar = GD::Barcode::NW7->new($value);
   if (! $oGDBar)
   {  die "$GD::Barcode::NW7::errStr\n";
   }
   else
   {  $sPtn = $oGDBar->barcode();
   }

   standardEnd();
   1;
}



sub EAN13
{  eval 'require GD::Barcode::EAN13';
   init();
   my %param = @_;
   for (keys %param)
   {   my $lc = lc($_);
        if (exists $default{$lc})
        {  $default{$lc} = $param{$_};
        }
        else
        {  print STDERR "Unknown parameter $_ , not used \n";
        }
    }
    $value = $default{'value'};

    general1();

    if ($value =~ m'([^0-9]+)'o)
    {  die "Invalid character $1, aborts\n";
    }

    if (length($value) == 12)
    {  $value .= GD::Barcode::EAN13::calcEAN13CD($value);
    }
    my $oGDBar = GD::Barcode::EAN13->new($value);
    if (! $oGDBar)
    {  die "$GD::Barcode::EAN13::errStr\n";
    }
    else
    {  $sPtn = $oGDBar->barcode();
    }
    general2();

    if ($default{'text'})
    {   my $siffra = substr($value, 0, 1);
        my $del1   = substr($value, 1, 6);
        my $del2   = substr($value, 7, 6);

        my @vec = prFont('C');

        prFontSize(10);

        prText(1, 2, $siffra);
        prText(14, 2, $del1);
        prText(56, 2, $del2);

        prFont($vec[3]);
     }
     general3;
     1;
}

sub EAN8
{  eval 'require GD::Barcode::EAN8';
   init();
   my %param = @_;
   for (keys %param)
   {   my $lc = lc($_);
        if (exists $default{$lc})
        {  $default{$lc} = $param{$_};
        }
        else
        {  print STDERR "Unknown parameter $_ , not used \n";
        }
    }
    $value = $default{'value'};

    general1();

    if ($value =~ m'([^0-9]+)'o)
    {  die "Invalid character $1, aborts\n";
    }

    if (length($value) == 7)
    {  $value .= GD::Barcode::EAN8::calcEAN8CD($value);
    }
    my $oGDBar = GD::Barcode::EAN8->new($value);
    if (! $oGDBar)
    {  die "$GD::Barcode::EAN8::errStr\n";
    }
    else
    {  $sPtn = $oGDBar->barcode();
    }
    general2();

    if ($default{'text'})
    {   my $del1   = substr($value, 0, 4);
        my $del2   = substr($value, 4, 4);
        my @vec = prFont('C');
        prFontSize(10);
        prText(14, 2, $del1);
        prText(42.5, 2, $del2);
        prFont($vec[3]);
    }
    general3;
    1;
}

sub ITF
{  eval 'require GD::Barcode::ITF';
   init();
   my %param = @_;
   for (keys %param)
    {   my $lc = lc($_);
        if (exists $default{$lc})
        {  $default{$lc} = $param{$_};
        }
        else
        {  print STDERR "Unknown parameter $_ , not used \n";
        }
    }
     $value = $default{'value'};

   general1();

   my $oGDBar = GD::Barcode::ITF->new($value);
   if (! $oGDBar)
   {  die "$GD::Barcode::ITF::errStr\n";
   }
   else
   {  $sPtn = $oGDBar->barcode();
   }

   standardEnd();
   1;
}

sub UPCA
{  eval 'require GD::Barcode::UPCA';
   init();
   my %param = @_;
   for (keys %param)
   {   my $lc = lc($_);
        if (exists $default{$lc})
        {  $default{$lc} = $param{$_};
        }
        else
        {  print STDERR "Unknown parameter $_ , not used \n";
        }
    }
    $value = $default{'value'};

    general1();

    if ($value =~ m'([^0-9]+)'o)
    {  die "Invalid character $1, aborts\n";
    }

    if (length($value) == 11)
    {  $value .= GD::Barcode::UPCA::calcUPCACD($value);
    }
    my $oGDBar = GD::Barcode::UPCA->new($value);
    if (! $oGDBar)
    {  die "$GD::Barcode::UPCA::errStr\n";
    }
    else
    {  $sPtn = $oGDBar->barcode();
    }
    general2();

  if ($default{'text'})
   {   my $siffra1 = substr($value, 0, 1);
       my $del1    = substr($value, 1, 5);
       my $del2    = substr($value, 6, 5);
       my $siffra2 = substr($value, 11, 1);

       my @vec = prFont('C');

       prFontSize(10);

       prText(2, 2, $siffra1);
       prText(20, 2, $del1);
       prText(56, 2, $del2);
       prText(97, 2, $siffra2);

       prFont($vec[3]);
    }
    general3;
    1;
}

sub UPCE
{  eval 'require GD::Barcode::UPCE';
   init();
   my %param = @_;
   for (keys %param)
   {   my $lc = lc($_);
        if (exists $default{$lc})
        {  $default{$lc} = $param{$_};
        }
        else
        {  print STDERR "Unknown parameter $_ , not used \n";
        }
    }
    $value = $default{'value'};

    general1();

    if ($value =~ m'([^0-9]+)'o)
    {  die "Invalid character $1, aborts\n";
    }

    if (length($value) == 6)
   {  $value  = '0' . $value;
      my $cd  = GD::Barcode::UPCE::calcUPCECD($value);
      $value .= $cd;
   }
   elsif (length($value) == 7)
   {  my $cd  = GD::Barcode::UPCE::calcUPCECD($value);
      $value .= $cd;
   }
    my $oGDBar = GD::Barcode::UPCE->new($value);
    if (! $oGDBar)
    {  die "$GD::Barcode::UPCE::errStr\n";
    }
    else
    {  $sPtn = $oGDBar->barcode();
    }
    general2();

  if ($default{'text'})
   {   my $siffra = substr($value, 0, 1);
       my $del1   = substr($value, 1, 6);
       my $del2   = substr($value, 7, 1);

       my @vec = prFont('C');

       prFontSize(10);

       prText(2, 2, $siffra);
       prText(14, 2, $del1);
       prText(58, 2, $del2);

       prFont($vec[3]);
    }
    general3;
    1;
}


1;


__END__