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