package ManUtils 0.2;

use v5.36;
use IPC::Open3;
use IO::Poll qw/POLLOUT POLLIN/;
use Symbol 'gensym';
use XSLoader;
use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);
XSLoader::load('ManUtils');

sub fmt($input) {
    my @cmd = 'groff';
    push @cmd, '-t' if $input =~ /^\.TS/m;
    push @cmd, '-e' if $input =~ /^\.EQ/m;
    # $MANWIDTH works by using the following groff options: -rLL=100n -rLT=100n
    push @cmd, qw/-mandoc -Tutf8 -DUTF-8 -P-c -rLL=80n -rLT=80n -/;

    # tix comes with* a custom(?) man.macros package. But it looks okay even without loading that.
    # (* It actually doesn't, the tcllib package appears to have that file, but doesn't '.so' it)
    # Other .so's are just turned into a link.
    $input =~ s/^\.so (.+)$/$1 eq 'man.macros' ? '' : ".in -10\n.sp\n[[[MANNEDINCLUDE$1]]]"/emg;

    $input =
        # Disable hyphenation, since that screws up man page references. :-(
        ".hy 0\n.de hy\n..\n"
        # Emulate man-db's --nj option
        .".na\n.de ad\n..\n"
        # Unbreak some quotes, there's plenty of man pages that ("incorrectly") use these for code samples.
        .".char ` \\`\n"
        .".char ' \\[aq]\n"
        .$input;
    utf8::encode($input);

    my $pid = open3(my $in, my $out, my $err = gensym, @cmd);

    # "POLLOUT" does NOT guarantee that a write will not block, we must set
    # O_NONBLOCK to tell the kernel that we can handle short writes.
    fcntl($in, F_SETFL, fcntl($in, F_GETFL, 0) | O_NONBLOCK);

    my $inoff = 0;
    my $output = '';
    my $poll = IO::Poll->new;
    $poll->mask($in => POLLOUT);
    $poll->mask($out => POLLIN);
    $poll->mask($err => POLLIN);
    while (1) {
        $poll->poll;

        if ($poll->events($in)) {
            my $r = syswrite $in, $input, 16*1024, $inoff;
            die "Write error: $!\n" if $r <= 0;
            $inoff += $r;
            if ($inoff == length $input) {
                $poll->remove($in);
                close $in;
            }
        }

        if ($poll->events($out)) {
            my $r = sysread $out, $output, 16*1024, length $output;
            die "Read error: $!\n" if $r < 0;
            if ($r == 0) {
                utf8::decode($output);
                waitpid $pid, 0;
                die "Groff exited with $?\n" if $?;
                return $output =~ s/\s+$//r;
            }
        }

        if ($poll->events($err)) {
            my $r = sysread $err, my $buf, 16*1024;
            $poll->remove($err) if $r == 0;
            #warn "GROFF: $buf\n" if $r > 0;
        }
    }
}

1;