view release on metacpan or  search on metacpan

bin/col  view on Meta::CPAN

#!/usr/local/bin/perl -w

use strict;

use Getopt::Std;

use vars qw($VERSION);
$VERSION = q$Revision: 1.1 $ =~ /Revision:\s*(\S*)/;

use vars qw($opt_b $opt_f $opt_p $opt_x $opt_l);
use vars qw($opt_e $opt_E $opt_s $opt_t);

$opt_f = 0;

getopts('bfpxl:eEst') || die "Bad options.\n";

if ($opt_l and $opt_l !~ /\D/) {
    # multiply by 2 for half-lines
    $opt_l *= 2;
} else {
    $opt_l = 512;
}

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;
if ($opt_E) {
    # as for IRIX
    @re = qw(       [7-9]           ^7$           ^8$           ^9$       );
} elsif ($opt_e) {
    # as for BSD
    @re = qw(       [\x07-\x09]     ^\x07$        ^\x08$        ^\x09$    );
} else {
    # accept either
    @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
    if ($opt_t) {
        $_ =~ s/^(.*(?:\x0A|\e$re[0])|).*$/$1/sxo;
    }

    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;
                $row >= 0 or $row = 0;
            } elsif ($chars[$i] =~ /$re[2]/xo) { # half reverse line feed
                $row -= 1;
                $row >= 0 or $row = 0;
            } 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] ||= [];

        # check buffer size
        if (@buf > $opt_l) {
            print_line(0);

            if ($buf[1] and @{$buf[1]}) {
                # print next half line
                print "\e9";
                print "\x0D" if !$front;
                $front = 1;

                print_line(1);
                print "\e9";
                print "\x0D" if !$front;
                $front = 1;