comparison tools/human_genome_variation/linkToDavid.pl @ 0:9071e359b9a3

Uploaded
author xuebing
date Fri, 09 Mar 2012 19:37:19 -0500
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:9071e359b9a3
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;