[MacPerl] LPD-submit.pl

["Peter Van Avermaet, SI-FABS @BRO, 856-7959 17-Jan-1996 0930 +0100"<vanavermaet@player.enet.dec.com>]

Hello,

I submitted a Perl script that behaves as an LPD client, some time ago.
This is a new version, implementing a number of suggestions from you, folks.
I am submitting this now, because I will soon leave this situation (of sitting
at a Mac with TCP/IP and with access to an LPD server).
Things I have not done yet, and that I dream of:
- multiple input files, and drag-and-drop for the Mac;
- PostScript sensing, and automatic choice between a PostScript queue and a
'plain' queue.
Remember that my host-address and queue-nqme of MY LPD-server are hardcoded in
this script.


Regards,
Peter Van Avermaet

# LPD-submit.pl
# This Perl script is a small client of the LPD protocol.
# It is intended to demonstrate the protocol,
#  not to be a product-quality LPD client.
# It can run on Mac and on Unix.
# For the LPD protocol itself:
#  refer to RFC1179
# Textbook: UNIX Network Programming, W. Richard Stevens, 
#  Prentice Hall, ISBN 0-13-949876-1
# (Chapter 13 in the 1990 edition)
# Interesting hints from GUSI.ph in the MacPerl distribution.
#
# Written by Peter Van Avermaet
# Version 16 January 1996
# Changes:
#  Finds own hostname
#  Finds username
#  Smarter about job-name (last 30 chars)
#  Re-shuffled some code

# get own hostname (or address)
# in case of Mac: this works if you have a recent version of MacPerl
#  (4.1.8 or better)
$thishost = `hostname` || die "get hostname: $!";
chop($thishost);
print "hostname is ",$thishost,"\n";

if ($thishost =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/){
  $cltadr = pack('C4',$1,$2,$3,$4);
} else {
  local(@x) = gethostbyname($thishost);
  $cltadr = $x[4];
};

# get own username
# in case of Mac: must have XFCN ChooserName in resource-fork
if($MacPerl'Version){
  $file = $0;
  &MacPerl'DebugExternals(2);
  &MacPerl'LoadExternals($file);
  $user = &ChooserName;
}else{
  $user = $ENV{'USER'};
};
print "user is ",$user,"\n";

# get hostname (or address) of LPD server
# in case of Mac: hard-coded
# in case of Unix: 1st argument
if($MacPerl'Version){
  $svr = '162.1.3.204';# uchsd01
}else{
  $svr = @ARGV[0];
  shift;
};
print "LPD server host is ", $svr, "\n";

if ($svr =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/){
  $svradr = pack('C4',$1,$2,$3,$4);
} else {
  local(@x) = gethostbyname($svr);
  $svradr = $x[4];
};

# get name of print queue (as defined on LPD server)
# in case of Mac: hard-coded
# in case of Unix: 2nd argument
if($MacPerl'Version){
  $queue = 'lp0';
}else{
  $queue = @ARGV[0];
  shift;
};
print "queue is ", $queue, "\n";

# get name of file
# in case of Mac: file-select dialog (we could add drag-and-drop)
# in case of Unix: 3rd argument
if($MacPerl'Version){
  $templ = pack("s",1) . "TEXT";
  $file = choose (4, 0, "", $templ);
}else{
  $file = @ARGV[0];
  shift;
};
print "file is ", $file, "\n";

$size = -s $file;
print "size is ", $size, "\n";

# some arithmetic with starting date & time
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);

# build a sequence-number - this algorithm is a hack -
#  we ought to have a sequence-number that is unique among all
#  pending requests from this client
$seqno = $min * 60;
$seqno = $seqno + $sec +100; # must have at least 3 digits
$seqno = $seqno - int($seqno/1000) * 1000;
print "sequence number is ",$seqno,"\n";

socket (SOC, 2, 1, 6) || die "socket: $!";

# bind a socket on the client side
# we assume that this is not possible on a Unix machine
# (you need privilege)
# if you do not bind a socket on the client side,
#  some servers may refuse you
# (they expect a connect from a privileged socket)
if($MacPerl'Version){
  $here = pack('S n a4 x8',2,515,$cltadr);
  bind (SOC,$here) || die "bind: $!";
};

$dest = pack('S n a4 x8',2,515,$svradr);

connect (SOC, $dest) || die "connect: $!";

$cmd = "\002" . $queue . "\012";
send(SOC,$cmd,0) || die "send request $!";
recv(SOC,$status,1,0);
if ($status ne "\000"){die "server refuses after: send request $!";};

$cmd = "\003" . $size . " dfA" . $seqno . "" . $thishost . "\012"; # RDF
send(SOC,$cmd,0) || die "send data header $!";
recv(SOC,$status,1,0);
if ($status ne "\000"){die "server refuses after: send data header $!";};

open(FH,$file) || die "open file $!";
$toread = $size;
while($toread > 0){
  $chunk = $toread;
  if ($chunk > 512) {$chunk = 512;};
  read(FH,$buf,$chunk) || die "read from file $!";
  send(SOC,$buf,0) || die "send data record $!";
  $toread = $toread - $chunk;
}  
close(FH);

send(SOC,"\000",0) || die "send end of data $!";

recv(SOC,$status,1,0);
if ($status ne "\000"){die "server refuses after: send end of data $!";};

# job-name: RFC says max 31 characters,
#  but HP LJ printers seem to truncate to 30
if (length($file) > 30){
  $jobname = substr($file,-30);
}else{
  $jobname = $file;
};

$cmd1 = "H" . $thishost . "\012"
 . "C" . $thishost . "\012"
 . "L" . $user . "\012"
 . "P" . $user . "\012"
 . "M" . $user . "\012"
 . "J" . $jobname . "\012"
 . "N" . $jobname . "\012"
 . "fdfA" . $seqno . "" . $thishost . "\012"
 . "UdfA" . $seqno . "" . $thishost . "\012";
$cmd = "\002" . length($cmd1) . " cfA" . $seqno . "" . $thishost . "\012";

send(SOC,$cmd,0) || die "send control header $!"; # RCF
recv(SOC,$status,1,0);
if ($status ne "\000"){die "server refuses after: send control header $!";};

$cmd1 = $cmd1 . "\000";
send(SOC, $cmd1,0) || die "send control $!";
recv(SOC,$status,1,0);
if ($status ne "\000"){die "server refuses after: send control $!";};

close SOC || die "close: $!";

print "finished\n";
exit;