| 0 | 1 =head1 LICENSE | 
|  | 2 | 
|  | 3  Copyright (c) 1999-2015 The European Bioinformatics Institute and | 
|  | 4  Genome Research Limited.  All rights reserved. | 
|  | 5 | 
|  | 6  This software is distributed under a modified Apache license. | 
|  | 7  For license details, please see | 
|  | 8 | 
|  | 9    http://www.ensembl.org/info/about/code_licence.html | 
|  | 10 | 
|  | 11 =head1 CONTACT | 
|  | 12 | 
|  | 13  Ensembl <http://www.ensembl.org/info/about/contact/index.html> | 
|  | 14 | 
|  | 15 =cut | 
|  | 16 | 
|  | 17 =head1 NAME | 
|  | 18 | 
|  | 19  DAS | 
|  | 20 | 
|  | 21 =head1 SYNOPSIS | 
|  | 22 | 
|  | 23  mv DAS.pm ~/.vep/Plugins | 
|  | 24  ./vep -i variations.vcf --plugin DAS,<DAS_server>,<DAS_source>,<proxy> | 
|  | 25 | 
|  | 26 =head1 DESCRIPTION | 
|  | 27 | 
|  | 28  A simple VEP plugin that checks for DAS features overlapping variants. Currently assumes that | 
|  | 29  the assemblies match, and doesn't do any smart fetching of chunks of features (i.e. the plugin | 
|  | 30  will query the DAS server once for every variant in the input file). | 
|  | 31 | 
|  | 32  You can run multiple instances of this plugin at the same time so you can query multiple DAS | 
|  | 33  servers and sources. If you are querying multiple sources from the same server it is | 
|  | 34  convenient to store the server name in an environment variable to avoid specifying it | 
|  | 35  multiple times, e.g.: | 
|  | 36 | 
|  | 37  export DAS="http://somewhere/das" | 
|  | 38  ./vep -i variations.vcf --plugin DAS,$DAS,source1 --plugin DAS,$DAS,source2 | 
|  | 39 | 
|  | 40  Requires the Bio::Das::Lite module from CPAN. | 
|  | 41 | 
|  | 42 =cut | 
|  | 43 | 
|  | 44 package DAS; | 
|  | 45 | 
|  | 46 use strict; | 
|  | 47 use warnings; | 
|  | 48 | 
|  | 49 use Bio::Das::Lite; | 
|  | 50 use Data::Dumper; | 
|  | 51 | 
|  | 52 use Bio::EnsEMBL::Variation::Utils::BaseVepPlugin; | 
|  | 53 | 
|  | 54 use base qw(Bio::EnsEMBL::Variation::Utils::BaseVepPlugin); | 
|  | 55 | 
|  | 56 sub get_header_info { | 
|  | 57     my $self = shift; | 
|  | 58     return { | 
|  | 59         $self->header => $self->{source}." features from DAS server ".$self->{server}, | 
|  | 60     }; | 
|  | 61 } | 
|  | 62 | 
|  | 63 sub feature_types { | 
|  | 64     return ['Transcript','RegulatoryFeature','MotifFeature','Intergenic']; | 
|  | 65 } | 
|  | 66 | 
|  | 67 sub new { | 
|  | 68     my $class = shift; | 
|  | 69 | 
|  | 70     my $self = $class->SUPER::new(@_); | 
|  | 71 | 
|  | 72     my ($server, $source, $proxy) = @{ $self->params }; | 
|  | 73 | 
|  | 74     # strip off any trailing slash from the server URL | 
|  | 75     $server =~ s/\/$//; | 
|  | 76 | 
|  | 77     $self->{das} = Bio::Das::Lite->new({ | 
|  | 78         timeout     => 10000, | 
|  | 79         dsn         => "$server/$source", | 
|  | 80         http_proxy  => $proxy, | 
|  | 81     }) || die "Failed to connect to DAS source: $server/$source"; | 
|  | 82 | 
|  | 83     $self->{source} = $source; | 
|  | 84     $self->{server} = $server; | 
|  | 85 | 
|  | 86     return $self; | 
|  | 87 } | 
|  | 88 | 
|  | 89 sub header { | 
|  | 90     my $self = shift; | 
|  | 91     return 'DAS_'.$self->{source}; | 
|  | 92 } | 
|  | 93 | 
|  | 94 sub run { | 
|  | 95     my ($self, $vfoa) = @_; | 
|  | 96 | 
|  | 97     my $vf = $vfoa->variation_feature; | 
|  | 98 | 
|  | 99     my $segment = $vf->seq_region_name .':'.$vf->seq_region_start.','.$vf->seq_region_end; | 
|  | 100 | 
|  | 101     # cache the results on the variation feature, making sure the cache key is unique given | 
|  | 102     # that there may be multiple DAS plugins running | 
|  | 103 | 
|  | 104     my $cache_key = '_vep_das_cache_'.$self->{server}.$self->{source}; | 
|  | 105 | 
|  | 106     unless (exists $vf->{$cache_key}->{$segment}) { | 
|  | 107 | 
|  | 108         $vf->{$cache_key}->{$segment} = []; | 
|  | 109 | 
|  | 110         if (my $response = $self->{das}->features($segment)) { | 
|  | 111             for my $url (keys %$response) { | 
|  | 112                 if (ref $response->{$url} eq 'ARRAY') { | 
|  | 113                     for my $feat (@{ $response->{$url} }) { | 
|  | 114                         push @{ $vf->{$cache_key}->{$segment} }, $feat->{feature_label}.'('.$feat->{type}.')'; | 
|  | 115                     } | 
|  | 116                 } | 
|  | 117             } | 
|  | 118         } | 
|  | 119     } | 
|  | 120 | 
|  | 121     my $res = join ',', @{ $vf->{$cache_key}->{$segment} }; | 
|  | 122 | 
|  | 123     return $res ? {$self->header => $res} : {}; | 
|  | 124 } | 
|  | 125 | 
|  | 126 1; | 
|  | 127 |