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; |
---|