File Coverage

blib/lib/PDF/Reuse/Barcode.pm

Criterion	Covered	Total	%
statement	12	396	3.0
branch	0	110	0.0
condition			n/a
subroutine	4	24	16.6
pod	13	20	65.0
total	29	550	5.2

package PDF::Reuse::Barcode;

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

our $VERSION = '0.07';

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

sub init
{  %default   = ( value           => '0000000',
                  x               => 0,
                  y               => 0,
                  size            => 1,
                  xsize           => 1,
                  ysize           => 1,
                  rotate          => 0,
                  background      => '1 1 1',
                  graybackground  => 1,
                  drawbackground  => 1,
                  text            => 'yes',
                  prolong         => 0,
                  hide_asterisk   => 0,
                  modulesize      => 1,
                  qr_ecc          => 'M',
                  qr_version      => 1,
                  qr_padding      => 0,
                  mode            => 'graphic');
   $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
{  if ($qrcode)
   {  my $m      = $default{'modulesize'};
      my @rows   = split(/\n/, $sPtn);
      $length = length($rows[0]) * $m;
      $height = (1 + scalar(@rows)) * $m;
      my $step   = 1;

      if ($default{'drawbackground'})
      {   $str .= "$default{'graybackground'} g\n";
         $str .= "0 0 $length $height re\n";
         $str .= 'f*' . "\n";
         $str .= "0 g\n";
      }
      prAdd($str);

      @sizes = prFontSize(12);

      $str = Qr( 0, $step, $sPtn);
   }
   else
   {  $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);

   $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;
          }
          $str .= Bar( 10, $step, $sPtn);
       }
    }
   }

    $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;
       if ($qrcode) {
          my $quiet = sprintf("%.2f", 4 * $default{'modulesize'});
          prText($start, 0-$quiet, $value);
       }
       else {
       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 = sprintf("%.2f", $x + 0.91);
   }
   return $string;
}


sub Qr
{  my ($x, $y, $pattern) = @_;
   my $xStart = sprintf("%.2f", $x);

   my $m = $default{'modulesize'};
   my $s = $default{'qr_padding'};
   my $space = sprintf('%.2f', $m + $s);#

   my $string = "0.01 w\n 0 G\n";
   my @rows = split(/\n/, $pattern);
   for my $row (reverse @rows) {
       my $yEnd = sprintf("%.2f", $y + $m);
       for (split(//, $row))
       {   my $xEnd = sprintf("%.2f", $x + $m);
           if ($_ eq '1')
           {  $string .= "$x $y $m $m re\nf\n";
           }
           $x = sprintf("%.2f", $x + $space);
       }
       $x = $xStart;
       $y = sprintf("%.2f", $y + $space);
   }
   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;
}

sub QRcode
{  eval 'require GD::Barcode::QRcode';
   $qrcode = 1;
   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::QRcode->new($value, {Ecc => $default{'qr_ecc'}, Version=>$default{'qr_version'}, ModuleSize => $default{'size'}});
   if (! $oGDBar)
   {  die "$GD::Barcode::QRcode::errStr\n";
   }
   else
   {  $sPtn = $oGDBar->barcode();
   }
   standardEnd();
   1;
}


1;


__END__