-
Notifications
You must be signed in to change notification settings - Fork 2
/
tsvcut.pl
executable file
·73 lines (62 loc) · 1.47 KB
/
tsvcut.pl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
#!/usr/bin/env perl
# -*- coding: utf-8 -*-
use strict;
use warnings FATAL => qw/all/;
use autodie;
use Getopt::Long;
{
GetOptions("u|unix" => \ (my $o_unix = 0))
or usage();
my (%watchColNames, @watchColList);
while (@ARGV and $ARGV[0] =~ /^\@(.*)$/) {
$watchColNames{$1}++;
push @watchColList, $1;
shift @ARGV;
}
unless (keys %watchColNames) {
die "Please specifly column name!\n";
}
unshift @ARGV, '-' unless @ARGV;
local ($/, $\) = map {$_, $_} $o_unix ? "\n" : "\r\n";
foreach my $fn (@ARGV) {
my $fh;
if ($fn eq '-') {
$fh = \*STDIN;
} else {
open $fh, '<', $fn;
}
defined(my $header = <$fh>)
or do { warn "Can't read header from $fn\n"; next };
$header =~ s/^\xef\xbb\xbf//; # Trim BOM
if ($o_unix and $header =~ /\r$/) {
warn "Input ends with CRLF!";
}
my @header = split "\t", $header;
my @watchCols = do {
my %found;
foreach (0 .. $#header) {
defined $watchColNames{$header[$_]}
or next;
$found{$header[$_]} = $_;
}
unless (keys %found == keys %watchColNames) {
die "Can't find column: "
.join(" ", grep {not $found{$_}} sort keys %watchColNames);
}
map {$found{$_}} @watchColList;
};
print tsv(@header[@watchCols]);
while (my $line = <$fh>) {
my @cols = split "\t", $line;
print tsv(@cols[@watchCols]);
}
}
}
sub tsv {
join "\t", map {$_ // ''} @_;
}
sub usage {
die <<END;
Usage: $0 [-u] file...
END
}