#!/usr/bin/perl
#$debug = 1;
##$fakeit = 1; # just fake opening of printer etc
while ( $#ARGV >= 0 ) {
  if ( $ARGV[0] eq "-d" ) { $debug = 1; }
  elsif ( $ARGV[0] eq "-spool" ) { $spooler = 1; }
  elsif ( $ARGV[0] eq "-cancel" ) { $cancel = 1; }
  elsif ( $ARGV[0] eq "-verify" ) { $verify = 1; }
  elsif ( $ARGV[0] eq "-daemon" ) { $daemon = 1; }
  else { die("Unknown option $ARGV[0]"); }
  shift(@ARGV);
}

# try to connect to an existing spooler daemon listening on 9100.
# If none, fork, become one, and retry.
$try = 0;
$| = 1;
use Socket;
while ( !$fakeit && $try++ < 2 ) {
  socket(PRINTER, PF_INET, SOCK_STREAM, getprotobyname('tcp'))
    or die("Unable to create socket");
  $sin = sockaddr_in(9100,inet_aton("192.168.0.150"));
  if ( connect(PRINTER,$sin) ) {
    last;
  } else {
    if ( $try == 2 ) {
      print STDERR "Unable to connect to spooler daemon\n";
      exit(1);
    }
    &start_daemon;
    sleep(2);
  }
}
if ( $daemon ) { exit(0); }

if ( $0 =~ /spool/ ) { $spooler = 1; }

if ( $cancel ) {
  $ccmd = "\@RCL3\001";
  $cpkt = "\002\002\006\000" . $ccmd . "\003";
  syswrite(PRINTER,$cpkt);
  read_printer();
} elsif ( $verify ) {
  $ccmd = "\@RCL4\000";
  $cpkt = "\002\002\006\000" . $ccmd . "\003";
  syswrite(PRINTER,$cpkt);
  read_printer();
} elsif ( $spooler ) {
  # take packetized input on stdin and send it to printer
  my($packet,$pstat,$delay,$error,$ready);
  # get printer status at start of job
  $data = $fakeit ? "" : get_status();
  ($online,$error,$generaltext,$cassettetext,$errortext) =
    parse_status($data);
  print STDERR join("\n",$generaltext,$cassettetext,$errortext,$errortext ? "\007" : ());
  while ( 1 ) {
    # get packet of data
    $packet = read_packet(STDIN);
    if ( ! defined($packet) ) {
      print STDERR "eof/error reading packet\n" if $debug;
      last;
    }
    # if it's a reset packet, hang on to it until the printer's idle
    if ( 0 and $packet eq "\002\001\002\000\ee\003" ) {
      $pendingpacket = $packet;
      print STDERR "deferring reset packet\n" if $debug;
      last;
    }
    $delay = 1;
    $errorseen = 0;
    $ready = 0;
    while ( 1 ) {
      if ( $ready ) {
	syswrite(PRINTER,$packet);
	print STDERR "sent packet\n" if $debug;
	print STDERR unpack("H30",$packet),"\n" if $debug;

      } else {
	# check OK to send
	syswrite(PRINTER,"\005\377");
	print STDERR "send enquiry\n" if $debug;
      }
      #select(undef,undef,undef,0.05);
      $pstat = $fakeit ? "\006" : read_printer($ready ? 1 : 0);
      if ( $pstat eq "\006" ) {
	print STDERR "Got ACK\n" if $debug;
	if ( $errorseen ) {
	  print STDERR "Printer OK\n";
	  $errorseen = 0;
	}
	# if it's more than 60 seconds since we last got status,
	# get it
	$now = time;
	if ( $now > $laststattime + 60 ) {
	  $laststattime = $now;
	  $pstat= get_status();
	  ($online,$error,$generaltext,$cassettetext,$errortext,$shorttext) =
	    parse_status($data);
	  print STDERR $shorttext,"\n";
##	  print STDERR join("\n",$generaltext,$cassettetext,$errortext,$errortext ? "\007" : ());
	}
	if ( $ready ) {
	  last; # exit retry loop
	} else {
	  # printer is ready, so now send the packet
	  $ready = 1;
	  next;
	}
      } elsif ( $pstat eq "\010" ) {
	print STDERR "Got BUSY\n" if $debug;
	select(undef,undef,undef,0.1*$delay++); # 100ms to 1s sleep
      } elsif ( $pstat eq "\025" ) {
	print STDERR "Got NAK\n" if $debug;
	$pstat= get_status();
	($online,$error,$generaltext,$cassettetext,$errortext) =
	  parse_status($data);
	print STDERR join("\n",$generaltext,$cassettetext,$errortext,$errortext ? "\007" : ());
	$errorseen = 1;
	sleep(15);
      } else {
	print STDERR "bad or no ACK - skipping\n" if $debug;
	last;
      }
    }
  }
  # if we get here, we're waiting for the printer to finish.
  # read status every 15 seconds until idle - print it on error
  print STDERR "waiting for printer to finish\n" if $debug;
  while ( 1 ) {
    $data = $fakeit ? "" : get_status();
    if ( !defined($data) ) { die "can't get status"; }
    ($online,$error,$generaltext,$cassettetext,$errortext) =
      parse_status($data);
    if ( $error ) {
      print STDERR "error condition\n" if $debug;
      print join("\n",$generaltext,$cassettetext,$errortext,$errortext ? "\007" : ());
    } elsif ( $generaltext =~ /Phase: idle/ ) {
      print STDERR "printer idle\n" if $debug;
      print join("\n",$generaltext,$cassettetext,$errortext,$errortext ? "" : ());
      if ( $pendingpacket ) { syswrite(PRINTER,$pendingpacket); }
      print STDERR "exiting\n" if $debug;
      exit(0);
    }
    sleep(15);
  }
} else {
  # get status and print it until eof on input
  while ( 1 ) {
    $data = $fakeit ? "" : get_status();
    if ( !defined($data) ) { die "can't get status"; }
    ($online,$error,$generaltext,$cassettetext,$errortext) =
      parse_status($data);
    print join("\n",$generaltext,$cassettetext,$errortext,$errortext ? "\007" : ());
    $_ = <STDIN>;
    last if ! $_;
  }
}

