trunc

#!/usr/bin/perl

use strict;
use warnings;
use open ':std', ':encoding(UTF-8)';		# handle wide characters
use Text::Tabs;
use Getopt::Std;
$Getopt::Std::STANDARD_HELP_VERSION = 1;	# help output to stdout, not err

$main::VERSION = "4.0.20191201";
my ($IAM) = $0 =~ m,([^/]+)$,;	# this program's name (path removed)
my $usage = "Usage: $IAM [OPTIONS] [FILE...]";

sub main::HELP_MESSAGE {
  print <<END_HELP;
Truncate file(s)/stdout to display width, accounting for tabs and escape chars
$usage
  -c		Force coloring the last character on truncated lines
  -C		Do not add colors or dots to truncated lines
  -d		Use dots to denote truncated lines, does not add color
  -D		Debug
  -h, --help	Display this help
  -m		Preserve right and left equally (remove from the middle)
  -r		Preserve right side of text rather than default of left
  -w WIDTH	Truncate to given WIDTH
END_HELP
  main::VERSION_MESSAGE();
  exit;
}

sub main::VERSION_MESSAGE {
  print "trunc v$main::VERSION Copyright 2005+ by Adam Katz, GPL v3+\n";
}

my %opt = ();
my $width = $ENV{COLUMNS};
my $color = -1;
my $end = "";

getopts("cCdDhmn:rw:", \%opt) or die "$usage\n";

die "You cannot remove the middle (`-m`) and also preserve the middle (`-M`)\n"
  if $opt{m} and $opt{M};

HELP_MESSAGE() if $opt{h};

# color management
my $cA = my $cB = my $cD = my $c0 = '';		# no colors (yet)
if ($opt{d}) { $color = 0; $end = "\x{2026}"; }	# dotted delimeter: no colors
elsif ($opt{C}) { $color = 0; } 		# explicitly no colors
elsif ($opt{c}) { $color = 1; } 		# explicit colors
$color = 1 if $color == -1 and -t 1;		# implicit colors (stdout=open)
if ($color) { $cA = "\e[7;40m"; $cB = "\e\\\e[m"; $cD = "\e[0;34m"; }

sub debug {
  return 0 unless $opt{D};
  my @a = @_;
  $a[0] = $cD . $a[0] . "\e[m" . "\n";
  printf STDERR @a;
}

# width management
if ($opt{w}) { $width = $opt{w}; }
elsif (not $width) { $width = `tput cols`; }
$width = $opt{w} if $opt{w};
die "Invalid width '$width'\n" if $width == 0;
$width -= length($end) + 1; 			# keep track of tail

# Non-printing characters (C0, delete, C1, soft hyphen, EXCLUDES SPACE)
# Note that we'll convert tabs (\x09) to spaces and that this excludes spaces.
# See also https://en.wikipedia.org/wiki/C0_and_C1_control_codes
my $nonprint = "\x00-\x1f\x7f-\x9f\xad";
# Adding higher unicode zero-width characters. Select all and use blank cells at
# http://kb.mozillazine.org/Network.IDN.blacklist_chars
$nonprint   .= "\x{115f}\x{1160}\x{200b}";

