eed0db7897
The signatures feature has been "experimental" since Perl 5.20 (May 2014), but expected to stay. After 8 years I'm ready to take the risk :) Have added Perl v5.28 (June 2018) as the minimum requirement, even though the current revbank should work with 5.20, to see if this bothers any users. Perl v5.28 is in Debian "buster", which is now oldstable.
49 lines
1.3 KiB
Perl
49 lines
1.3 KiB
Perl
#!perl
|
|
|
|
|
|
# Ja, het is lelijk. Even snel in elkaar geklust en daarna niet meer naar
|
|
# gekeken. Pech :) -- Juerd
|
|
|
|
|
|
|
|
|
|
sub command :Tab(barcode) ($self, $cart, $command, @) {
|
|
return NEXT if $command ne "barcode";
|
|
|
|
return "Barcode data", \&data;
|
|
}
|
|
|
|
sub data($self, $cart, $input, @) {
|
|
$cart->add(
|
|
-0.07,
|
|
"Barcode <$input>",
|
|
{ is_barcode => 1, barcode_data => $input }
|
|
);
|
|
|
|
return ACCEPT;
|
|
}
|
|
|
|
sub hook_checkout($class, $cart, $username, $transaction_id, @) {
|
|
my @barcodes;
|
|
for my $entry ($cart->entries('is_barcode')) {
|
|
push @barcodes, ($entry->attribute('barcode_data')) x $entry->quantity;
|
|
}
|
|
if (@barcodes) {
|
|
print "\nCheck the following:\n 1. label tape is 12 mm\n 2. printer is on\n 3. wifi is enabled and connected\n\nPress enter to continue.";
|
|
readline STDIN;
|
|
|
|
my $printjob = "";
|
|
|
|
open my $bcgen, "-|", "/home/bar/revlabel/barcode.pl", @barcodes
|
|
or warn "Could not open script 1";
|
|
|
|
local $/;
|
|
my $filenames = readline $bcgen;
|
|
close $bcgen;
|
|
|
|
open my $fh, "| /home/bar/revlabel/ptouch-770-write 12 $filenames | nc -N 10.42.42.222 9100"
|
|
or warn "Couldn't open script 2\n";
|
|
print $fh $printjob;
|
|
close $fh;
|
|
}
|
|
}
|