/usr/bin/vcf-to-tab is in vcftools 0.1.12+dfsg-1.
This file is owned by root:root, with mode 0o755.
The actual contents of the file can be viewed below.
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 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 | #!/usr/bin/env perl
use strict;
use warnings;
use Carp;
use Vcf;
my $opts = parse_params();
convert_to_tab($opts);
exit;
#--------------------------------
sub error
{
my (@msg) = @_;
if ( scalar @msg )
{
croak @msg;
}
die
"Usage: vcf-to-tab [OPTIONS] < in.vcf > out.tab\n",
"Options:\n",
" -h, -?, --help This help message.\n",
" -i, --iupac Use one-letter IUPAC codes\n",
"\n";
}
sub parse_params
{
my $opts = { iupac=>0 };
while (my $arg=shift(@ARGV))
{
if ( $arg eq '-?' || $arg eq '-h' || $arg eq '--help' ) { error(); }
if ( $arg eq '-i' || $arg eq '--iupac' ) { $$opts{iupac}=1; next; }
error("Unknown parameter \"$arg\". Run -h for help.\n");
}
if ( $$opts{iupac} )
{
$$opts{iupac} =
{
'GG' => 'G',
'CC' => 'C',
'TT' => 'T',
'AA' => 'A',
'GT' => 'K',
'TG' => 'K',
'AC' => 'M',
'CA' => 'M',
'CG' => 'S',
'GC' => 'S',
'AG' => 'R',
'GA' => 'R',
'AT' => 'W',
'TA' => 'W',
'CT' => 'Y',
'TC' => 'Y',
'..' => '.',
};
}
return $opts;
}
sub convert_to_tab
{
my ($opts) = @_;
my $iupac;
if ( $$opts{iupac} ) { $iupac=$$opts{iupac}; }
my $vcf = Vcf->new(fh=>\*STDIN);
$vcf->parse_header();
my $header_printed=0;
while (my $x=$vcf->next_data_hash())
{
if ( !$header_printed )
{
print "#CHROM\tPOS\tREF";
for my $col (sort keys %{$$x{gtypes}})
{
print "\t$col";
}
print "\n";
$header_printed = 1;
}
print "$$x{CHROM}\t$$x{POS}\t$$x{REF}";
for my $col (sort keys %{$$x{gtypes}})
{
my ($al1,$sep,$al2) = exists($$x{gtypes}{$col}{GT}) ? $vcf->parse_alleles($x,$col) : ('.','/','.');
my $gt = $al1.'/'.$al2;
if ( $iupac )
{
if ( !exists($$iupac{$gt}) ) { error(qq[Unknown IUPAC code for "$al1$sep$al2" .. $$x{CHROM}:$$x{POS} $col\n]); }
$gt = $$iupac{$gt};
}
print "\t".$gt;
}
print "\n";
}
}
|