colrm

#!/usr/bin/perl

=begin metadata

Name: colrm
Description: remove columns from a file
Author: Jeffrey S. Haemer
License: perl

=end metadata

=cut


use strict;

use File::Basename qw(basename);

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

my $Program = basename($0);

if (@ARGV > 2) {
	warn "usage: $Program [startcol [endcol]]\n";
	exit EX_FAILURE;
} elsif (@ARGV == 0) {
	print while(<>);
} elsif (@ARGV == 1) {
	my $startcol = getarg();
	while (my $line = <>) {
		chomp $line;
		my $len = length $line;
		if ($startcol > $len) {
			print $line;
		} else {
			print substr $line, 0, $startcol - 1;
		}
		print "\n";
	}
} elsif (@ARGV == 2) {
	my $startcol = getarg();
	my $endcol = getarg();
	if ($startcol > $endcol) {
		warn "$Program: bad range: $startcol,$endcol\n";
		exit EX_FAILURE;
	}
	while (my $line = <>) {
		chomp $line;
		my $len = length $line;
		if ($startcol > $len) {
			print $line;
		} else {
			print substr $line, 0, $startcol - 1;
			print substr $line, $endcol;
		}
		print "\n";
	}
}
exit EX_SUCCESS;

sub getarg {
	my $n = shift @ARGV;
	if (!defined($n)) {
		warn "$Program: missing argument\n";
		exit EX_FAILURE;
	}
	if ($n =~ m/[^0-9]/ || $n == 0) {
		warn "$Program: invalid column number '$n'\n";
		exit EX_FAILURE;
	}
	return $n;
}


=head1 NAME

colrm - remove columns from a file

=head1 SYNOPSIS

colrm [startcol [endcol]]

=head1 DESCRIPTION

B<colrm> removes the named columns from each line of its standard input
(one column = one character).
Column numbering starts at 1, not 0.

If a only I<startcol> is provided, removes all columns from I<startcol>
rightwards.

If both I<startcol> and I<endcol> are provided, removes all columns from
I<startcol> to I<endcol>, inclusive.

If neither is provided, acts just like B<cat>.

=head1 OPTIONS AND ARGUMENTS

=over 2

=item I<startcol>

The first column to remove.

=item I<endcol>

The last column to remove.

=back

=head1 AUTHOR

  Jeffrey S. Haemer

=head1 BUGS

Lacks the special-case handling of backspace and tab added in some
other versions.  Acts, instead, like the simpler Linux and SunOS versions.

=head1 SEE ALSO

  awk(1)