#!/usr/bin/perl
#
# print
#
# tool for spooling files
#
# Idea: Ready-to-print files are deposited in the spool directory
# These must be in the right format.
# The job of 'print' is to convert the file to the right format
# and then copy it to the spool directory
#
use strict;
use File::Copy;
use Getopt::Std;
use lib '/home/mjd/lib';
use MJD::Print;
use vars qw($opt_t $opt_n $opt_v $opt_s $opt_b);
umask 077;
my @TMPFILES = ();

# Options
#  -t TYPE     assume file type is TYPE instead of heristic
#  -s          do not spool or start printer daemon
#  -v          verbose mode
#  -n number   number of copies to print (default 1)
#  -b          run in background, returning immediately
getopts('n:vt:sb') or usage();
$opt_v ||= $opt_s;
my $NCOPIES = $opt_n || 1;
# my %CONF = load_conf("/etc/printd.conf");
my %CONF = load_conf($CONFIG);  
my $tempdir = mktempdir();
unless (@ARGV) {
  push @ARGV, save_stdin();
}

if ($opt_b) {
  fork && exit;
}

1;
1;
1;

FILE:
for my $file (@ARGV) {
  unless (-e $file) {
    warn "No such file: $file; skipping\n";
    next;
  }
  my $type = defined($opt_t) ? $opt_t : file_type($file);
  while (is_compressed($type)) {
    warn "File is compressed\n" if $opt_v;
    $file = convert($file, 'uncompressed', decompress_command($type));
    next FILE unless defined $file;
    $type = file_type($file);
  }

  if ($type eq '???') {
    die "I can't figure out what type of data is in that file.\n";
  }
  my @path = conversion_path($type, $CONF{printable});
  warn "Conversion path: @path\n" if $opt_v;
  unless (@path) {
    die "I don't know how to convert from file type $type to $CONF{printable}.\n";
  }
  shift @path;          # the first element is the source type

  for my $next_type (@path) {
    $file = convert($file, $next_type, $CONF{"$type\->$next_type"});
    $type = $next_type;
  }
  spool($file) for 1 .. $NCOPIES;
  unlink @TMPFILES;
  @TMPFILES = ();
}



################################################################
#
#

sub spool {
  if ($opt_s) {
    warn "(Not) spooling file\n" if $opt_v;
    return;
  }
  my $file = shift;
  my $spoolfile = make_spool_file_name();
  my $dotfile = $spoolfile;
  unless (copy($file, "$CONF{spooldir}/$dotfile")) {
    die "Sorry, couldn't spool $file: $!; aborting";
  }
  unless (rename "$CONF{spooldir}/$dotfile",  
                 "$CONF{spooldir}/$spoolfile.$CONF{printable}") {
    die "Sorry, couldn't finish spooling $file: $!; aborting";
  }
  run_printd();
}

my $Q;
sub make_spool_file_name {
  join ".", $<, time(), $$, ++$Q;
}

sub run_printd {
  warn "*** Starting daemon: $CONF{daemon}\n" if $opt_v;
  fork && return;
  exec $CONF{daemon};
  die "Couldn't exec daemon $CONF{daemon}: $!\n";
}

sub tempfile {
  my $ext = shift;
  join ".", "$tempdir/tmp", int(rand(10000)), $ext;
}

sub mktempdir {
  my $Q;
  my $base_tempdir = "$CONF{temp}/$<.$$";
  my $tempdir = $base_tempdir;
  until (mkdir $tempdir) {
    if ($! !~ /exists/) {
      die "Couldn't create temporary directory $tempdir: $!";
    }
    $Q++;
    $tempdir = "$base_tempdir.$Q";
  }
  return $tempdir;
}

sub save_stdin {
  my $output = tempfile();
  local *F;

  open F, ">", $output 
    or die "Couldn't open temporary file '$output' for saving stdin: $!";
  my ($nb, $buf);
  while ($nb = read STDIN, $buf, 8192) {
    print F $buf;
  }
  unless (defined $nb) {
    die "Error reading from stdin: $!; aborting";
  }
  close F
    or die "Error closing stdin savefile $output; $!; aborting";
  push @TMPFILES, $output;
  return $output;
}


