]> git.donarmstrong.com Git - function2gene.git/blob - bin/function2gene
* Start supporting keyword weights
[function2gene.git] / bin / function2gene
1 #! /usr/bin/perl
2 # function2gene, is part of the function2gene suite and is released
3 # under the terms of the GPL version 2, or any later version, at your
4 # option. See the file README and COPYING for more information.
5 # Copyright 2007 by Don Armstrong <don@donarmstrong.com>.
6
7
8 use threads;
9 use warnings;
10 use strict;
11
12 use Getopt::Long;
13 use Pod::Usage;
14
15 use Storable;
16
17 =head1 NAME
18
19   function2gene - Call out to each of the search modules to search for
20   each of the terms
21
22 =head1 SYNOPSIS
23
24  function2gene --keywords keywords.txt --results gene_search_results
25
26  Options:
27   --keywords newline delineated list of keywords to search for
28   --results directory to store results in
29   --database databases to search
30   --restart-at mode to start searching at
31   --invalidate-state state to invalidate
32   --debug, -d debugging level (Default 0)
33   --help, -h display this help
34   --man, -m display manual
35
36 =head1 OPTIONS
37
38 =over
39
40 =item B<--keywords>
41
42 A file which contains a newline delinated list of keywords to search
43 for. Can be specified multiple times. Lines starting with # or ; are
44 ignored. An optional weight can be specified after the keyword, which
45 is separated from the keyword by a tab. (If not specified, 1 is
46 assumed.)
47
48 =item B<--results>
49
50 Directory in which to store results; also stores the current state of
51 the system
52
53 =item B<--database>
54
55 Databases to search, can be specified multiple times. [Defaults to
56 NCBI, GeneCards and Harvester, the only currently supported
57 databases.]
58
59 =item B<--restart-at>
60
61 If you need to restart the process at a particular state (which has
62 already been completed) specify this option. Valid values are get,
63 parse, or combine.
64
65 =item B<--invalidate-state>
66
67 This is a more powerful version of --restart-at, which can
68 specifically invalidate a certain method,database,keyword combination.
69
70 For example, you can request that the keyword foo be retreived again
71 from ncbi using --invalidate-state 'get,ncbi,foo'
72
73 =item B<--debug, -d>
74
75 Debug verbosity. (Default 0)
76
77 =item B<--help, -h>
78
79 Display brief useage information.
80
81 =item B<--man, -m>
82
83 Display this manual.
84
85 =back
86
87 =head1 EXAMPLES
88
89    # Search all databases for transferrin
90    echo 'transferrin' > keywords.txt
91    function2gene --keywords keywords.txt --results keyword_results
92
93    # reparse the results
94    function2gene --keywords keywords.txt --results keyword_results \
95        --restart-at parse
96
97 =cut
98
99
100 use vars qw($DEBUG);
101 use Cwd qw(abs_path);
102 use IO::File;
103 use Storable qw(thaw freeze);
104 use File::Basename qw(basename dirname);
105 use Thread::Queue;
106
107 my %options = (databases       => [],
108                keywords        => [],
109                debug           => 0,
110                help            => 0,
111                man             => 0,
112                results         => '',
113                invalidate_state => [],
114                );
115
116 GetOptions(\%options,'keywords=s@','databases=s@',
117            'restart_at|restart-at=s','results=s',
118            'invalidate_state|invalidate-state=s@',
119            'debug|d+','help|h|?','man|m');
120
121 pod2usage() if $options{help};
122 pod2usage({verbose=>2}) if $options{man};
123
124 my $base_dir = dirname(abs_path($0));
125
126 my $ERRORS='';
127
128 $ERRORS.="restart-at must be one of get, parse or combine\n" if
129      exists $options{restart_at} and $options{restart_at} !~ /^(?:get|parse|combine)$/;
130
131 $ERRORS.="unknown database(s)" if
132      @{$options{databases}} and
133      grep {$_ !~ /^(?:ncbi|genecard|harvester)$/i} @{$options{databases}};
134
135 if (not length $options{results}) {
136      $ERRORS.="results directory not specified";
137 }
138 elsif (not -d $options{results} or not -w $options{results}) {
139      $ERRORS.="results directory $options{results} does not exist or is not writeable";
140 }
141
142 pod2usage($ERRORS) if length $ERRORS;
143
144 if (not @{$options{databases}}) {
145      $options{databases} = [qw(ncbi genecard harvester)]
146 }
147
148 $DEBUG = $options{debug};
149
150 # There are three states for our engine
151 # Getting results
152 # Parsing them
153 # Combining results
154
155 # first, check to see if the state in the result directory exists
156
157 my %state;
158
159 $options{keywords} = [map {abs_path($_)} @{$options{keywords}}];
160
161 chdir $options{results} or die "Unable to chdir to $options{results}";
162
163 if (-e "function2gene_state") {
164      ADVISE("Using existing state information");
165      my $state_fh = IO::File->new("function2gene_state",'r') or die
166           "Unable to open state file for reading: $!";
167      local $/;
168      my $state_file = <$state_fh>;
169      %state = %{thaw($state_file)} or die "Unable to thaw state file";
170 }
171 else {
172      ADVISE("Starting new run");
173      %state = (keywords => [],
174                databases => [map {lc($_)} @{$options{databases}}],
175                done_keywords => {
176                                  get => {},
177                                  parse => {},
178                                  combine => {},
179                                 },
180               );
181 }
182
183 my @new_keywords;
184 if (@{$options{keywords}}) {
185      # uniqify keywords
186      my %old_keywords;
187      @old_keywords{@{$state{keywords}}} = (1) x @{$state{keywords}};
188      for my $keyword_file (@{$options{keywords}}) {
189           my $keyword_fh = IO::File->new($keyword_file,'r') or die
190                "Unable to open $keyword_file for reading: $!";
191           while (<$keyword_fh>) {
192                next if /^\s*[#;]/;
193                next unless /\w+/;
194                chomp;
195                my ($keyword,$weight) = split /\t/, $_;
196                $weight = 1 if not defined $weight;
197                $state{keyword_weight}{$keyword} = $weight;
198                if (not $old_keywords{$_}) {
199                     DEBUG("Adding new keyword '$_'");
200                     push @new_keywords, $_;
201                }
202                else {
203                     DEBUG("Not adding duplicate keyword '$_'");
204                }
205           }
206      }
207      push @{$state{keywords}},@new_keywords;
208 }
209
210 if (exists $options{restart_at} and length $options{restart_at}) {
211      if (lc($options{restart_at}) eq 'get') {
212           delete $state{done_keywords}{get};
213           delete $state{done_keywords}{parse};
214           delete $state{done_keywords}{combine};
215      }
216      elsif (lc($options{restart_at}) eq 'parse') {
217           delete $state{done_keywords}{parse};
218           delete $state{done_keywords}{combine};
219      }
220      elsif (lc($options{restart_at}) eq 'combine') {
221           delete $state{done_keywords}{combine};
222      }
223 }
224
225 if (exists $options{invalidate_state}) {
226      for my $invalidate_state (@{$options{invalidate_state}}) {
227           my ($method,$database,$keyword) = split /,/, $invalidate_state;
228           if (grep {not defined $_ } ($method,$database,$keyword) ) {
229                print STDERR "The invalidate state option '$invalidate_state' is invalid.\n";
230                next;
231           }
232           if (not exists $state{done_keywords}{$method}) {
233                print STDERR "Method '$method' does not exist, and cannot be invalidated\n";
234                next;
235           }
236           if (not exists $state{done_keywords}{$method}{$database}) {
237                print STDERR "Database '$database' does not exist for method '$method', and cannot be invalidated\n";
238                next;
239           }
240           if (not length $keyword) {
241                delete $state{done_keywords}{$method}{$database};
242                if ($method eq 'get') {
243                     delete $state{done_keywords}{parse}{$database};
244                     delete $state{done_keywords}{combine}{$database};
245                }
246                if ($method eq 'parse') {
247                     delete $state{done_keywords}{combine}{$database};
248                }
249                next;
250           }
251           if (not exists $state{done_keywords}{$method}{$database}{$keyword}) {
252                print STDERR "Keyword '$keyword' does not exist for database '$database' and method '$method', and cannot be invalidated\n";
253                next;
254           }
255           delete $state{done_keywords}{$method}{$database}{$keyword};
256           if ($method eq 'get') {
257                delete $state{done_keywords}{parse}{$database}{$keyword};
258                delete $state{done_keywords}{combine}{$database}{$keyword};
259           }
260           if ($method eq 'parse') {
261                delete $state{done_keywords}{combine}{$database}{$keyword};
262           }
263      }
264 }
265
266 # now we need to figure out what has to happen
267 # for each keyword, we check to see if we've got results, parsed
268 # results, and combined it. If not, we queue up those actions.
269
270 my %actions = (combine => 0,
271                get     => {},
272                parse   => {},
273               );
274
275 if (not @{$state{keywords}}) {
276      ADVISE("There are no keywords specified");
277 }
278
279 for my $keyword (@{$state{keywords}}) {
280      for my $database (@{$state{databases}}) {
281           if (not exists $state{done_keywords}{get}{$database}{$keyword}) {
282                push @{$actions{get}{$database}}, $keyword;
283                delete $state{done_keywords}{parse}{$database}{$keyword} if
284                     exists $state{done_keywords}{parse}{$database}{$keyword};
285                delete $state{done_keywords}{combine}{$database}{$keyword} if
286                     exists $state{done_keywords}{combine}{$database}{$keyword};
287           }
288           if (not exists $state{done_keywords}{parse}{$database}{$keyword}) {
289                push @{$actions{parse}{$database}},$keyword;
290                delete $state{done_keywords}{combine}{$database}{$keyword} if
291                     exists $state{done_keywords}{combine}{$database}{$keyword};
292           }
293           if (not exists $state{done_keywords}{combine}{$database}{$keyword}) {
294               $actions{combine} = 1;
295           }
296      }
297 }
298
299
300 for my $state (qw(get parse)) {
301      my %databases;
302      for my $database (keys %{$actions{$state}}) {
303           next unless @{$actions{$state}{$database}};
304           $databases{$database}{queue} = Thread::Queue->new
305                or die "Unable to create new thread queue";
306           $databases{$database}{thread} = threads->create(\&handle_action,$state,$database,$databases{$database}{queue})
307                or die "Unable to create new thread";
308           $databases{$database}{queue}->enqueue(@{$actions{$state}{$database}});
309           $databases{$database}{queue}->enqueue(undef);
310      }
311      my $ERRORS=0;
312      for my $database (keys %databases) {
313           my ($actioned_keywords,$failed_keywords) = @{$databases{$database}{thread}->join||[]};
314           if (not defined $failed_keywords) {
315                ADVISE("Something bad happened during '$state' of '$database'");
316                $ERRORS = 1;
317           }
318           elsif (@{$failed_keywords}) {
319                ADVISE("These keywords failed during '$state' of '$database':",@{$failed_keywords});
320                $ERRORS=1;
321           }
322           @{$state{done_keywords}{$state}{$database}}{@{$actioned_keywords}} = (1) x @{$actioned_keywords};
323           delete @{$state{done_keywords}{$state}{$database}}{@{$failed_keywords}};
324      }
325      save_state(\%state);
326      if ($ERRORS) {
327           WARN("Stoping, asthere are errors");
328           exit 1;
329      }
330 }
331
332 if ($actions{combine}) {
333      save_state(\%state);
334      # deal with combining results
335      my @parsed_results = map { my $db = $_;
336                                 map {
337                                      "parsed_results_${db}_${_}.txt"
338                                 } keys %{$state{done_keywords}{parse}{$db}}
339                            } keys %{$state{done_keywords}{parse}};
340
341      # create temporary file to store keyword weights
342
343      write_command_to_file('combined_results.txt',
344                            "$base_dir/combine_results",
345                            '--keywords',
346                            
347                            @parsed_results,
348                           );
349      for my $result (@parsed_results) {
350           $result =~ s/^parsed_results_//;
351           $result =~ s/\.txt$//;
352           my ($db,$keyword) = split /_/, $result, 2;
353           $state{done_keywords}{combined}{$db}{$keyword} = 1;
354      }
355      save_state(\%state);
356      write_command_to_file('combined_results_table.txt',
357                            "$base_dir/results_to_table",
358                            'combined_results.txt',
359                           );
360      ADVISE("Finished; results in $options{results}/combined_results.txt");
361 }
362 else {
363      ADVISE('Nothing to do. [Perhaps you wanted --restart-at?]');
364 }
365
366 sub handle_action{
367      my ($state,$database,$queue) = @_;
368      my $keyword;
369      my $actioned_keywords = [];
370      my $failed_keywords = [];
371      DEBUG("Beginning to handle actions for state '$state' database '$database'");
372      while ($keyword = $queue->dequeue) {
373           DEBUG("Handling state '$state' database '$database' keyword '$keyword'");
374           # handle the action, baybee
375           if ($state eq 'get') {
376                my $command_fh;
377                eval {
378                     open($command_fh,'|-',
379                          "$base_dir/get_${database}_results",
380                         ) or die "unable to execute '$base_dir/get_${database}_results'";
381                     print {$command_fh} "$keyword\n" or die "unable to print $keyword to 'get_${database}_results'";
382                     close($command_fh) or die "Unable to close filehandle";
383                     if ($? != 0) {
384                          die "get_${database}_results with keyword $keyword failed with error code ".($?>>8);
385                     }
386                };
387                if ($@) {
388                     WARN($@);
389                     push @{$failed_keywords}, $keyword;
390                     next;
391                }
392           }
393           elsif ($state eq 'parse') {
394                eval {
395                     write_command_to_file("parsed_results_${database}_${keyword}.txt",
396                                           "$base_dir/parse_${database}_results",
397                                           '--keywords',
398                                           $keyword,
399                                          );
400                };
401                if ($@) {
402                     WARN("parse_${database}_results failed with $@");
403                     push @{$failed_keywords}, $keyword;
404                     next;
405                }
406           }
407           else {
408                die "I don't know how to handle state $state";
409           }
410           ADVISE("$state results from '$database' for '$keyword'");
411           push @{$actioned_keywords},$keyword;
412      }
413      return [$actioned_keywords,$failed_keywords];
414 }
415
416 sub save_state{
417      my ($state) = @_;
418      my $state_fh = IO::File->new("function2gene_state",'w') or die
419           "Unable to open state file for writing: $!";
420      print {$state_fh} freeze($state) or die "Unable to freeze state file";
421      close $state_fh or die "Unable to close state file: $!";
422 }
423
424 sub write_command_to_file{
425      my ($file,@command) = @_;
426      my $fh = IO::File->new($file,'w') or
427           die "Unable to open $file for writing: $!";
428      my $command_fh;
429      open($command_fh,'-|',
430           @command,
431          ) or die "Unable to execute $command[0] $!";
432      print {$fh} <$command_fh>;
433      close $fh;
434      close $command_fh or die "$command[0] failed with ".($?>>8);
435 }
436
437
438 sub ADVISE{
439      print STDOUT map {($_,qq(\n))} @_;
440 }
441
442 sub DEBUG{
443      print STDERR map {($_,qq(\n))} @_;
444 }
445
446
447 sub WARN {
448      print STDERR map {($_,qq(\n))} @_;
449 }
450
451 __END__