1#!@PERL@ 2eval 'exec @PERL@ -S $0 ${1+"$@"}' 3 if $running_under_some_shell; 4 # this emulates #! processing on NIH machines. 5 # (remove #! line above if indigestible) 6 7 8use strict; 9use English; 10use Socket; 11use LPRng; 12use Sys::Hostname; 13use Getopt::Std; 14 15my( 16 $Printer, $Pc_value, $Debug, $pr, $remote, $port, $option, 17 $options, $SOCK, $line, $prefix, $firstpart, $count, $username, %Args 18); 19 20$| = 1; 21 22$Debug = 0; 23Set_Debug($Debug); 24getopts( "P:", \%Args ); 25Setup_LPRng( %Args ); 26 27# get the printer name 28$Printer = Get_printer_name(%Args); 29if( not $Printer ){ 30 die "missing printer name"; 31} 32 33print "Printer '$Printer'\n" if $Debug; 34 35$Pc_value = Setup_pc_entry( $Printer ); 36 37($pr, $remote, $port ) = Get_remote_pr_host( $Printer, $Pc_value ); 38print "pr '$pr', remote '$remote', port '$port'\n" if $Debug; 39 40$option = 5; 41 42$username = getpwuid($UID); 43 44$SOCK = getconnection( $remote, $port ); 45 46$options = join (" ", @ARGV); 47printf "%d%s %s%s\n", $option, $pr, $username, $options ? (" " . $options) : "" if $Debug; 48printf $SOCK "%c%s %s%s\n", $option, $pr, $username, $options ? (" " . $options) : ""; 49$prefix = ""; 50 51while ( defined( $line = <$SOCK> ) ) { 52 print $line; 53} 54close ($SOCK) or die "close: $!"; 55exit 0; 56