#!/usr/bin/perl
#
# printd
# 
# print spooling daemon
#
use strict;
use Sys::Syslog;
use Fcntl ':flock';
use lib '/home/mjd/lib';
use MJD::Print;
my %CONF = load_conf($CONFIG);
my $NEXTOP = 0;

open STDERR, ">>", '/tmp/printd.err' if $CONF{debug_printd};
print STDERR "printd $$ running\n" if $CONF{debug_printd};
close STDOUT;
chdir $CONF{spooldir} 
  or die "Couldn't chdir to spool directory $CONF{spooldir}: $!; aborting";
open D, "." or die "Couldn't open .: $!; aborting";
flock D, LOCK_EX | LOCK_NB 
  or exit 0;
print STDERR "Got lock.\n" if $CONF{debug_printd};
mainloop();

sub mainloop {
 MAINLOOP:
  while (1) {
    sleep ($NEXTOP - time()) while $NEXTOP > time();
    %CONF = load_conf($CONFIG);
    my @QUEUE = read_spoold($CONF{spooldir});

    if (@QUEUE == 0) {          # empty queue
#      $NEXTOP = time() + 2;     # try again in two seconds
#      next;
      # It seems there is a race condition here.
      # printd #1 reads the queue and finds that it is empty.
      # The someone prints a document, which writes a new queue item
      # and starts printd #2.  printd #2 exits because printd #1 is 
      # still running.  Then printd #1 exits because the queue was empty.
      # Now the document is never printed.
      print STDERR "queue empty; exiting\n" if $CONF{debug_printd};
      exit 0;
    }

    my $head = shift @QUEUE;
    unless (unlink $CONF{curfile}) {
      if ($! !~ /no such file/i) {
        die "Couldn't unlink $CONF{curfile}: $!; aborting";
      }
    }
    symlink $head, $CONF{curfile} or
      temp_error("Couldn't symlink $head to $CONF{curfile}: $!", 30);
    print STDERR "current job is now $head\n" if $CONF{debug_printd};

    unless (open FILE, $CONF{curfile}) {
#      system ("ls -l");
      die "Couldn't open spool file $head ($CONF{curfile}): $!; aborting";
    }
    my $pid;
    if ($pid = fork()) {               # parent
      wait;
      handle_printlp_result($? >> 8) if $? != 0;
    } elsif (defined $pid) {    # child
      open STDIN, "< &=FILE" or exit 8;
      close FILE;
      close STDOUT;
      print STDERR "exec-ing $CONF{printlp}, $CONF{printer}\n" 
          if $CONF{debug_printd};
      exec $CONF{printlp}, $CONF{printer};
      exit 9;
    } else {                    # fork error
      log_error("Couldn't fork for $CONF{printlp}: $!");
    }
    close FILE
      or log_error("Couldn't close spool file $head: $!");
    until (unlink $head) {
      log_error("Couldn't unlink spool file $head: $!!!");
      sleep 10;
    }
    unlink $CONF{curfile};
  }
}

sub read_spoold {
  my $dir = shift;
  local *SPOOLD;
  unless (opendir SPOOLD, $dir) {
    temp_error("Couldn't read spool directory $dir: $!", 10);
  }
  my @f = grep $_ ne $CONF{curfile}, grep !/^\./, readdir SPOOLD;
  print STDERR "queue contains ", scalar(@f), " items\n" 
    if $CONF{debug_printd};
  map $_->[0], sort { $b->[1] <=> $a->[1] } map [$_, -M], @f;
}

# temp_error 
# Something has gone wrong that prevents printing. Log a message with
# syslog and then suspend operations temporarily; try again later
#
# args: $message: message to log
#       $delay: time to wait before trying again
sub temp_error {
  my ($message, $delay) = @_;
  ###XXX TODO log the $message
  warn "printd: $message\n";

  $NEXTOP = time() + $delay;
  next MAINLOOP;
}

sub log_error {
  print STDERR "ERROR: @_\n";
  exit 1;
}

sub handle_printlp_result {
  my @errors = ('No error',
                'printer argument missing',
                'printer argument malformed',
                'printer file is not a character device',
                'group is not lp',
                'couldn\'t open printer device',
                'read error',
                'write error',
                'RESERVED',
                'exec failure',
                );
  my $err = shift;
  temp_error("printlp failed: ($err: $errors[$err])", 10);
}