# read some data from the printer
# the argument is the maximum number of read attempts, defaulting to 10
sub read_printer {
  my($cnt,$ans,$n,$max);
  $max = $_[0];
  if ( ! $max ) { $max = 10; }
  # loop until reply comes back
  $cnt = 0;
  $delay = 0.1;
  $ans = '';
  # mybook appears to return EAGAIN (11) for nonblock read
  while ( (defined($n = sysread(PRINTER,$ans,1024)) || $! == 11 ) && $n == 0 && ++$cnt < $max ) { 
    print STDERR "sysread returned $n on try $cnt\n" if $debug;
    select(undef,undef,undef,$delay); # 100ms to 1s sleep
    $delay *= 1.5;
  };
  if ( !defined($n) ) { 
    printf STDERR "sysread error: (%d) $!\n",$!+0 ;
    return undef;
  }
  return $ans;
}

# enquire printer status. Returns an unpacked status sequence
sub get_status {
  my($n,$cnt,$try);
  for ( $try = 0; $try < 5; $try++ ) {
    $n = syswrite(PRINTER,"\005\001");
    if ( $n < 2 ) {
      print STDERR "couldn't write enquiry command: syswrite: $!";
      return undef;
    }
    $ans = read_printer();
    $n = length($ans);
    if ( $n == 0 ) { 
      print STDERR "get_status: no response, retrying command\n";
      next;
    }
    print STDERR "read $n bytes\n" if $debug;
    print STDERR unpack("H*",$ans),"\n" if $debug;
    $data = unpack_packet($ans);
    if ( !defined($data) ) {
      print STDERR "get_status: error decoding status packet\n" ; 
      return undef;
    }
    return $data;
  }
  print STDERR "get_status: no response from printer\n";
  return undef;
}