sub convert {
  my ($input, $new_type, $command) = @_;
  my $output = tempfile($new_type);
  local (*R, *W, *F);

  subst($command, 'I', $input);
  subst($command, 'O', $output);
  
  warn "*** Running command $command\n" if $opt_v;
  unless (system($command) == 0) {
    exit $? if $? & 255;        # catch signals
    warn "command returned failure status $?; skipping";
    return;
  }

  push @TMPFILES, $output;
  return $output;
}

=begin :later

# This is only useful if the conversion command 
# reads stdin and writes stdout.  Deal with it another time.
# The program actually uses convert(), found above.
sub convert_redirect {
  my ($input, $command) = @_;
  my $output = tempfile();
  local (*R, *W, *F);

  unless (pipe(R,W)) {
    die "Couldn't make pipe: $!; aborting";
  }
  open F, "< $input"
    or die "Couldn't read input file $input: $!; aborting";

  my $pid = fork;
  unless (defined $pid) {
    die "Couldn't fork to run command '$command': $!; aborting";
  }

  if ($pid==0) {                   # child
    open STDOUT, "> $output"
      or die "Couldn't redirect stdout to $output: $!.\n";
    open STDIN, "<&=R"
      or die "Couldn't redirect stdin from pipe: $!.\n";
    close F;
    close R;
    close W;
    exec $command;
    die "Couldn't exec command '$command': $!; aborting";
  }

  # parent
  close R;
  my ($nb, $buf);
  while ($nb = read F, $buf, 8192) {
    print W $buf;
  }
  unless (defined $nb) {
    die "Error reading from $input: $!; aborting";
  }
  close W
    or die "Error closing command $command; $!; aborting";
  push @TMPFILES, $output;
  return $output;
}

=end :later

=cut


sub is_compressed {
  my $type = shift;
  return exists $CONF{"$type\->???"};
}

sub decompress_command {
  my $type = shift;
  return $CONF{"$type\->???"};
}


sub conversion_path {
  # Do BFS on configuration information
  my ($s, $d) = @_;
  return ($s) if $s eq $d;
  my @queue = ($s);
  my %conversions;
  for (keys %CONF) { push @{$conversions{$1}}, $2 if /(.*)->(.*)/; }
  my %good_path_to = ($s => []);
  while (@queue) {
    my ($here) = shift @queue;
    for my $next_type (@{$conversions{$here}}) {
      next if exists $good_path_to{$next_type};  # we've been here already
      my $p = [@{$good_path_to{$here}}, $here];
      return @$p, $next_type if $next_type eq $d;
      $good_path_to{$next_type} = $p;
      push @queue, $next_type;
    }
  }
  # no path found
  return;
}


sub file_type {
  my $file = shift;
  local $_ = qx{file -Lb $file};  # -b: Do not prepend filename to output
  /JPEG/ && return 'jpg';
  /GIF/ && return 'gif';
  /HTML/ && return 'html';
  /PostScript/ && return 'ps';
  /HP PCL/ && return 'pcl';
  /(ASCII( English| mail)?|news) text/ && return 'txt';
  /PDF/ && return 'pdf';
  /TeX DVI/ && return 'dvi';
  /gzip/ && return 'gz';
  /compress/ && return 'Z';
  /troff/ && return '3';
  /perl script/ && return 'pl';
  /\w+ script/ && return 'txt';
  /PPM/ && return 'ppm';
  /Microsoft Office/ && return 'doc';
  return '???';
}

sub usage {
  exit 1;
}

sub subst {
  my ($string, $seq, $repl) = @_;
  # Look for %$seq or %$seq:.foo
  # If you see %$seq, replace it with $repl
  # If you see %$seq:foo, replace it with $repl:tfoo
  while ($_[0] =~ /%\Q$seq\E(?::(\.\S+))?/g) {
    my $len = length($&);
    my $pos = pos($_[0])-$len;
    my $repl = $repl;
#    warn "pos=$pos len=$len suff=$1 arg='$_[0]'\n";
    if (defined $1) {
      my $suffix = $1;
      $repl =~ s/\.[^.]*$/$suffix/;
    }
    substr($_[0], $pos, $len) = $repl;
  }
}

END {
  unlink @TMPFILES;
  rmdir $tempdir;
}