File Coverage

blib/lib/HTML/Barcode.pm

Criterion	Covered	Total	%
statement	6	58	10.3
branch	0	26	0.0
condition	0	3	0.0
subroutine	2	12	16.6
pod	4	4	100.0
total	12	103	11.6

package HTML::Barcode;
use Any::Moose;

our $VERSION = '0.11';

has 'text' => (
    is  => 'rw',
    isa => 'Str',
    documentation => 'The information to put into the barcode.',
);
has 'foreground_color' => (
    is      => 'rw',
    isa     => 'Str',
    default => '#000',
    documentation => 'A CSS color value for the foreground.',
);
has 'background_color' => (
    is      => 'rw',
    isa     => 'Str',
    default => '#fff',
    documentation => 'A CSS color value for the background.',
);
has 'bar_width' => (
    is      => 'rw',
    isa     => 'Str',
    default => '2px',
    documentation => 'A CSS value for the width of an individual bar.',
);
has 'bar_height' => (
    is      => 'rw',
    isa     => 'Str',
    default => '100px',
    documentation => 'A CSS value for the height of an individual bar.',
);
has show_text => (
    is      => 'rw',
    isa     => 'Bool',
    default => 1,
    documentation => 'Indicates whether or not to render the text below the barcode.',
);

has 'css_class' => (
    is      => 'rw',
    isa     => 'Str',
    default => 'hbc',
    trigger => \&_css_class_set,
    documentation => 'The value for the "class" attribute applied to any container tags.',
);

has 'embed_style' => (
    is      => 'rw',
    isa     => 'Bool',
    default => 0,
    documentation => 'Embed the style information in HTML "style" attributes. This is NOT recommended.',
);

has 'td_on_class' => (is => 'rw', 'isa' => 'Str', lazy => 1, builder => '_build_td_on_class');
has 'td_off_class' => (is => 'rw', 'isa' => 'Str', lazy => 1, builder => '_build_td_off_class');
sub _css_class_set {
    my ($self) = @_;
    $self->td_on_class($self->_build_td_on_class);
    $self->td_off_class($self->_build_td_off_class);
}
sub _build_td_on_class { return $_[0]->css_class . '_on'; }
sub _build_td_off_class { return $_[0]->css_class . '_off'; }

# You need to override this.
sub barcode_data { return []; }

sub render {
    my ($self) = @_;
    return '' unless defined $self->text;
    return q() . $self->css . q()
        . $self->render_barcode();
}

# If you're doing anything that can't be represented by a rectangular
# grid, you need to override this.
# This needs to also render the text, if $self->show_text is true.
sub render_barcode {
    my ($self) = @_;
    return '' unless defined $self->text;

    my $data = $self->barcode_data;
    my $num_columns = 1;

    my @rows = ();
    if (@$data > 0) {
        if (ref $data->[0] && ref $data->[0] eq 'ARRAY') {
            $num_columns = scalar @{$data->[0]};
            push @rows, map {
                $self->_generate_tr(
                    join('', map { $self->_generate_td($_) } @$_)
                );
            } @$data;
        } else {
            $num_columns = scalar @$data;
            push @rows, $self->_generate_tr(
                join('', map { $self->_generate_td($_) } @$data)
            );
        }
    }

    if ($self->show_text) {
        push @rows, $self->_generate_tr(
            $self->_generate_td(undef, $num_columns, $self->text)
        );
    }

    return $self->_generate_table(join '', @rows);
}

sub css {
    my $self = shift;
    my $class = $self->css_class;
    my $on = $self->td_on_class;
    my $off = $self->td_off_class;
    return
           "table.${class} {border-width:0;border-spacing:0;}"
         . "table.${class} {border-width:0;border-spacing:0;}"
         . "table.${class} tr, table.${class} td{border:0;margin:0;padding:0;}"
         . "table.${class} td{text-align:center;}"
         . "table.${class} td.${on},table.${class} td.${off} {width:" . $self->bar_width . ";height:" . $self->bar_height . ";}"
         . "table.${class} td.${on} {background-color:" . $self->foreground_color . ";color:inherit;}"
         . "table.${class} td.${off} {background-color:" . $self->background_color . ";color:inherit;}"
         ;
}

sub _generate_table {
    my ($self, $contents) = @_;
    my $class = $self->css_class;

    my $style = '';
    if ($self->embed_style) {
        $style = ' style="border:0;margin:0;padding:0;border-spacing:0;"';
    }

    return qq{$contents