# this routine parses the contents of a status packet
# and prints an appropriate message
# Its arg is the contents, not the packet.
# It returns an array of boolean and also strings giving status info in
# human readable form, as follows:
#  online: 1 if online
#  error: 1 if error/alarm
#  generaltext: general status info string
#  cassettetext: cassette status string
#  errortext: error status string
#  shorttext: abbreviated (one line) status string
# It returns undef on unexplained errors.
sub parse_status {
  my ($b,@b,$p,$i,$e,$f,@e,$cart,$stat,$rstat,$high,$low);
  my($online,$error,$generaltext,$cassettetext,$errortext,$shorttext);
  # is this an MD5k packet (33 bytes) or earlier (11 bytes)
  my($pre5k) = 0;
  if ( length($_[0]) == 11 ) {
    $pre5k = 1;
  } elsif ( length($_[0]) != 33 ) {
    print STDERR "parse_status: Unknown status packet";
    return undef;
  }
  # names of cassette holders
  my(@holders);
  if ( $pre5k ) {
    @holders = ("holder 1", "holder 2", "holder 3", "holder 4" );
  } else {
    @holders = ( "1 upper ", "2 upper ", "3 upper ", "4 upper ",
		  "1 lower ", "2 lower ", "3 lower ", "4 lower " );
  }
  @b = unpack("C*",$_[0]);
  $b = shift @b;
  for ( $i = 0 ; $i < 8; $i++ ) { $p[$i] = ($b & (1<<$i));}
  $generaltext .= "Status: " . ($p[7] ? "off" : "on") . "-line\n";
  $online = ! $p[7];
  if ( $p[7] ) {
    $generaltext .= "Off-line status: " . ($p[6] ? "error/alarm" : "switched off-line") . "\n";
    $error = $p[6];
  }
  $shorttext = $online ? "On-line" : $error ? "Error" : "Off-line";
  $generaltext .= "Feed position: " . ($p[4] ? "auto" : "manual") . "\n";
  $generaltext .=  "Phase: " . ($p[3] ? "printing" : "idle") . "\n";
  if ( $p[3] ) { $shorttext .= ", printing"; }
  $shorttext .= ". ";
  if ( $p[3] ) {
    $generaltext .= "Mode: " . ($p[2] ? ($p[1] ? "(reserved)" : "text") : ($p[1] ? "PDM" : "RGL")) . "\n";
  }
  $generaltext .= "Buffer: " . ($p[0] ? "not empty" : "empty") ;
  $cassettetext .= "Ribbon holder status:\n";
  foreach $cart ( @holders , "carriage" ) {
    $cassettetext .= "  $cart: ";
    $stat = shift @b;
    if ( ! $pre5k ) {
      $low = shift @b;
      $high = shift @b;
    }
    $rstat = $stat >> 6 ;
    $shorttext .= " ";
    if ( $rstat == 0 ) {
      $cassettetext .= ($barcodes[$stat & 0x03F] 
			|| ("Unknown(" . ($stat & 0x03) . ")")) . " ";
      $shorttext .= ($shortbarcodes[$stat & 0x03F] || ($stat & 0x03F)) ;
    }
    # empirically, code 01 appears to mean reversed ribbon, although
    # it's reserved in the manual
    $cassettetext .= ( ("", "**ribbon reversed**", "**end of ribbon**", "empty")[$rstat]);
    $shorttext .= ( ("", "*R", "*E", "--")[$rstat]);
    if ( $rstat == 0 && ! $pre5k ) {
      $cassettetext .= ($high ? "***broken ribbon***" :
	     ($low ? "($low)" : "(--)"));
      $shorttext .= ($high ? "(*B)" :
	     ($low ? "($low)" : "(--)"));
    }
    $cassettetext .= "\n";
  }
  chop($cassettetext); # remove final newline
  $shorttext .= ". ";
  # high-level error status
  @e = @b[0..4];
  $e = $e[0];
  if ( $e & 0x80 ) { 
    $errortext .= "Motor Error: " ;
    $shorttext .= "Motor Error. ";
    $f = $e[4];
    if ( $f & 0x80 ) { $errortext .= "Cassette Changer Motor." ; }
    if ( $f & 0x40 ) { $errortext .= "CR Motor." ; }
    if ( $f & 0x20 ) { $errortext .= "Bail arm Motor."; }
    if ( $f & 0x10 ) { $errortext .= "LF Motor."; }
    if ( $f & 0x08 ) { $errortext .= "Paper Feed Motor." ; }
    if ( $f & 0x04 ) { $errortext .= "Anti-Curl Motor." ; }
  }
  if ( $e & 0x40 ) {
    $errortext .= "Cover Open";
    $shorttext .= "Cover Open. ";
  }
  if ( $e & 0x01 ) {
    $errortext .= "EEPROM Error";
    $shorttext .= "EEPROM Error. ";
  }
  $e = $e[1];
  if ( $e & 0x80 ) {
    $f = $e[2];
    $errortext .= "Out of Paper: ";
    $shorttext .= "Out of Paper. ";
    if ( $f & 0x80 ) {
      $errortext .= "wrong size paper in ";
    } else {
      $errortext .= "no paper in ";
    }
    if ( $f & 0x40 ) {
      $errortext .= "manual input";
    } else {
      $errortext .= "tray";
    }
  }
  if ( $e & 0x40 ) {
    $f = $e[2];
    $errortext .= "Paper Jam: ";
    $shorttext .= "Paper Jam. ";
    if ( $f & 0x08 ) {
      $errortext .= "paper eject error in ";
    } else {
      $errortext .= "paper misfeed in ";
    }
    if ( $f & 0x04 ) {
      $errortext .= "manual input";
    } else {
      $errortext .= "tray";
    }
  }
  if ( $e & 0x22 ) {
    $f = $e[3];
    $errortext .= (($e & 0x20) ? "Ribbon End: " : "Ribbon Break: ");
    $shorttext .= (($e & 0x20) ? "Ribbon End. " : "Ribbon Break. ");
    my($i) = $pre5k ? 0x10 : 0x01 ;
    foreach $cart ( @holders ) {
      if ( $f & $i ) { $errortext .= $cart ; }
      $i *= 2;
    }
  }
  if ( $e & 0x10 ) {
    $f = $e[3];
    $errortext .= "Cassette Error: ";
    $shorttext .= "Cassette Error. ";
    $errortext .= (("(Reserved)", "(Reserved)", 
	    "Cassette Occupied", "Ribbon Mismatch")[($f & 0x7) >> 1]);
    if ( ($f & 0x6) == 0x6 ) {
      $errortext .= " (" . $barcodes[$f >> 3] . ")";
    }
  }
  if ( $e & 0x04 ) {
    $errortext .= "Memory Overflow";
    $shorttext .= "Memory Overflow. ";
  }
  return ($online,$error,$generaltext,$cassettetext,$errortext,$shorttext);
}

