tangetools/field/field
2020-10-11 12:40:12 +02:00

134 lines
2.8 KiB
Perl
Executable file

#!/usr/bin/perl
=pod
=head1 NAME
field - select fields in tabular files
=head1 SYNOPSIS
B<field> I<field spec> file
... | B<field> I<field spec>
=head1 DESCRIPTION
B<field> selects fields in tabular files.
=head1 EXAMPLE
Select field 2:
field 2 file
Select field 2,3,4,5:
field 2-5 file
Select field 2..end:
field 2- file
Select field 2,3,4,1:
field 2-4,1 file
=head1 AUTHOR
Copyright (C) 2017-2020 Ole Tange,
http://ole.tange.dk and Free Software Foundation, Inc.
=head1 LICENSE
Copyright (C) 2012 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 3 of the License, or
at your option any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.
=head1 SEE ALSO
B<cut>
=cut
use strict;
my @fields = range_to_fields(shift);
my $fields = join(",", @fields);
sub range_to_fields {
my @ranges = split(/,/, shift);
my @fields;
for (@ranges) {
/^(\d+)$/ and push (@fields,($1-1));
/^(\d+)-(\d+)$/ and push (@fields,($1-1) .. ($2-1));
/^(\d+)-$/ and do {
push (@fields,($1-1)." .. \$#F");
$Global::must_eval = 1;
};
}
# Default: field 1
# Perl counts from 0 - not from 1
if(not @fields) { @fields=(1-1); }
return @fields;
}
if($Global::must_eval) {
while(<>) {
my @F = split/\s+/,$_;
if(not $Calc::f{$#F}) {
# Eval is expensive, so only do it if we have not done before
# If an argument ends in '-' then we must figure out the last field
# which depends on the number of fields in the line
$Calc::f{$#F}++;
@{$Calc::fields->{$#F}} = eval $fields;
}
print join("\t",@F[@{$Calc::fields->{$#F}}]),"\n";
}
} else {
# awk counts from 1 not 0
@fields = map { $_+1 } @fields;
# Use mawk (60 MB/s)/gawk (30 MB/s)/awk (? MB/s)
my $awk = which("mawk") || which("gawk") || which("awk");
my $awkscript = 'BEGIN {OFS = "\t"} {print '.
(join ",", map { '$'.$_ } @fields).
'}';
exec($awk,$awkscript);
}
sub which {
# Input:
# @programs = programs to find the path to
# Returns:
# @full_path = full paths to @programs. Nothing if not found
my @which;
for my $prg (@_) {
push(@which, grep { not -d $_ and -x $_ }
map { $_."/".$prg } split(":",$ENV{'PATH'}));
if($prg =~ m:/:) {
# Including path
push(@which, grep { not -d $_ and -x $_ } $prg);
}
}
return wantarray ? @which : $which[0];
}