# Escape sequences, based on my answer at https://superuser.com/a/1388860/300293
my $esc = qr"
  (?:
    # Control Sequence Introducer and the ensuing escape sequence,
    # which includes Select Graphic Rendition sequences like colors,
    # see https://en.wikipedia.org/wiki/ANSI_escape_code#CSI_sequences
    \e\[[\x30-\x3f]*[\x20-\x2f]*[\x40-\x7e]
    |
    # grep adds \e[K
    \e\[K
    |
    # Sequences that continue until given the String Terminator (ST)
    \e[PX^_].*?\e\\
    |
    # Operating System Command sequences can terminate with ST or a bell
    \e\][^\a]*(?:\a|\e\\)
    |
    # Remaining singleton sequences
    \e[\[\]A-Z\\^_@]
    |
    [$nonprint]+
  )
"x;

sub has {
  my ($where, $what) = @_;
  return -1 != index($where, $what);
}

while (<>) {
  my $backup = $_; # preserve original so we can revert to it if narrow enough

  chomp;		# remove trailing line feed
  $_ = expand($_);	# expand tabs

  my $char = my $real = 0;
  my $unesc = my $uncolor = my $last_unesc = my $last_uncolor = "";
  my @new = ();
  my @new_len = ();

  # loop through each ESC/printable pair
  while (/\G($esc*+)([^$nonprint]++)/g) {
    my $escape = $1 || "", my $print = $2;
    if ($escape) {
      push(@new, $escape);
      push(@new_len, 0);
      # revert colors if they change and we're not already reverting with $cB
      $last_uncolor = $uncolor = "\e[m" if has($escape, "\e[") and not $cB;
      $last_unesc = $unesc = "\e\\";	# revert escape sequences
    }
    my $len = length($print);
    $char += $len;
    if ($opt{D}) {
      my $ee2 = $escape; $ee2 =~ s/\e/\\e/g;
      debug("escape=<%s>@%d print=<%s>@%d char=%d real=%d",
        $ee2, length($escape), $print, $len, $char, $real);
    }
    if ($char <= $width or $opt{r} or $opt{m} or $opt{M}) {
      push(@new, $print);
      push(@new_len, $len);
      debug("added, iterating...");
    } else {
      push(@new, substr($print, 0, $width - $char)
                 . $unesc . $cA
                 . substr($print, $width - $char, 1)
                 . $unesc . $end . $cB);
      push(@new_len, $width - $char);
      if ($char > $width) {
        my $off = "";
        debug("\@new=%d", scalar @new);
        $new[scalar @new - 1] =~ /(\e\\)?(\e\[[0;]*m)?/;
        $new[scalar @new - 1] .= "\e\\" unless $1;
        $new[scalar @new - 1] .= "\e[m" unless $2;
        last;
      }
    }
    $real += $len + length($escape);
  }
  my $tmp = join("", @new);
  debug("new=<$cB%s$cD> last_unesc=<%s> last_uncolor=<%s>",
    join(",", @new), $last_unesc, $last_uncolor);
  if ($char <= $width) {
    print $backup;
    next;
  } elsif ($opt{r}) {	# preserve the right side
    $tmp = "";
    my $tmp_len = 0;
    for (my $i = scalar @new - 1; $i >= 0; $i--) {
      debug("width=%d tmp_len=%d new_len=%d substr=%d", $width, $tmp_len,
        $new_len[$i], $tmp_len - $width);
      if ($tmp_len + $new_len[$i] > $width) {
        $tmp = $cA . substr($new[$i], $tmp_len - $width - 1, 1) . $cB
          . ($tmp_len - $width < 0 ? substr($new[$i], $tmp_len - $width) : "")
          . $tmp;
        last;
      } else {
        $tmp = $new[$i] . $tmp;
        $tmp_len += $new_len[$i];
      }
    }
  } elsif ($opt{m}) {	# preserve the left and right sides
    my $tmp_right = $tmp = "";
    my $tmp_len = 0;
    my $half = int($width / 2); 	# truncate; (82-1)/2 = 40, + 1 for dots
    for (my $i = 0; $i < scalar @new; $i++) {
      debug("left: i=%d half=%d width=%d tmp_len=%d new_len=%d", $i,
        $half, $width, $tmp_len, $new_len[$i]);
      if ($tmp_len + $new_len[$i] >= $half) {
        debug("substr=%d", $half - $tmp_len);
        $tmp .= substr($new[$i], 0, $half - $tmp_len + 1);
        last;
      } else {
        $tmp .= $new[$i];
        $tmp_len += $new_len[$i];
      }
    }
    $half-- if $half * 2 >= $width;	# less one if we rounded earlier
    debug("tmp=%s", $tmp);
    $tmp_len = 0;
    for (my $i = scalar @new - 1; $i >= 0; $i--) {
      debug("right: i=%d half=%d width=%d tmp_len=%d new_len=%d", $i, $half,
        $width, $tmp_len, $new_len[$i]);
      if ($tmp_len + $new_len[$i] >= $half) {
        debug("substr=%d", $tmp_len - $half);
        $tmp_right = substr($new[$i], $tmp_len - $half) . $tmp_right;
        last;
      } else {
        $tmp_right = $new[$i] . $tmp_right;
        $tmp_len += $new_len[$i];
      }
    }
    $tmp .= "$cA\x{2026}$cB$tmp_right";
  } else {	# preserve the left side (done above for short-circuiting)
    $tmp .= $last_unesc . $last_uncolor;
  }
  if ($tmp eq $_) { $_ = $backup; }
  else { $_ = "$tmp\n"; }
  print;

}