-
Notifications
You must be signed in to change notification settings - Fork 2
/
ltsv2tsv.pl
executable file
·60 lines (55 loc) · 1.15 KB
/
ltsv2tsv.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
#!/usr/bin/perl -w
use strict;
use warnings FATAL => qw/all/;
use fields qw/o_noheader/;
sub MY () {__PACKAGE__}
{
my MY $opts = fields::new(MY);
my %opt_alias = qw/n o_noheader/;
my (@headers);
while (@ARGV and $ARGV[0] =~ m{^-(?<opt>\w+)|^\+(?<key>\S+)}) {
if (defined $+{key}) {
push @headers, $+{key};
} elsif (defined $+{opt}) {
my $o = $opt_alias{$+{opt}} || $+{opt};
$opts->{$o} = 1;
} else {
die "really?";
}
shift;
}
if (not @headers) {
defined($_ = <>)
or exit;
chomp;
my @cols;
foreach my $cell (split "\t") {
my ($label, $value) = split ":", $cell, 2;
push @headers, $label;
push @cols, $value;
}
print tsv(@headers);
print tsv(@cols);
}
elsif (not $opts->{o_noheader}) {
print tsv(@headers);
}
while (<>) {
chomp;
my @pairs = map {split ":", $_, 2} split "\t";
if (@pairs % 2 != 0) {
warn "Non LTSV input($_), ignored.\n";
next;
}
my %log = @pairs;
print tsv(@log{@headers});
}
}
sub usage {
die <<END;
Usage: $0 +KEY [+KEY...] LTSV_FILES...
END
}
sub tsv {
join("\t", map {$_ // ''} @_)."\n";
}