Mercurial > repos > willmclaren > ensembl_vep
comparison variant_effect_predictor/Bio/EnsEMBL/Utils/Converter.pm @ 0:21066c0abaf5 draft
Uploaded
author | willmclaren |
---|---|
date | Fri, 03 Aug 2012 10:04:48 -0400 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
-1:000000000000 | 0:21066c0abaf5 |
---|---|
1 =head1 LICENSE | |
2 | |
3 Copyright (c) 1999-2012 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 Please email comments or questions to the public Ensembl | |
14 developers list at <dev@ensembl.org>. | |
15 | |
16 Questions may also be sent to the Ensembl help desk at | |
17 <helpdesk@ensembl.org>. | |
18 | |
19 =head1 AUTHOR | |
20 | |
21 Juguang Xiao <juguang@tll.org.sg> | |
22 | |
23 =cut | |
24 | |
25 =head1 NAME | |
26 | |
27 Bio::EnsEMBL::Utils::Converter, a converter factory | |
28 | |
29 =head1 SYNOPSIS | |
30 | |
31 my $converter = Bio::EnsEMBL::Utils::Converter->new( | |
32 -in => 'Bio::SeqFeature::Generic', | |
33 -out => 'Bio::EnsEMBL::SimpleFeature' | |
34 ); | |
35 | |
36 my ( $fearture1, $feature2 ); | |
37 my $ens_simple_features = | |
38 $converter->convert( [ $feature1, $feature2 ] ); | |
39 my @ens_simple_features = @{$ens_simple_features}; | |
40 | |
41 =head1 DESCRIPTION | |
42 | |
43 Module to converter the business objects between EnsEMBL and any other | |
44 projects, currently BioPerl. | |
45 | |
46 What the ready conversions are, | |
47 | |
48 Bio::SeqFeature::Generic <-> Bio::EnsEMBL::SeqFeature, Bio::EnsEMBL::SimpleFeature | |
49 Bio::SeqFeature::FeaturePair <-> Bio::EnsEMBL::SeqFeature, Bio::EnsEMBL::RepeatFeature | |
50 Bio::Search::HSP::GenericHSP -> Bio::EnsEMBL::BaseAlignFeature's submodules | |
51 Bio::Tools::Prediction::Gene -> Bio::EnsEMBL::PredictionTranscript | |
52 Bio::Tools::Prediction::Exon -> Bio::EnsEMBL::Exon | |
53 Bio::Pipeline::Analysis -> Bio::EnsEMBL::Analysis | |
54 | |
55 =head1 METHODS | |
56 | |
57 =cut | |
58 | |
59 | |
60 package Bio::EnsEMBL::Utils::Converter; | |
61 | |
62 use strict; | |
63 use Bio::EnsEMBL::Root; | |
64 our @ISA =qw(Bio::EnsEMBL::Root); | |
65 | |
66 =head2 new | |
67 | |
68 Title : new | |
69 Usage : | |
70 my $converter = Bio::EnsEMBL::Utils::Converter->new( | |
71 -in => 'Bio::SeqFeature::Generic', | |
72 -out => 'Bio::EnsEMBL::SimpleFeature' | |
73 ); | |
74 | |
75 Function: constructor for converter object | |
76 Returns : L<Bio::EnsEMBL::Utils::Converter> | |
77 Args : | |
78 in - the module name of the input. | |
79 out - the module name of the output. | |
80 analysis - a Bio::EnsEMBL::Analysis object, if converting other objects to EnsEMBL features. | |
81 contig - a Bio::EnsEMBL::RawContig object, if converting other objects to EnsEMBL features. | |
82 | |
83 =cut | |
84 | |
85 sub new { | |
86 my ($caller, @args) = @_; | |
87 my $class = ref($caller) || $caller; | |
88 | |
89 if($class =~ /Bio::EnsEMBL::Utils::Converter::(\S+)/){ | |
90 my $self = $class->SUPER::new(@args); | |
91 $self->_initialize(@args); | |
92 return $self; | |
93 }else{ | |
94 my %params = @args; | |
95 @params{map {lc $_} keys %params} = values %params; | |
96 my $module = $class->_guess_module($params{-in}, $params{-out}); | |
97 | |
98 return undef unless($class->_load_module($module)); | |
99 return "$module"->new(@args); | |
100 } | |
101 } | |
102 | |
103 # This would be invoked by sub-module's _initialize. | |
104 | |
105 sub _initialize { | |
106 my ($self, @args) = @_; | |
107 | |
108 my ($in, $out) = $self->_rearrange([qw(IN OUT)], @args); | |
109 | |
110 $self->in($in); | |
111 $self->out($out); | |
112 } | |
113 | |
114 =head2 _guess_module | |
115 | |
116 Usage : $module = $class->_guess_module( | |
117 'Bio::EnsEMBL::SimpleFeature', | |
118 'Bio::EnsEMBL::Generic' | |
119 ); | |
120 | |
121 =cut | |
122 | |
123 sub _guess_module { | |
124 my ($self, $in, $out) = @_; | |
125 if($in =~ /^Bio::EnsEMBL::(\S+)/ and $out =~ /^Bio::EnsEMBL::(\S+)/){ | |
126 $self->throw("Cannot convert between EnsEMBL objects.\n[$in] to [$out]"); | |
127 }elsif($in =~ /^Bio::EnsEMBL::(\S+)/){ | |
128 return 'Bio::EnsEMBL::Utils::Converter::ens_bio'; | |
129 }elsif($out =~ /^Bio::EnsEMBL::(\S+)/){ | |
130 return 'Bio::EnsEMBL::Utils::Converter::bio_ens'; | |
131 }else{ | |
132 $self->throw("Cannot convert between non-EnsEMBL objects.\n[$in] to [$out]"); | |
133 } | |
134 } | |
135 | |
136 =head2 convert | |
137 | |
138 Title : convert | |
139 Usage : my $array_ref = $converter->convert(\@input); | |
140 Function: does the actual conversion | |
141 Returns : an array ref of converted objects | |
142 Args : an array ref of converting objects | |
143 | |
144 =cut | |
145 | |
146 sub convert{ | |
147 my ($self, $input) = @_; | |
148 | |
149 $input || $self->throw("Need a ref of array of input objects to convert"); | |
150 | |
151 my $output_module = $self->out; | |
152 $self->throw("Cannot load [$output_module] perl module") | |
153 unless $self->_load_module($output_module); | |
154 | |
155 unless(ref($input) eq 'ARRAY'){ | |
156 $self->warn("The input is supposed to be an array ref"); | |
157 return $self->_convert_single($input); | |
158 } | |
159 | |
160 my @output = (); | |
161 foreach(@{$input}){ | |
162 push(@output, $self->_convert_single($_)); | |
163 } | |
164 | |
165 return \@output; | |
166 } | |
167 | |
168 sub _convert_single{ | |
169 shift->throw("Not implemented. Please check the instance subclass"); | |
170 } | |
171 | |
172 foreach my $field (qw(in out)){ | |
173 my $slot=__PACKAGE__ ."::$field"; | |
174 no strict 'refs'; | |
175 *$field=sub{ | |
176 my $self=shift; | |
177 $self->{$slot}=shift if @_; | |
178 return $self->{$slot}; | |
179 }; | |
180 } | |
181 | |
182 =head2 _load_module | |
183 | |
184 This method is copied from Bio::Root::Root | |
185 | |
186 =cut | |
187 | |
188 sub _load_module { | |
189 my ($self, $name) = @_; | |
190 my ($module, $load, $m); | |
191 $module = "_<$name.pm"; | |
192 return 1 if $main::{$module}; | |
193 | |
194 # untaint operation for safe web-based running (modified after a fix | |
195 # a fix by Lincoln) HL | |
196 if ($name !~ /^([\w:]+)$/) { | |
197 $self->throw("$name is an illegal perl package name"); | |
198 } | |
199 | |
200 $load = "$name.pm"; | |
201 my $io = Bio::Root::IO->new(); | |
202 # catfile comes from IO | |
203 $load = $io->catfile((split(/::/,$load))); | |
204 eval { | |
205 require $load; | |
206 }; | |
207 if ( $@ ) { | |
208 $self->throw("Failed to load module $name. ".$@); | |
209 } | |
210 return 1; | |
211 } | |
212 | |
213 1; |