#!/usr/bin/perl
use warnings;
use strict;

use CGI;
use CGI::Carp qw(fatalsToBrowser);
use autodie;
use Data::Dump qw(dump);

use lib '/usr/share/koha/lib/';
use C4::Context;

my $q = CGI->new;

my $size  = $q->param('size')	|| 'INA-76x51';
my $width = $q->param('width')	|| 600;

my $barcode = $q->param('barcode') || die "no barcode?";

my $ip = $q->remote_addr;
my $dir = '/srv/Printer-Zebra';

my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare('select barcode, itemcallnumber, itemnumber, stocknumber, materials from items where barcode = ?');
$sth->execute( $barcode );
my @row = $sth->fetchrow_array;
warn "# $barcode = ",dump( @row );
my ( $barcode, $itemcallnumber, $itemnumber, $stocknumber, $materials ) = @row;

$stocknumber ||= $materials;

my ( $call1, $call2, $call3 ) = split(/\s+/, $itemcallnumber, 3);

my $tmp = '/tmp/zebra';
mkdir $tmp unless -e $tmp;

open(my $from, '<',  "$dir/templates/$size.svg");
open(my $to,   '|-', "rsvg-convert --width=$width --format=png --background-color=white | tee $tmp/$barcode.png | pngtopnm > $tmp/$barcode.pnm");
while(<$from>) {
	no warnings 'uninitialized';
	s/100999/$barcode/gs	&& warn "# barcode $barcode\n";
	s/299/$call1/gs		&& warn "# 1: $call1\n";
	s/MMMM/$call2/gs	&& warn "# 2: $call2\n";
	s/mm/$call3/gs		&& warn "# 3: $call3\n";
	s/123456/$itemnumber/gs && warn "# itemnumber: $itemnumber\n";
	s/2014-999/$stocknumber/gs && warn "# stocknumber: $itemnumber\n";

	print $to $_;
}
close($from);
close($to);

system "./pbm2ZPL.pl $tmp/$barcode.pnm 2>/dev/null | rlpr --printhost=$ip --printer=zpl --windows --verbose";

unlink "$tmp/$barcode.pnm";

my $status = `rlpq --printhost=$ip --printer=zpl 2>&1 | tee $tmp/$ip.status`;
die "$status\n" if $status =~ m/error/;

if ( my $return = $q->param('return') ) {
	print $q->redirect( $q->param('return') . '&station=' . $ip );
} else {
	print "Content-type: image/png\r\n\r\n";
	local $/ = undef;
	open(my $fh, '<', "$tmp/$barcode.png");
	print <$fh>;
}