[2] | 1 | #!/usr/bin/env perl |
---|
| 2 | |
---|
| 3 | use strict; |
---|
| 4 | use warnings; |
---|
| 5 | |
---|
| 6 | ################################################### |
---|
| 7 | # linkToDavid.pl |
---|
| 8 | # Generates a link to David for a list of gene IDs. |
---|
| 9 | ################################################### |
---|
| 10 | |
---|
| 11 | if (!@ARGV or scalar @ARGV != 4) { |
---|
| 12 | print "usage: linkToDavid.pl infile.tab 1basedCol idType outfile\n"; |
---|
| 13 | exit 1; |
---|
| 14 | } |
---|
| 15 | |
---|
| 16 | my $in = shift @ARGV; |
---|
| 17 | my $col = shift @ARGV; |
---|
| 18 | my $type = shift @ARGV; |
---|
| 19 | my $out = shift @ARGV; |
---|
| 20 | |
---|
| 21 | if ($col < 1) { |
---|
| 22 | print "ERROR the column number should be 1 based counting\n"; |
---|
| 23 | exit 1; |
---|
| 24 | } |
---|
| 25 | my @gene; |
---|
| 26 | open(FH, $in) or die "Couldn't open $in, $!\n"; |
---|
| 27 | while (<FH>) { |
---|
| 28 | chomp; |
---|
| 29 | my @f = split(/\t/); |
---|
| 30 | if (scalar @f < $col) { |
---|
| 31 | print "ERROR there is no column $col in $in\n"; |
---|
| 32 | exit 1; |
---|
| 33 | } |
---|
| 34 | if ($f[$col-1]) { push(@gene, $f[$col-1]); } |
---|
| 35 | } |
---|
| 36 | close FH or die "Couldn't close $in, $!\n"; |
---|
| 37 | |
---|
| 38 | if (scalar @gene > 400) { |
---|
| 39 | print "ERROR David only allows 400 genes submitted via a link\n"; |
---|
| 40 | exit 1; |
---|
| 41 | } |
---|
| 42 | |
---|
| 43 | my $link = 'http://david.abcc.ncifcrf.gov/api.jsp?type=TYPE&ids=GENELIST&tool=summary'; |
---|
| 44 | |
---|
| 45 | my $g = join(",", @gene); |
---|
| 46 | $link =~ s/GENELIST/$g/; |
---|
| 47 | $link =~ s/TYPE/$type/; |
---|
| 48 | #print output |
---|
| 49 | if (length $link > 2048) { |
---|
| 50 | print "ERROR too many genes to fit in URL, please select a smaller set\n"; |
---|
| 51 | exit; |
---|
| 52 | } |
---|
| 53 | open(FH, ">", $out) or die "Couldn't open $out, $!\n"; |
---|
| 54 | print FH "<html><head><title>DAVID link</title></head><body>\n", |
---|
| 55 | '<A TARGET=_BLANK HREF="', $link, '">click here to send of identifiers to DAVID</A>', "\n", |
---|
| 56 | '</body></html>', "\n"; |
---|
| 57 | close FH or die "Couldn't close $out, $!\n"; |
---|
| 58 | |
---|
| 59 | exit; |
---|