#!/usr/bin/env perl
use strict; use warnings; use utf8;

=head1 NAME

notunoconv -- Convert LibreOffice documents

=head1 SYNOPSIS

notunoconv -q -f OUTFORMAT OPTIONS INPUTFILES...

=head1 DESCRIPTION

This is a drop-in replacement in common use cases for the old C<unoconv>,
and can be run concurrently without molesting or depending on
interactive soffice sessions.

Friendly options allow creating password-proteced PDFs or PDF/A files for archiving.

OUTFORMAT is "pdf", "txt", etc.

INPUTFILES may be of any LibreOffice-supported document type.

By default each generated file will have the same pathname as the input file
but with a B<.OUTFORMAT> suffix; an arbitrary output directory or pathname may
be specified with B<-o>.

C<notunoconv> runs a separate instance of soffice (LibreOffice or OpenOffice) 
in "headless" mode using command line options; it does not use UNO directly.

=head1 OPTIONS

=head2 -o --output <directory>/  # Put output(s) here with default names

=head2 -o --output <path>        # Put a single output here (arbitrary path)

=head2 --pdfa                    # Create self-contained PDF/A-3 pdf files for archiving 

=head2 --pw <password>           # Create a password-protected PDF file (may not be PDF/A)

=head2 --prog PROG               # use PROG instead of "soffice"

=head2 -q --quiet                # redirect everything to /dev/null absent errors

=head2 -d --debug                # Show details of what's happening

Z<>

=head1 SOFFICE INSTANCES and CONCURRENCY

Multiple instances of this script may be run concurrently.

Each invocation starts a separate soffice process using a dedicated temporary profile
directory, avoiding myriad problems with concurrency and error reporting.

There is no interference with, or dependency on, unrelated soffice
processes (unlike the old C<unoconv> which commandeered an existing
soffice process if one was running).

A per-user pool of profile directories (in /tmp) is created and re-used
by subsequent invocations, which speeds startup.  The pool size is limited
to the number of CPUs; C<notunoconv> waits if necessary for a slot to become available.

=head1 AUTHOR

Jim Avera   (jim.avera at gmail)

=head1 LICENSE

CC0 / Public Domain

This documentation is from $Revision: 1.8 $

=cut                                                                           q
 
use 5.030;
use feature qw/state say signatures/;
use Getopt::Long qw/GetOptions/;
use Pod::Usage qw(pod2usage);
use List::Util qw/any/;
use Path::Tiny;
use File::Spec::Functions qw/tmpdir/;
use Data::Dumper::Interp qw/qshlist qsh ivis dvis vis u/;
my $progname = path($0)->basename;

# use constant CAN_DETECT_OTHER_POROCESSES => sub{
#   # If /proc is mounted with option hidepid=2 then /proc/<pid> directories
#   # are invisible for processes owned by other users.
#   opendir(my $proc, "/proc") or return 0;
#   my $mystat = path("/proc/$$")->stat;
#   my ($myuid, $mygid) = ($mystat->uid, $mystat->gid);
#   my $ostat;
#   while(defined(my $fname = readdir($proc))) {
#     return $fname if $fname =~ /\A\d+\z/ && $fname != 1 && $fname != $$
#             && ($ostat = path("/proc/$fname")->stat)
#             && $ostat->uid != $<+0 && $ostat->gid != $(+0
#             && $ostat->uid != $>+0 && $ostat->gid != $)+0
#   }
#   0; 
# }->();

# The above was not necessary because we only re-use profile directories 
# created by the same UID, and we can always detect processes running under
# the same UID regardless of /proc mount options.
use constant CAN_DETECT_OTHER_POROCESSES => do{ opendir(my $proc, "/proc/$$") ? 1 : 0 };
my $profiles_parent = path(tmpdir)->child("${progname}_profiles_".($>+0))->canonpath;

my ($pw, $pdfa, $quiet, $debug, $out_format, $output, $max_concurrent);
my $soffice_prog = "soffice";

@ARGV = ("-h") unless @ARGV;
Getopt::Long::Configure qw(gnu_getopt require_order);
GetOptions(
  "f|format=s"         => \$out_format,
  "o|output=s"         => \$output,
  "pw=s"               => \$pw,
  "pdfa"               => \$pdfa,
  "prog=s"             => \$soffice_prog,
  "j=n"                => \$max_concurrent,
  "q|quiet"            => \$quiet,
  "d|debug"            => \$debug,
  "h|help"             => sub{ pod2usage(-verbose => 2, -exitval => 0); }, 
) && @ARGV>=1 or pod2usage(-verbose => 0, -exitval => 1);

