#!/usr/bin/perl
### nosgr.perl  -*- Perl -*-
## Start a command removing SGR (^[[{value}m) escapes and escaping controls.

### Ivan Shmakov, 2021

## To the extent possible under law, the author(s) have dedicated
## all copyright and related and neighboring rights to this software
## to the public domain worldwide.  This software is distributed
## without any warranty.

## You should have received a copy of the CC0 Public Domain Dedication
## along with this software.  If not, see
## <http://creativecommons.org/publicdomain/zero/1.0/>.

### Commentary:

## This is used as a wrapper for software that assumes a VT100-compatible
## terminal, such as for the purposes of coloring its output; possibly
## interfering with script(1) logging, or screen reader or braille display
## function.

## Typically this behavior can be inhibited by explicitly setting the
## TERM environment variable to dumb for such a program; e. g.:

##      $ TERM=dumb program --help 

## Alternatively, it is sometimes inhibited by not using a tty to
## interact with the program, and using a socket or a pair of pipes
## instead.  This is possible with socat(1), like:

##      $ socat  STDIO  EXEC:"program " 

## Which can be further combined with rlwrap(1) when needed:

##      $ rlwrap --history-file=.program_history \
##            -- socat  STDIO  EXEC:"program " 

## When everything else fails, the present wrapper can be used:

##      $ nosgr -- program [argument...]

## (Note that -- above is mandatory even though no options are currently
## supported.)

### History:

## 0.2  2021-05-08 17:00Z
##      Added customary header and footer.  Improved error reporting.

## 0.1  2021-05-08 07:27Z
##      (sfn.bR6ClIB5ikuzHP30l2dEkJaoF2etgpqsDuuwcChywPA.perl)
##      Initial revision.

### Code:
use common::sense;
use English qw (-no_match_vars);

require IO::Handle;
require IO::Select;
require IO::Socket;

## FIXME: add conventional, Getopt::Long-based option decoding here
unless (@ARGV > 1 && "--" eq $ARGV[0]) {
    print STDERR ("Usage: ${0} -- COMMAND [ARGUMENT...]\n");
    ## .
    exit (1);
}
shift (@ARGV);

my ($a, $b)
    = IO::Socket->socketpair (IO::Socket::AF_UNIX (),
                              IO::Socket::SOCK_STREAM (),
                              IO::Socket::PF_UNSPEC ())
    or die ("socketpair: ", $!);

my $pid
    = fork ();
die ("fork: ", $!)
    unless (defined ($pid) && $pid >= 0);
if ($pid == 0) {
    $a->close ();
    open (STDIN, "<&", $b)
        and open (STDOUT, ">&", $b)
        and open (STDERR, ">&", $b)
        or die ("redirection: ", $!);
    $b->close ();
    ## .
    exec (@ARGV)
        or die ("exec: ", $!);
}

$b->close ();

## NB: we assume that writes to our fds never block (for long)
my $sel
    = IO::Select->new (\*STDIN, $a);
my $buffer
    = "";
while (1) {
    my @ready
        = $sel->can_read (31);
    next
        unless (@ready > 0);
    foreach my $fh (@ready) {
        my $rd
            = sysread ($fh, $buffer, 4096, length ($buffer));
        die ("read: ", $!)
            unless (defined ($rd) && $rd >= 0);
        if ($rd == 0) {
            ## FIXME: should perhaps give it a chance to exit normally?
            kill ("HUP", $pid);

            ## FIXME: waitpid and pass the exit code upwards
            ## .
            exit (0);
        }

        $buffer
            =~ s/\033(?:\[[0-9]*)?$//;
        my $save
            = $&;

        ## NB: likely possible to do in one s/// pass (instead of two)
        $buffer
            =~ s/\033\[[0-9]+m//g;
        ## NB: here the set of allowed (unescaped) codes is specified
        $buffer
            =~ s/[^\n -~]/${ \sprintf ("\\%03o", ord ($&)); }/g;

        while (length ($buffer) > 0) {
            my $wr
                = syswrite (($fh eq \*STDIN ? $a : \*STDOUT), $buffer);
            die ("write: ", $!)
                unless (defined ($wr) && $wr >= 0);
            substr ($buffer, 0, $wr, "");
        }

        $buffer
            .= $save;
    }
}

### nosgr.perl ends here