view release on metacpan or  search on metacpan

bin/col  view on Meta::CPAN

#!/usr/bin/perl

=begin metadata

Name: col
Description: filter reverse line feeds from input
Author: Ronald J Kimball, rjk-perl@tamias.net
License: perl

=end metadata

=cut


use strict;

use File::Basename qw(basename);
use Getopt::Std qw(getopts);

use constant EX_SUCCESS => 0;
use constant EX_FAILURE => 1;

my $Program = basename($0);
our $VERSION = '1.2';

use vars qw($opt_b $opt_f $opt_h $opt_p $opt_s $opt_t $opt_x);

getopts('bfhpxl:st') or usage();
usage() if @ARGV;

my @buf = [];       # character buffer
my $col = 0;        # current column number
my $row = 0;        # current row number
my $max_row = -2;   # max populated row
my $iset = 1;       # current input character set (1 or 2)

my $oset = 1;       # current output character set (1 or 2)
my $front = 0;      # note whether at front of line in output
my $spaces = '';    # save spaces for converting to tabs

# prepare regexes for matching linefeeds
#            any             full reverse  half reverse  half forward
my @re = qw( [7-9\x07-\x09]  ^[7\x07]$     ^[8\x08]$     ^[9\x09]$ );

# INPUT

while (<>) {
    # chop trailing characters not followed by a linefeed of any kind
    s/^(.*(?:\x0A|\e$re[0])|).*$/$1/sxo if $opt_t;

    my @chars = split m//;

    my $i;
    for ($i=0; $i<=$#chars; ++$i) {
        my $c = $chars[$i];

        if ($c eq "\x1B" or $c eq "\x0B") {
            if ($c eq "\x0B" or $chars[++$i] =~ /$re[1]/xo) {
                                                # reverse line feed
                $row -= 2 if $row >= 2;
            } elsif ($chars[$i] =~ /$re[2]/xo) { # half reverse line feed
                $row-- if $row >= 1;
            } elsif ($chars[$i] =~ /$re[3]/xo) { # half forward line feed
                $row += 1;
            } else {                            # unrecognized escape
                if ($opt_p) {
                    add_char("\x1B");
                    add_char($chars[$i]);
                } else {
                }
            }
        } elsif ($c eq "\x08") {                # backspace
            $col--;
            $col >= 0 or $col = 0;
        } elsif ($c eq "\x0D") {                # carriage return
            $col = 0;
        } elsif ($c eq "\x0A") {                # line feed
            $row += 2;
            $col = 0;
        } elsif ($c eq "\x0F") {                # shift in
            $iset = 1;
        } elsif ($c eq "\x0E") {                # shift out
            $iset = 2;
        } elsif ($c eq "\x20") {                # space
            $col++;
        } elsif ($c eq "\x09") {                # tab
            $col += (($col % 8) || 8);
        } elsif ($c gt "\x20") {                # printable character
            add_char($c);
        } else {                                # unrecognized ctl char
        }

        # start row if necessary
        $buf[$row] ||= [];
    }
}


# add_char
# add a character at the current row and column
# uses globals @buf, $row, $max_row, $col, $iset, $opt_f, $opt_b
sub add_char {
    my($char) = @_;

    # move to next full line, if necessary
    my $r = $row;
    if (!$opt_f) {
        $r += $row & 1;
        # start row if necessary
        $buf[$r] ||= [];
    }