File Coverage

blib/lib/SVG/Barcode/UPCA.pm

Criterion	Covered	Total	%
statement	107	107	100.0
branch	12	14	85.7
condition	1	3	33.3
subroutine	17	17	100.0
pod	1	1	100.0
total	138	142	97.1

package SVG::Barcode::UPCA;
$SVG::Barcode::UPCA::VERSION = '0.9';
use parent 'SVG::Barcode';
use strict;
use warnings;
use utf8;
use v5.24;
use feature 'signatures';
no warnings 'experimental::signatures';

use POSIX 'fmax';
use Exporter 'import';
our @EXPORT_OK = qw|plot_upca|;

use GD::Barcode::UPCA;

use constant DEFAULTS => {
  lineheight => 50,
  linewidth  => 1,
  quietzone  => 9,  # UPCA needs an explicit quiet zone left and right
  textsize   => 10,
};

SVG::Barcode::_param(__PACKAGE__, $_, DEFAULTS->{$_}) for keys DEFAULTS->%*;

# functions

sub plot_upca ($text, %params) {
  return __PACKAGE__->new(%params)->plot($text);
}

# internal methods

# Add support for taller lines (typically at the sides and middle)
sub _plot_1d ($self, $code, $sign, $signlong) {
  my @line;
  my $width    = $self->{linewidth};
  my $height   = $self->{lineheight};
  my $add_line = sub {
    if (@line) {
      $self->_rect(@line);
      @line = ();
    }
  };
  for my $x (0 .. $#$code) {
    if ($code->[$x] eq $sign) {
      if (@line) {
        $line[2] += $width;
      } else {
        @line = ($x * $width, 0, $width, $height);
      }
    } elsif ($code->[$x] eq $signlong) {
      # Make a slightly taller line
      if (@line) {
        $line[2] += $width;
      } else {
        @line = ($x * $width, 0, $width, $height * 1.1);
      }
    } else {
      $add_line->();
    }
  }
  $add_line->();
}

sub _plot ($self, $text) {
  $self->{plotter} ||= GD::Barcode::UPCA->new($text)
    or die "Cannot create GD::Barcode::UPCA plotter: " . $GD::Barcode::UPCA::errStr;

  my @code = split //, $self->{plotter}->barcode();
  $self->_plot_1d(\@code, '1', 'G');
  $self->_plot_text($self->{plotter}->{text});
}

# We have to add the quiet zones on the sides
sub _rect ($self, $x, $y, $width, $height, $color = $self->{foreground}) {
  my $x1 = $x + $self->{margin} + $self->{quietzone};
  my $y1 = $y + $self->{margin};
  $self->{vbwidth}  = fmax($self->{vbwidth},  $x1 + $width + $self->{quietzone});
  $self->{vbheight} = fmax($self->{vbheight}, $y1 + $height);
  push $self->{elements}->@*,
    qq|  |;
  return $self;
}

# Handle aligning the text below the barcode
# TODO: find a better way to calculate the positions relative to the bars
sub _text ($self, $text, $x_offset, $y_offset, $size, $color = $self->{foreground}) {
  return $self if $size == 0;

  my $escaped = $self->_xml_escape($text);
  my $margin  = $self->{margin};
  my $qz      = $self->{quietzone};
  my $width   = $self->{linewidth};

  # The full barcode string is 95 modules wide.
  # The text is split into 3 parts:
  # - 1st digit (system character)
  # - next 5 digits
  # - last 5 digits + check digit

  my ($sys_char, $left_digits, $right_digits, $check_digit) =
    $escaped =~ m/^(\d)(\d{5})(\d{5})(\d)$/;

  my $y1 = $y_offset; # Position below the shortest bars
  $self->{vbheight} = fmax $self->{vbheight}, $y1 + $size; # Ensure height accounts for text

  # System character (1st digit)
  my $x_sys = $margin; # Just inside the margin
  push $self->{elements}->@*, qq|  $sys_char|;

  # Left 5 digits (modules 3-47, center at 25)
  my $x_left = $margin + $qz + (40 * $width) - (length($left_digits) * $size / 2);
  push $self->{elements}->@*, qq|  $left_digits|;

  # Right 5 digits + check digit (modules 48-92, center at 70)
  my $x_right = $margin + $qz + (80 * $width) - (length($right_digits) * $size / 2);
  push $self->{elements}->@*, qq|  $right_digits|;

  # Check digit (last digit)
  my $x_check = $margin + $qz *2 + 90; # Approximately just inside the margin
  push $self->{elements}->@*, qq|  $check_digit|;
  return $self;
}

1;

__END__