cleanup pnm files, query printer status
[Printer-Zebra.git] / print.cgi
1 #!/usr/bin/perl
2 use warnings;
3 use strict;
4
5 use CGI;
6 use CGI::Carp qw(fatalsToBrowser);
7 use autodie;
8
9 my $q = CGI->new;
10
11 my $size  = $q->param('size') || '105x40';
12 my $width = $q->param('width')    || 832;
13
14 my $print = $q->param('print') || die "no print?";
15
16 my $ip = $q->remote_addr;
17 my $dir = '/srv/Printer-Zebra';
18
19 my ( $barcode, $call1, $call2, $call3, $call4 ) = split(/\s+/, $print, 5);
20
21 my $tmp = '/tmp/zebra';
22 mkdir $tmp unless -e $tmp;
23
24 open(my $from, '<',  "$dir/templates/$size.svg");
25 open(my $to,   '|-', "rsvg-convert --width=$width --format=png --background-color=white | tee $tmp/$barcode.png | pngtopnm > $tmp/$barcode.pnm");
26 while(<$from>) {
27         no warnings 'uninitialized';
28         s/1301272944/$barcode/gs && warn "# barcode $barcode\n";
29         s/##call1##/$call1/gs    && warn "# 1: $call1\n";
30         s/##call2##/$call2/gs    && warn "# 2: $call2\n";
31         s/##call3##/$call3/gs    && warn "# 3: $call3\n";
32         s/##call4##/$call4/gs    && warn "# 4: $call4\n";
33
34         print $to $_;
35 }
36 close($from);
37 close($to);
38
39 system "./pbm2ZPL.pl $tmp/$barcode.pnm | rlpr --printhost=$ip --printer=zpl --windows --verbose";
40
41 unlink "$tmp/$barcode.pnm";
42
43 my $status = `rlpq --printhost=$ip --printer=zpl 2>&1 | tee $tmp/$ip.status`;
44 die "$status\n" if $status =~ m/error/;
45
46 if ( my $return = $q->param('return') ) {
47         print $q->redirect( $q->param('return') . '&station=' . $ip );
48 } else {
49         print "Content-type: image/png\r\n\r\n";
50         local $/ = undef;
51         open(my $fh, '<', "$tmp/$barcode.png");
52         print <$fh>;
53 }
54