Perl CGIを使用してZebraラベルを印刷する

Question

ZebraラベルをPerl CGIから印刷する際に問題が発生します。また、コマンドラインからプログラムを実行すると、どちらのサーバでも動作します。サーバーはIIS 7です（笑ってはいけません）。ここで

はコードです：

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; 
} 

私はそれがCGIでソケットを開くとは何かを持って推測しているが、私はそれで経験の全体の多くを持っていません。事前に

おかげで

Answer 1

それは私たちのZebraプリンタはラベルを印刷し、それをロックされ、それが配信された確認するために待機した後に応答を送信していることが判明しました。これまでに働いていた解決策は応答を得ることですが、場合によってはソケットのタイムアウトを短く設定することもあります。また、食物連鎖を立ち上げ、古いソケットライブラリの代わりにIO :: Socketを使用しました：

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; 
}