$out_format //= "pdf" if $pdfa;
pod2usage(-verbose => 0, -exitval => 1) 
  unless $out_format;

$out_format = lc($out_format);

# Input files which need different filter options will be split into
# additional groups
my @infile_groups = ( [ @ARGV ] );

sub showpid() { $debug ? $$ : "" };

sub num_cpus() {
  state $num_cpus = do{
    my $n = qx{ nproc 2>/dev/null }
            || qx{ grep '^processor.*:' /proc/cpuinfo 2>/dev/null | wc -l }
            || 4;
    warn "#num_cpus = $n\n" if $debug;
    $n
  };
}

print showpid,"# CAN_DETECT_OTHER_POROCESSES = ${\vis(CAN_DETECT_OTHER_POROCESSES)}\n" if $debug;

sub run_cmd($cmd) {
  if ($debug) {
    warn showpid,"> ",qshlist(@$cmd), "\n" unless $quiet;
    STDERR->flush;
    die "failed" unless 0 == system { $cmd->[0] } @$cmd;
  } else {
    # Arrgh! Some LO output filters are always noisy on stdout
    # First run re-directing to /dev/null; if it fails (non-zero exit),
    # re-run without diversions so the user can see the diagnostics.
    my $redirects = " 2>/dev/null 1>&2";
    warn showpid,"> ",qshlist(@$cmd), "$redirects\n" unless $quiet;
    my @shcmd = ("/bin/sh", "-c", "exec $redirects; exec \"\$\@\"", "sh", @$cmd);
    if (0 != system { $shcmd[0] } @shcmd) {
      warn showpid,"> Conversion failed, re-running without redirection\n> ", qshlist(@$cmd),"\n";
      die showpid,"> died" unless 0 == system { $cmd->[0] } @$cmd;
      warn showpid,"WHAT?? It unexpectedly worked this time...\n";
    }
  }
}

# By default, soffice --convert-to ... will connect with an existing LO 
# process and tell it to do the job, which prevents concurrent conversions
# and pollutes the stdout/err of the existing instance with warnings but
# is silent in the current terminal (and possibly other problems).
#
# Therefore we use a separate profile, which causes a new
# instance to be started and run independantly of any existing instances.
# File locking is used to serialize our manipulation of a pid file.

