Printing Zebra Labels using Perl CGI - perl

Question

I am having issues printing Zebra labels from a Perl CGI, where it works on one server but not another. Also, if I run the program from the command line it works on either server. The servers are IIS 7 (don't laugh it's what I'm stuck using).
Here is the code:
use strict;
use Socket;
use CGI qw(:cgi-lib);
use CGI::Carp qw ( fatalsToBrowser );
my %formdata = Vars;
print "Content-type: text/html\r\n\r\n";
# to test running from the command line, hardcode the paramters normally passed from the web interface
# comment these out when running CGI
$formdata{printer} = "zebraprinter.mycompany.com";
$formdata{serials} = "TR16170003|Gerry's Product TR|This is a generic product where all serial numbers start with the letters TR|T~";
# initialize server and port
my $port = 9100;
# create the socket, connect to the port
socket(SOCKET,PF_INET,SOCK_STREAM,(getprotobyname('tcp'))[2]) or myExit("Can't create a socket $!\n");
connect( SOCKET, pack_sockaddr_in($port, inet_aton($formdata{printer}))) or myExit("Can't connect to port $port! \n");
foreach my $serial(split("~", $formdata{serials}))
{
my #ar = split(/\|/, $serial);
my $line;
if ($formdata{printer} =~ /label2/) # small labels
{
$line = "^XA^PRA,A,A^LH5,5^FO10,10^BCN,50,N,N,N,D^FD$ar[0]^FS";
$line .= "^FO300,10^AD,15,12^FDSerial Number:^FS";
$line .= "^FO300,30^AD,15,12^FD$ar[0]^FS^XZ";
}
else # large labels
{
$line = "^XA^PRA,A,A^LH20,20";
$line .= "^FO20,40^FWN^AT,60,10^FD Serial Number: $ar[0]^FS";
$line .= "^FO20,120^FWN^AT,60,10^FD $ar[1]^FS";
# need to hard break and limit long lines
if (length($ar[2]) > 60)
{
my $part = substr($ar[2],0,60);
$line .= "^FO20,200^FWN^AT,60,10^FD Description: $part^FS";
$part = substr($ar[2],61,74);
$line .= "^FO20,260^FWN^AT,60,10^FD$part^FS";
$line .= "^FO50,340^B3N,N,100,Y,N^FD$ar[0]^FS";
}
else
{
$line .= "^FO20,200^FWN^AT,60,10^FD Description: $ar[2]^FS";
$line .= "^FO50,280^B3N,N,100,Y,N^FD$ar[0]^FS";
}
$line .= "^XZ";
# example formatted label
#$line = qq~^XA^PRA,A,A^LH20,20^FO20,40^FWN^AT,60,10^FD Serial Number: $ar[0]^FS^FO20,120^FWN^AT,60,10^FD Product: $ar[1]^FS^FO20,200^FWN^AT,60,10^FD Description: $ar[2]^FS^FO50,280^B3N,N,100,Y,N^FD$ar[0]^FS^XZ~;
}
print SOCKET $line;
}
close SOCKET;
myExit("Labels Printed.");
sub myExit
{
my $msg = shift;
print "<script>alert('$msg')</script>";
exit;
}
I'm guessing it has something to do with opening sockets in a CGI but I don't have a whole lot of experience with that.
Thanks in advance

Answer 1

It turns out that our Zebra printer is sending a response after printing labels and waiting to verify it was delivered, which locked it up. The solution that is working so far is to get the response but also set a short timeout on the socket just in case. Also went up the food chain and used IO::Socket instead of the old Socket library:
use strict;
use IO::Socket;
use CGI qw(:cgi-lib);
use CGI::Carp qw ( fatalsToBrowser );
my %formdata = Vars;
print "Content-type: text/html\r\n\r\n";
# to test running from the command line, hardcode the paramters normally passed from the web interface
# comment these out when running CGI
$formdata{printer} = "zebralabel1.mycompany.com";
$formdata{serials} = "TR16170003|Gerry's Product TR|This is a generic product where all serial numbers start with the letters TR|T~";
# create the socket, connect to the port
my $remote = IO::Socket::INET->new(
Proto => 'tcp',
PeerAddr=> "$formdata{printer}",
PeerPort=> "9100",
ReuseAddr=> 0,
Timeout => 2,
) or myExit("Cannot connect to printer: $!");
$remote->autoflush(1); # Send immediately
my ($serial, $product, $desc) = split(/\|/, $formdata{serials});
# example formatted label
my $line = qq~^XA^PRA,A,A^LH20,20^FO20,40^FWN^AT,60,10^FD Serial Number: $serial^FS^FO20,120^FWN^AT,60,10^FD Product: $product^FS^FO20,200^FWN^AT,60,10^FD Description: $desc^FS^FO50,280^B3N,N,100,Y,N^FD$serial^FS^XZ~;
print $remote $line;
my $dontCare = <remote>;
close $remote;
myExit("Labels Printed.");
sub myExit
{
my $msg = shift;
print "<script>alert('$msg')</script>";
exit;
}