# unpack a packet, returning undef on error
sub unpack_packet {
  my($p) = $_[0];
  # the following is very nice, but it requires a very recent perl
  # my($stx,$cmd,$data,$etx) = unpack('CCv/a*C',$p);
  my($stx,$cmd,$len,$pp) = unpack('CCva*',$p);
  my($data,$etx) = unpack("a${len}C",$pp);
  if ( $stx != 0x02 || $etx != 0x03 ) {
    print STDERR "unpack_packet: malformed packet\n";
    return undef;
  }
  return $data;
}

# read a packet from the filehandle named in the arg.
# cumulates packets to give about 8k of data
# return undef on error or eof
# Now extended so that it recognizes whether the input is
# packetized or not, and deals with it appropriately
BEGIN {
 my($savedstx,$savedcmd,$savedlenl,$savedlenh);
 my($packetized) = undef;
sub read_packet {
  my($f) = $_[0];
  my($cumulateddata,$cumulatedlen);
  my($stx);
  my($cmd);
  my($lenl);
  my($lenh);
  my($etx);
  my($len);
  while ( 1 ) {
    if ( !defined($packetized) ) {
      print STDERR "format not yet known..." if $debug;
      $stx = getc($f);
      if ( ord($stx) == 0x02 ) {
	$packetized = 1;
	print STDERR "is packetized\n" if $debug;
	$savedstx = $stx;
	$savedcmd = getc($f);
	$savedlenl = getc($f);
	$savedlenh = getc($f);
      } elsif ( ord($stx) == 0x1B ) {
	$packetized = 0;
	print STDERR "is unpacketized\n" if $debug;
	$cumulateddata = $stx;
	$cumulatedlen = 1;
	$stx = chr(0x02);
	$cmd = chr(0x01);
	$etx = chr(0x03);
      } else {
	print STDERR "Unknown data format on $f\n";
	return undef;
      }
    } elsif ( $packetized ) {
      if ( $savedstx ) { 
	$stx = $savedstx;
	$cmd = $savedcmd;
	$lenl = $savedlenl;
	$lenh = $savedlenh;
	printf "Savedstx, setting stx %d cmd %d lenl %d lenh %d\n",
	  ord($stx), ord($cmd), ord($lenl), ord($lenh) if $debug;
	undef $savedstx;
      } else { 
	my($c) = getc($f);
	if ( ! defined($c) ) { last; }
	$stx = $c;
	$cmd = getc($f);
	$lenl = getc($f);
	$lenh = getc($f);
	printf "no saved stx, setting stx %d cmd %d lenl %d lenh %d\n",
	  ord($stx), ord($cmd), ord($lenl), ord($lenh) if $debug;
      }
      if ( ! defined($stx) ) { last ; }
      if ( ord($stx) != 0x02 ) { 
	print STDERR "read_packet: bad packet start on $f\n"; 
	return undef;
      }
      $len = ord($lenl)+256*ord($lenh);
      if ( $cumulatedlen + $len > 8192 ) {
	$savedstx = $stx;
	$savedcmd = $cmd;
	$savedlenl = $lenl;
	$savedlenh = $lenh;
	last;
      }
      my($data);
      my($n) = read($f,$data,$len);
      if ( $n != $len ) {
	print STDERR "read_packet: short read on $f\n";
	return undef;
      }
      $etx = getc($f);
      if ( ord($etx) != 0x03 ) { 
	print STDERR "read_packet: bad packet end on $f\n"; 
	return undef;
      }
      $cumulateddata .= $data;
      $cumulatedlen += $len;
    } else { # not packetized
      my($n,$data);
      $n = read($f,$data,8192-$cumulatedlen);
      $cumulateddata .= $data;
      $cumulatedlen += $n;
      if ( $n == 0 || $cumulatedlen == 8192 ) {
	print STDERR "read $n bytes (unpacketized) from input\n" if $debug;
	last;
      }
    }
  }
  if ( !defined($cumulateddata) ) { return undef; }
  printf "stx %d, cmd %d, cumlen %d\n", ord($stx), ord($cmd), $cumulatedlen if $debug;
  return $stx . $cmd . chr($cumulatedlen & 0xFF) . chr($cumulatedlen >> 8) . $cumulateddata . $etx;
}
}
BEGIN {
  @barcodes = (
	       "Black",
	       "Yellow",
	       "Magenta",
	       "Cyan",
	       "MultiColour",
	       "GoldFoil",
	       "SilverFoil",
	       "Unknown(7)",
	       "MetallicGold",
	       "MetallicMagenta",
	       "MetallicCyan",
	       "MetallicSilver",
	       "Unknown(12)",
	       "Yellow(OHP)",
	       "Magenta(OHP)",
	       "Cyan(OHP)",
	       "White",
	       "Finish",
	       "VPhotoPrimer",
	       "FinishII",
	       "LabecaBlack",
	       "LabecaBlue",
	       "LabecaRed",
	       "EconoBlack",
	       "Unknown(24)",
	       "Yellow(DyeSub)",
	       "Magenta(DyeSub)",
	       "Cyan(DyeSub)",
	       "Overcoat(DyeSub)",
	       "Unknown(29)",
	       "OvercoatII(DyeSub)",
	       "Unknown(31)",
	       "Unknown(32)"
	      );
  @shortbarcodes = (
	       "K",
	       "Y",
	       "M",
	       "C",
	       "MC",
	       "GF",
	       "SF",
	       "7",
	       "MG",
	       "MM",
	       "MC",
	       "MS",
	       "12",
	       "OY",
	       "OM",
	       "OC",
	       "W",
	       "F1",
	       "P",
	       "F2",
	       "LK",
	       "LB",
	       "LR",
	       "EB",
	       "24",
	       "DY",
	       "DM",
	       "DC",
	       "DO1",
	       "29",
	       "DO2",
	       "31",
	       "32"
	      );
}


