First commit of label software

dist.ini

@@ -0,0 +1,7 @@
+name=Protocol-Zebra-Label
+version=0.001
+license=None
+copyright_holder=Stuifzand Software
+
+
+[@Basic]

lib/Protocol/Zebra/Label.pm

@@ -0,0 +1,132 @@
+use strict;
+use warnings;
+package Protocol::Zebra::Label;
+use 5.14.2;
+use Moose;
+use Text::Wrap;
+
+has 'data' => (
+    traits  => [qw/String/],
+    is      => 'rw',
+    isa     => 'Str',
+    default => "",
+    handles => {
+        append_data => 'append',
+    },
+);
+
+has 'line_height' => (
+    is     => 'rw',
+    isa    => 'Int',
+    default => 2,
+);
+
+has 'height' => (
+    traits => ['Number'],
+    is     => 'rw',
+    isa    => 'Int',
+    default => 32,
+    handles => {
+        add_height => 'add',
+    },
+);
+
+sub header {
+    my $self = shift;
+    return "^XA~TA000~JSN~LT0^MNW^MTD^PON^PMN^LH0,0^JMA^PR2,2~SD25~JO^JUS^LRY^CI0^XZ^XA^MMT^PW254^LL0203^LS0";
+}
+
+sub reset {
+    my $self = shift;
+    $self->data("");
+    $self->height(32);
+    $self->line_height(2);
+}
+
+sub format {
+    my $self = shift;
+    my $vars = shift;
+
+    # split lines
+    my $name = $vars->{name};
+
+    $Text::Wrap::columns = 27;
+    my @line = split/\n/,wrap("", "", $name);
+
+    $self->append_data($self->header);
+
+    # add_line
+    for (@line) {
+        $self->add_line($_);
+    }
+
+    # add_price
+    $self->add_line($vars->{price}, 32);
+
+    # add_barcode
+    $self->add_barcode($vars->{barcode});
+
+    # add_count
+    $self->add_count($vars->{count});
+
+    my $str = $self->data;
+    $self->reset;
+
+    return $str;
+}
+
+sub add_line {
+    my $self = shift;
+    my $line = shift;
+    my $font_height = shift;
+    $font_height //= 20;
+
+    if (length $line > 27) {
+        die "Long line";
+    }
+
+    my $font_width = $font_height;
+    if ($font_height == 32) {
+        $self->add_height(16);
+    }
+
+    $self->append_data("^FT16," . $self->height . "^A0N," . $font_height . "," . $font_width . "^FH\\^FD" . $line . "^FS");
+    $self->add_height($font_height + $self->line_height);
+    return;
+}
+
+sub add_barcode {
+    my $self = shift;
+    my $barcode = shift;
+
+    my $code = ""; # EAN13 of Code128C
+
+    $code .= "^BEN,,Y,N"; # EAN13
+
+    # Code128C code = "^BCN,,Y,N";
+    # barcode = ">;" + barcode;
+
+    $self->append_data("^BY2,2,56^FT32,158" . $code . "\r\n^FD" . $barcode . "^FS");
+    return;
+}
+
+# RawPrinterHelper.SendStringToPrinter(printer_name, header+"^XA^MMT^PW254^LL0203^LS0"+text+"^BY2,2,56^FT32,158" + code + "\r\n^FD" + barcode + "^FS^PQ" + count + ",0,1,Y^XZ\r\n");
+sub add_count {
+    my $self = shift;
+    my $count = shift;
+    $self->append_data("^PQ" . $count . ",0,1,Y^XZ\r\n");
+    return;
+}
+
+no Moose;
+1;
+
+__END__
+
+=head1 NAME 
+
+Protocol::Zebra::Label - Labels or barcode printer
+
+=cut
+
+

t/label.t

@@ -0,0 +1,25 @@
+
+use Test::More;
+use Test::LongString;
+use Protocol::Zebra::Label;
+
+my $p = Protocol::Zebra::Label->new;
+ok($p);
+
+is_string($p->header, "^XA~TA000~JSN~LT0^MNW^MTD^PON^PMN^LH0,0^JMA^PR2,2~SD25~JO^JUS^LRY^CI0^XZ^XA^MMT^PW254^LL0203^LS0");
+
+is_string($p->format({ name => "Test product", barcode => "812345678901", price => "EUR 1,00", count => 1 }),
+    "^XA~TA000~JSN~LT0^MNW^MTD^PON^PMN^LH0,0^JMA^PR2,2~SD25~JO^JUS^LRY^CI0^XZ^XA^MMT^PW254^LL0203^LS0"
+    ."^FT16,32^A0N,20,20^FH\\^FDTest product^FS"
+    ."^BY2,2,56^FT32,158^BEN,,Y,N\r\n^FD812345678901^FS"
+    ."^PQ1,0,1,Y^XZ\r\n");
+
+is_string($p->format({ name => "Test product met een langere naam", barcode => "812345678901", price => "EUR 1,00", count => 1 }),
+    "^XA~TA000~JSN~LT0^MNW^MTD^PON^PMN^LH0,0^JMA^PR2,2~SD25~JO^JUS^LRY^CI0^XZ^XA^MMT^PW254^LL0203^LS0"
+    ."^FT16,32^A0N,20,20^FH\\^FDTest product met een lang^FS"
+    ."^FT16,54^A0N,20,20^FH\\^FDere naam^FS"
+    ."^BY2,2,56^FT32,158^BEN,,Y,N\r\n^FD812345678901^FS"
+    ."^PQ1,0,1,Y^XZ\r\n");
+
+done_testing();
+