my $profdir;
if (CAN_DETECT_OTHER_POROCESSES) {
  # Create temp profiles and re-use them.
  # But only share them among processes spawned by the same UID
  print showpid, dvis '# $profiles_parent\n' if $debug;
  $profiles_parent = path($profiles_parent)->mkdir;
  while (! defined $profdir) {
    my @ancient_pids;
    # Avoid overhead of detecting num_cpus if the first slot is free
    for (my $seq=1; $seq == 1 || $seq <= ($max_concurrent//(num_cpus + 1)); $seq++) {
      my $dir = $profiles_parent->child(sprintf "profile_%03d", $seq)->mkdir;
      my $pidfile = $dir->child("_my_pidfile");
      my $fh = $pidfile->filehandle({locked => 1}, "+>>", ":raw");
      seek($fh, 0, 0) or die $!;
      my $pid = <$fh>;
      if ($pid && -e "/proc/$pid") {
        my $age = time() - $pidfile->stat->mtime;
        print "$$ # $pidfile contains $pid (still running, age = $age)\n" if $debug;
        die "wtf" if $pid == $$;
        push @ancient_pids, $pid if $age > (30*60);
      } else {
        print "$$ # $pidfile contains ${\vis($pid)} (not running; replacing with our pid)\n" if $debug;
        seek($fh, 0, 0) or die $!;
        truncate $fh, 0;
        print $fh $$;
        close $fh or die $!;
        $profdir = $dir;
        last;
      }
    }
    unless (defined $profdir) {                                                 
      if (my $pid = shift @ancient_pids) {
        warn "$$: PID $pid seems stuck.. killing it...\n"; STDERR->flush;
        kill "HUP",$pid;
        sleep 1; 
        next if ! kill "TERM",$pid;
        sleep 1; 
        next if ! kill "KILL",$pid;
        sleep 1; 
        next if ! kill 0,$pid;
        warn "$$: WARNING - PID $pid is unkillable!\n";
      }
      if ($debug) {
        warn "$$: Too many concurrent conversions; sleeping...\n"; STDERR->flush;
      }
      sleep(1);
    }
  }
}

sub fname_to_apptype($path) {
  my ($suf) = map{lc} ($path =~ /\.(\w+)$/g) or die ivis 'No suffix in $path';
  my $apptype = 
    $suf =~ /^(?:odt|doc|docx|orr|fodt|uot|dotx|xml|ftf|dot|docm|md|html|txt)$/ ? "writer" :
    $suf =~ /^(?:odg|otg|fodg)$/ ? "draw" : 
    die "Unsupported: Conversion of .$suf to .pdf" ;
  return $apptype
}

while (@infile_groups) {
  my $infiles = shift @infile_groups;
  my @cmd = ($soffice_prog, "--headless", "--nolockcheck", "--norestore");
  if (defined $profdir) {
    push @cmd, "-env:UserInstallation=file://" . $profdir->canonpath;
  }
  push @cmd, "--convert-to";
  if ($out_format eq "pdf") {
    # https://wiki.openoffice.org/wiki/API/Tutorials/PDF_export
  
    my $apptype = fname_to_apptype($infiles->[0]); # "writer" or "draw"
    if (my @others = grep{ fname_to_apptype($_) ne $apptype } @$infiles) {
      # A different filter is needed for writer or draw documents
      push @infile_groups, \@others;
      $infiles = [  grep{ fname_to_apptype($_) eq $apptype } @$infiles ];
    }

    my $filter_opts = "pdf:${apptype}_pdf_Export:{\n";
    if ($pw) {
      die "A password may not be used with PDF/A files\n" if $pdfa;
      # We only support an encrypted file which allows nothing but viewing
      # and printing.  The "PermissionPassword" is randomly set, to disallow
      # changing permissions.
      my $perm_pw = sprintf("%08x",rand(0xFFFFFFFF));
      # Based on https://www.libreofficehelp.com/batch-convert-writer-documents-pdf-libreoffice/
      $filter_opts .= <<~EOF;
        "EncryptFile":{"type":"boolean","value":"true"},
        "DocumentOpenPassword":{"type":"string","value":"${pw}"},
        "PermissionPassword":{"type":"string","value":"${perm_pw}"},
      EOF
    }
    $filter_opts .= <<~'EOF';
      "Printing":{"type":"long","value":"2"},
      "EnableCopyingOfContent":{"type":"boolean","value":"true"},
      "EnableTextAccessForAccessibilityTools":{"type":"boolean","value":"true"},
    EOF
  
    if ($pdfa) {
      $filter_opts .= qq{  "SelectPdfVersion":{"type":"long","value":"3"},\n};
    }
  
    $filter_opts =~ s/,$//; # remove comma after last item (just in case)
    $filter_opts .= "\n}";
    push @cmd, $filter_opts;
  }
  else {
    push @cmd, $out_format;
  }
  
  # OUTPUT PATH CONTROL
  #   LibreOffice only allows controlling the output directory, and individual
  #   output filenames (AFAIK) are always the corresponding input file 
  #   basenames with the a different suffix.
  #
  #   With -o filename, create a temp outdir and then move the file to
  #     the specified path.  Only supported with a single input file
  #   With -o direcory, just use the --outdir LO option.
  #     
  if (defined $output) {
    if ($output =~ m{/$}) { # trailing slash
      die qsh($output), " does not exist or is not a directory\n" unless -d $output;
    }
    if (-d $output) {
      push @cmd, "--outdir", $output;
      push @cmd, @$infiles;
      run_cmd \@cmd;
    } else {
      # `man unoconv` says "If multiple input files are provided, use it as a
      # basename (and add output extension)." **WHAT DOES THAT MEAN?
      #   We simply insist that the -o path either be a directory which receives
      #   default-named output files, or a suitable complete path for a single 
      #   output file.
      die "Multiple inputs not allowed with -o unless giving existing directory\n"
        if @$infiles > 1 or @infile_groups > 0;
      die "-o <non-directory> must specify a file with the correct output suffix (.${out_format})\n"
        unless $output =~ /\.\Q${out_format}\E$/;
      my $tdir = Path::Tiny->tempdir; 
      push @cmd, "--outdir", $tdir;
      push @cmd, @$infiles;
      run_cmd \@cmd;
      my $outfname = path($infiles->[0])->basename(qr/\.\w+$/) . ".${out_format}";
      die "BUG: Expected tdir/$outfname to exist!"
        unless -e "$tdir/$outfname";
      warn showpid,"> mv ",qsh("$tdir/$outfname")," ",qsh($output),"\n" unless $quiet;
      path("$tdir/$outfname")->move($output);
    }
  } else {
    push @cmd, @$infiles;
    run_cmd \@cmd;
  }
}

exit 0;