146 lines
3 KiB
Perl
Executable file
146 lines
3 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,1,3,5,7,9,13:
|
|
|
|
field 2,1-13/2 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) {
|
|
# 2
|
|
/^(\d+)$/ and push (@fields,($1-1));
|
|
# 2-11
|
|
/^(\d+)-(\d+)$/ and push (@fields,($1-1) .. ($2-1));
|
|
# 3-19/2
|
|
/^(\d+)-(\d+)\/(\d+)$/ and do {
|
|
for(my $t = $1; $t <= $2; $t += $3) {
|
|
push (@fields,($t-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];
|
|
}
|