File Coverage

bin/cut

Criterion	Covered	Total	%
statement	78	104	75.0
branch	29	50	58.0
condition	7	9	77.7
subroutine	9	10	90.0
pod			n/a
total	123	173	71.1

#!/usr/bin/perl

=begin metadata

Name: cut
Description: select portions of each line of a file
Author: Rich Lafferty, [e-mail]
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 $me = basename($0);

my %opt;
getopts('b:c:d:f:ns', \%opt) or usage();

# There's no difference between -b and -c on any unix I
# use regularly -- it's for i18n. Thus, -n is a noop, too.
if (defined $opt{'b'}) {
    usage() if $opt{'f'};
    handle_b($opt{'b'});
}
elsif (defined $opt{'c'}) {
    usage() if $opt{'f'};
    handle_b($opt{'c'});
}
elsif (defined $opt{'f'}) {
    handle_f($opt{'f'}, $opt{'d'}, $opt{'s'});
}
else {
    warn "$me: byte, character or field list required\n";
    usage();
}
exit EX_SUCCESS;

sub checknum {
    my $n = shift;
    if ($n !~ m/\A\-?[0-9]+\Z/) {
        warn "$me: unexpected byte or field number: '$n'\n";
        exit EX_FAILURE;
    }
    if ($n == 0) {
        warn "$me: bytes and fields are numbered from 1\n";
        exit EX_FAILURE;
    }
}

sub parse_fields {
    my $spec = shift;
    my @list = split /,/, $spec;

    my $to_end;
    my @cols;
    foreach my $item (@list) {
        my ($from, $is_range, $to);
        if ($item =~ m/\A([0-9]*)(\-?)([0-9]*)\z/) {
            $from = $1;
            $is_range = $2;
            $to = $3;
        }
        else {
                warn "$me: invalid byte list: '$item'\n";
                exit EX_FAILURE;
        }
        checknum($from) if length($from);
        checknum($to)   if length($to);
        if (!length($from) && !length($to)) { # reject lone '-'
            warn "$me: invalid byte list\n";
            exit EX_FAILURE;
        }
        if (length($from) && length($to)) {
            if ($from > $to) {
                warn "$me: invalid range $from-$to\n";
                exit EX_FAILURE;
            }
            $is_range = 0 if $from == $to;
        }
        if ($is_range) {
            if (length($from) && length($to)) { # a-b
                push @cols, $from .. $to;
            }
            elsif (length $from) { # a-
                push @cols, $from;
                $to_end = 1;
            }
            else { # -a
                push @cols, 1 .. $to;
            }
        }
        else {
            push @cols, $from;
        }
    }
    my @sorted = sort { $a <=> $b } @cols;
    unshift @sorted, $to_end;
    return @sorted;
}

sub handle_b {
    my $spec = shift;
    my ($to_end, @cols) = parse_fields($spec);

    while (<>) {
        chomp;
        my $col = 0;
        my @chars = split //;
        foreach my $c (@cols) {
	    next if $c <= $col;
            print $chars[$c - 1];
            $col = $c;
        }
        if ($to_end) {
            $col++;
            foreach my $c ($col .. scalar(@chars)) {
                print $chars[$c - 1];
            }
        }
        print "\n";
    }
}

sub handle_f {
    my ($spec, $delim, $sflag) = @_;

    my ($to_end, @cols) = parse_fields($spec);
    if (defined $delim) {
        $delim = substr $delim, 0, 1;
    }
    else {
        $delim = "\t";
    }
    while (<>) {
        chomp;

        # Only waste time on lines with delimiters
        if (/$delim/) {
            my @hunk = split /$delim/;
            my $col = 0;
            my @out;
            foreach my $c (@cols) {
	        next if $c <= $col;
                push @out, $hunk[$c - 1];
                $col = $c;
            }
            if ($to_end) {
                $col++;
                foreach my $c ($col .. scalar(@hunk)) {
                    push @out, $hunk[$c - 1];
                }
            }
            print join($delim, @out), "\n";
        }
        else {  # no delimiter in line
            print "$_\n" unless $sflag;
        }
    }
}

sub usage {
    print <
usage:  $me -b list [-n] [file ...]
        $me -c list [file ...]
        $me -f list [-d delim] [-s] [file ...]

Each LIST is made up of one range, or many ranges separated by commas.
Each range is one of:

  N     Nth byte, character or field, counted from 1
  N-    from Nth byte, character or field, to end of line
  N-M   from Nth to Mth (included) byte, character or field
  -M    from first to Mth (included) byte, character or field

EOT
    exit EX_FAILURE;
}

__END__