[2] | 1 | #!/usr/bin/env perl |
---|
| 2 | |
---|
| 3 | use strict; |
---|
| 4 | use warnings; |
---|
| 5 | |
---|
| 6 | use LWP::UserAgent; |
---|
| 7 | require HTTP::Cookies; |
---|
| 8 | |
---|
| 9 | ####################################################### |
---|
| 10 | # ctd.pl |
---|
| 11 | # Submit a batch query to CTD and fetch results into galaxy history |
---|
| 12 | # usage: ctd.pl inFile idCol inputType resultType actionType outFile |
---|
| 13 | ####################################################### |
---|
| 14 | |
---|
| 15 | if (!@ARGV or scalar @ARGV != 6) { |
---|
| 16 | print "usage: ctd.pl inFile idCol inputType resultType actionType outFile\n"; |
---|
| 17 | exit; |
---|
| 18 | } |
---|
| 19 | |
---|
| 20 | my $in = shift @ARGV; |
---|
| 21 | my $col = shift @ARGV; |
---|
| 22 | if ($col < 1) { |
---|
| 23 | print "The column number is with a 1 start\n"; |
---|
| 24 | exit 1; |
---|
| 25 | } |
---|
| 26 | my $type = shift @ARGV; |
---|
| 27 | my $resType = shift @ARGV; |
---|
| 28 | my $actType = shift @ARGV; |
---|
| 29 | my $out = shift @ARGV; |
---|
| 30 | |
---|
| 31 | my @data; |
---|
| 32 | open(FH, $in) or die "Couldn't open $in, $!\n"; |
---|
| 33 | while (<FH>) { |
---|
| 34 | chomp; |
---|
| 35 | my @f = split(/\t/); |
---|
| 36 | if (scalar @f < $col) { |
---|
| 37 | print "ERROR the requested column is not in the file $col\n"; |
---|
| 38 | exit 1; |
---|
| 39 | } |
---|
| 40 | push(@data, $f[$col-1]); |
---|
| 41 | } |
---|
| 42 | close FH or die "Couldn't close $in, $!\n"; |
---|
| 43 | |
---|
| 44 | my $url = 'http://ctd.mdibl.org/tools/batchQuery.go'; |
---|
| 45 | #my $url = 'http://globin.bx.psu.edu/cgi-bin/print-query'; |
---|
| 46 | my $d = join("\n", @data); |
---|
| 47 | #list maintains order, where hash doesn't |
---|
| 48 | #order matters at ctd |
---|
| 49 | #to use input file (gives error can't find file) |
---|
| 50 | #my @form = ('inputType', $type, 'inputTerms', '', 'report', $resType, |
---|
| 51 | #'queryFile', [$in, ''], 'queryFileColumn', $col, 'format', 'tsv', 'action', 'Submit'); |
---|
| 52 | my @form = ('inputType', $type, 'inputTerms', $d, 'report', $resType, |
---|
| 53 | 'queryFile', '', 'format', 'tsv', 'action', 'Submit'); |
---|
| 54 | if ($resType eq 'cgixns') { #only add if this type |
---|
| 55 | push(@form, 'actionTypes', $actType); |
---|
| 56 | } |
---|
| 57 | my $ua = LWP::UserAgent->new; |
---|
| 58 | $ua->cookie_jar(HTTP::Cookies->new( () )); |
---|
| 59 | $ua->agent('Mozilla/5.0'); |
---|
| 60 | my $page = $ua->post($url, \@form, 'Content_Type'=>'form-data'); |
---|
| 61 | if ($page->is_success) { |
---|
| 62 | open(FH, ">", $out) or die "Couldn't open $out, $!\n"; |
---|
| 63 | print FH "#"; |
---|
| 64 | print FH $page->content, "\n"; |
---|
| 65 | close FH or die "Couldn't close $out, $!\n"; |
---|
| 66 | }else { |
---|
| 67 | print "ERROR failed to get page from CTD, ", $page->status_line, "\n"; |
---|
| 68 | print $page->content, "\n"; |
---|
| 69 | my $req = $page->request(); |
---|
| 70 | print "Requested \n"; |
---|
| 71 | foreach my $k(keys %$req) { |
---|
| 72 | if ($k eq '_headers') { |
---|
| 73 | my $t = $req->{$k}; |
---|
| 74 | foreach my $k2 (keys %$t) { print "$k2 => $t->{$k2}\n"; } |
---|
| 75 | }else { print "$k => $req->{$k}\n"; } |
---|
| 76 | } |
---|
| 77 | exit 1; |
---|
| 78 | } |
---|
| 79 | exit; |
---|
| 80 | |
---|