First commit of label software
This commit is contained in:
commit
769bdfab33
7
dist.ini
Normal file
7
dist.ini
Normal file
|
@ -0,0 +1,7 @@
|
||||||
|
name=Protocol-Zebra-Label
|
||||||
|
version=0.001
|
||||||
|
license=None
|
||||||
|
copyright_holder=Stuifzand Software
|
||||||
|
|
||||||
|
|
||||||
|
[@Basic]
|
132
lib/Protocol/Zebra/Label.pm
Normal file
132
lib/Protocol/Zebra/Label.pm
Normal file
|
@ -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
|
||||||
|
|
||||||
|
|
25
t/label.t
Normal file
25
t/label.t
Normal file
|
@ -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();
|
||||||
|
|
Loading…
Reference in New Issue
Block a user