gene_to_aliases

   1 #! /usr/bin/perl
   2 # gene_to_aliases takes a list of genes and returns their aliases,
   3 # and is released under the terms of the GPL version 2, or any later
   4 # version, at your option. See the file README and COPYING for more
   5 # information.
   6 # Copyright 2009 by Don Armstrong <don@donarmstrong.com>.
   7 # $Id: perl_script 1432 2009-04-21 02:42:41Z don $
   8
   9
  10 use warnings;
  11 use strict;
  12
  13 use Getopt::Long;
  14 use Pod::Usage;
  15
  16 =head1 NAME
  17
  18 gene_to_aliases - take a list of genes and return aliases
  19
  20 =head1 SYNOPSIS
  21
  22  [options]
  23
  24  Options:
  25   --debug, -d debugging level (Default 0)
  26   --help, -h display this help
  27   --man, -m display manual
  28
  29 =head1 OPTIONS
  30
  31 =over
  32
  33 =item B<--debug, -d>
  34
  35 Debug verbosity. (Default 0)
  36
  37 =item B<--help, -h>
  38
  39 Display brief usage information.
  40
  41 =item B<--man, -m>
  42
  43 Display this manual.
  44
  45 =back
  46
  47 =head1 EXAMPLES
  48
  49
  50 =cut
  51
  52
  53 use vars qw($DEBUG);
  54
  55 use WWW::Mechanize;
  56 use URI::Escape;
  57
  58 my %options = (debug           => 0,
  59                help            => 0,
  60                man             => 0,
  61                );
  62
  63 GetOptions(\%options,
  64            'debug|d+','help|h|?','man|m');
  65
  66 pod2usage() if $options{help};
  67 pod2usage({verbose=>2}) if $options{man};
  68
  69 $DEBUG = $options{debug};
  70
  71 my @USAGE_ERRORS;
  72 # if (1) {
  73 #      push @USAGE_ERRORS,"You must pass something";
  74 # }
  75
  76 pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;
  77
  78 my @genes;
  79 while (<>) {
  80     chomp;
  81     next unless length $_;
  82     push @genes,$_;
  83 }
  84
  85 my $m = WWW::Mechanize->new(autocheck => 0);
  86
  87 for my $gene (@genes) {
  88     my $url = 'http://eutils.ncbi.nlm.nih.gov/entrez/eutils/esearch.fcgi?db=gene&retmax=1&term='.
  89         uri_escape($gene.'[Symbol] AND Homo[Orgn]');
  90     my $content = get_loop($url);
  91     my @id = $content =~
  92         m|<Id>(\d+)</Id>|gis;
  93     if (not @id) {
  94         print $gene,qq(\n);
  95         next;
  96     }
  97     $content = get_loop('http://eutils.ncbi.nlm.nih.gov/entrez/eutils/efetch.fcgi?db=gene&retmax=1&retmode=xml&id='.$id[0]);
  98     my @syn = $content =~
  99         m{<(?:Gene|Prot)-ref_(?:syn|name)_E>([^<]+)</(?:Gene|Prot)-ref_(?:syn|name)_E>}g;
 100     print join("\t",$gene,@syn),qq(\n);
 101     print $content if $DEBUG;
 102 }
 103 sub get_loop {
 104     my $url = shift;
 105     my $counter = 0;
 106     my $content='';
 107  LOOP: {do {
 108         if ($m->get($url
 109                         )) {
 110             $content = $m->content;
 111             last;
 112         }
 113         $counter++;
 114         sleep 10;
 115     } while ($counter < 100);
 116     }
 117     return $content;
 118 }
 119
 120
 121
 122 __END__