sub start_daemon {
  # become a daemon
  if ( fork() ) {
    return;
  }
  close(STDIN);
  close(STDOUT);
  open(STDERR,">/tmp/spoolerrors");
  $n = sysopen(PRINTER,"/dev/usblp0",0002) || die("unable to open /dev/lp0: $!");
  print STDERR "sysopen return $n\n" if $debug;
  socket(SOCKET,PF_INET,SOCK_STREAM,getprotobyname('tcp'))
    or die("socket");
  $sin = sockaddr_in(9100,INADDR_ANY);
  bind(SOCKET,$sin) or die("bind");
  listen(SOCKET,5) or die("listen");
  while ( 1 ) {
    accept(COM,SOCKET) or die("accept");
    while ( 1 ) {
      $rin = $win = $ein = '';
      vec($rin,fileno(PRINTER),1) = 1;
      vec($rin,fileno(COM),1) = 1;
      $ein = $rin;
      select($rin,undef,$ein,undef);
      if ( vec($ein,fileno(PRINTER),1) ) {
	print STDERR "error on printer pipe\n";
	exit(1);
      }
      if ( vec($ein,fileno(COM),1) ) {
	print STDERR "error on socket\n";
	exit(1);
      }
      if ( vec($rin,fileno(PRINTER),1) ) {
	$n = sysread(PRINTER,$data,1024);
	if ( $n == 0 ) {
	  print STDERR "eof on printer!";
	  exit(1);
	}
	syswrite(COM,$data);
      }
      if ( vec($rin,fileno(COM),1) ) {
	$n = sysread(COM,$data,65512);
	if ( $n == 0 ) {
	  close(COM);
	  last;
	}
	syswrite(PRINTER,$data);
      }
    }
  }
}