Mercurial > repos > mahtabm > ensembl
comparison variant_effect_predictor/Bio/EnsEMBL/DBSQL/OperonAdaptor.pm @ 0:1f6dce3d34e0
Uploaded
author | mahtabm |
---|---|
date | Thu, 11 Apr 2013 02:01:53 -0400 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
-1:000000000000 | 0:1f6dce3d34e0 |
---|---|
1 | |
2 =head1 LICENSE | |
3 | |
4 Copyright (c) 1999-2012 The European Bioinformatics Institute and | |
5 Genome Research Limited. All rights reserved. | |
6 | |
7 This software is distributed under a modified Apache license. | |
8 For license details, please see | |
9 | |
10 http://www.ensembl.org/info/about/code_licence.html | |
11 | |
12 =head1 CONTACT | |
13 | |
14 Please email comments or questions to the public Ensembl | |
15 developers list at <dev@ensembl.org>. | |
16 | |
17 Questions may also be sent to the Ensembl help desk at | |
18 <helpdesk@ensembl.org>. | |
19 | |
20 =cut | |
21 | |
22 =head1 NAME | |
23 | |
24 Bio::EnsEMBL::DBSQL::OperonAdaptor - Database adaptor for the retrieval and | |
25 storage of Operon objects | |
26 | |
27 =head1 SYNOPSIS | |
28 | |
29 my $operon_adaptor = Bio::EnsEMBL::DBSQL::OperonAdaptor->new($dba); | |
30 $operon_adaptor->store($operon); | |
31 my $operon2 = $operon_adaptor->fetch_by_dbID( $operon->dbID() ); | |
32 | |
33 =head1 DESCRIPTION | |
34 | |
35 This is a database aware adaptor for the retrieval and storage of operon | |
36 objects. | |
37 | |
38 =head1 METHODS | |
39 | |
40 =cut | |
41 | |
42 package Bio::EnsEMBL::DBSQL::OperonAdaptor; | |
43 | |
44 use strict; | |
45 | |
46 use Bio::EnsEMBL::Utils::Exception qw( deprecate throw warning ); | |
47 use Bio::EnsEMBL::Utils::Scalar qw( assert_ref ); | |
48 use Bio::EnsEMBL::DBSQL::SliceAdaptor; | |
49 use Bio::EnsEMBL::DBSQL::BaseFeatureAdaptor; | |
50 use Bio::EnsEMBL::DBSQL::DBAdaptor; | |
51 use Bio::EnsEMBL::Operon; | |
52 | |
53 use vars '@ISA'; | |
54 @ISA = qw(Bio::EnsEMBL::DBSQL::BaseFeatureAdaptor); | |
55 | |
56 # _tables | |
57 # Arg [1] : none | |
58 # Description: PROTECTED implementation of superclass abstract method. | |
59 # Returns the names, aliases of the tables to use for queries. | |
60 # Returntype : list of listrefs of strings | |
61 # Exceptions : none | |
62 # Caller : internal | |
63 # Status : Stable | |
64 | |
65 sub _tables { | |
66 return ( [ 'operon', 'o' ] ); | |
67 } | |
68 | |
69 # _columns | |
70 # Arg [1] : none | |
71 # Example : none | |
72 # Description: PROTECTED implementation of superclass abstract method. | |
73 # Returns a list of columns to use for queries. | |
74 # Returntype : list of strings | |
75 # Exceptions : none | |
76 # Caller : internal | |
77 # Status : Stable | |
78 | |
79 sub _columns { | |
80 my ($self) = @_; | |
81 | |
82 my $created_date = | |
83 $self->db()->dbc()->from_date_to_seconds("o.created_date"); | |
84 my $modified_date = | |
85 $self->db()->dbc()->from_date_to_seconds("o.modified_date"); | |
86 | |
87 return ( 'o.operon_id', 'o.seq_region_id', 'o.seq_region_start', | |
88 'o.seq_region_end', 'o.seq_region_strand', 'o.display_label', | |
89 'o.analysis_id', 'o.stable_id', 'o.version', | |
90 $created_date, $modified_date ); | |
91 } | |
92 | |
93 =head2 list_dbIDs | |
94 | |
95 Example : @operon_ids = @{$operon_adaptor->list_dbIDs()}; | |
96 Description: Gets an array of internal ids for all operons in the current db | |
97 Arg[1] : <optional> int. not 0 for the ids to be sorted by the seq_region. | |
98 Returntype : Listref of Ints | |
99 Exceptions : none | |
100 Caller : general | |
101 Status : Stable | |
102 | |
103 =cut | |
104 | |
105 sub list_dbIDs { | |
106 my ( $self, $ordered ) = @_; | |
107 | |
108 return $self->_list_dbIDs( "operon", undef, $ordered ); | |
109 } | |
110 | |
111 =head2 list_stable_ids | |
112 | |
113 Example : @stable_operon_ids = @{$operon_adaptor->list_stable_ids()}; | |
114 Description: Gets an listref of stable ids for all operons in the current db | |
115 Returntype : reference to a list of strings | |
116 Exceptions : none | |
117 Caller : general | |
118 Status : Stable | |
119 | |
120 =cut | |
121 | |
122 sub list_stable_ids { | |
123 my ($self) = @_; | |
124 | |
125 return $self->_list_dbIDs( "operon", "stable_id" ); | |
126 } | |
127 | |
128 sub list_seq_region_ids { | |
129 my $self = shift; | |
130 | |
131 return $self->_list_seq_region_ids('operon'); | |
132 } | |
133 | |
134 =head2 fetch_by_name | |
135 | |
136 Arg [1] : String $label - name of operon to fetch | |
137 Example : my $operon = $operonAdaptor->fetch_by_name("accBC"); | |
138 Description: Returns the operon which has the given display label or undef if | |
139 there is none. If there are more than 1, only the first is | |
140 reported. | |
141 Returntype : Bio::EnsEMBL::Operon | |
142 Exceptions : none | |
143 Caller : general | |
144 Status : Stable | |
145 | |
146 =cut | |
147 | |
148 sub fetch_by_name { | |
149 my $self = shift; | |
150 my $label = shift; | |
151 | |
152 my $constraint = "o.display_label = ?"; | |
153 $self->bind_param_generic_fetch( $label, SQL_VARCHAR ); | |
154 my ($operon) = @{ $self->generic_fetch($constraint) }; | |
155 | |
156 return $operon; | |
157 } | |
158 | |
159 =head2 fetch_by_stable_id | |
160 | |
161 Arg [1] : String $id | |
162 The stable ID of the operon to retrieve | |
163 Example : $operon = $operon_adaptor->fetch_by_stable_id('ENSG00000148944'); | |
164 Description: Retrieves a operon object from the database via its stable id. | |
165 The operon will be retrieved in its native coordinate system (i.e. | |
166 in the coordinate system it is stored in the database). It may | |
167 be converted to a different coordinate system through a call to | |
168 transform() or transfer(). If the operon or exon is not found | |
169 undef is returned instead. | |
170 Returntype : Bio::EnsEMBL::Operon or undef | |
171 Exceptions : if we cant get the operon in given coord system | |
172 Caller : general | |
173 Status : Stable | |
174 | |
175 =cut | |
176 | |
177 sub fetch_by_stable_id { | |
178 my ( $self, $stable_id ) = @_; | |
179 | |
180 my $constraint = "o.stable_id = ?"; | |
181 $self->bind_param_generic_fetch( $stable_id, SQL_VARCHAR ); | |
182 my ($operon) = @{ $self->generic_fetch($constraint) }; | |
183 | |
184 return $operon; | |
185 } | |
186 | |
187 =head2 fetch_all | |
188 | |
189 Example : $operons = $operon_adaptor->fetch_all(); | |
190 Description : Similar to fetch_by_stable_id, but retrieves all | |
191 operons stored in the database. | |
192 Returntype : listref of Bio::EnsEMBL::Operon | |
193 Caller : general | |
194 Status : At Risk | |
195 | |
196 =cut | |
197 | |
198 sub fetch_all { | |
199 my ($self) = @_; | |
200 | |
201 my $constraint = ''; | |
202 my @operons = @{ $self->generic_fetch($constraint) }; | |
203 return \@operons; | |
204 } | |
205 | |
206 =head2 fetch_all_versions_by_stable_id | |
207 | |
208 Arg [1] : String $stable_id | |
209 The stable ID of the operon to retrieve | |
210 Example : $operon = $operon_adaptor->fetch_all_versions_by_stable_id | |
211 ('ENSG00000148944'); | |
212 Description : Similar to fetch_by_stable_id, but retrieves all versions of a | |
213 operon stored in the database. | |
214 Returntype : listref of Bio::EnsEMBL::Operon | |
215 Exceptions : if we cant get the operon in given coord system | |
216 Caller : general | |
217 Status : At Risk | |
218 | |
219 =cut | |
220 | |
221 sub fetch_all_versions_by_stable_id { | |
222 my ( $self, $stable_id ) = @_; | |
223 | |
224 my $constraint = "o.stable_id = ?"; | |
225 $self->bind_param_generic_fetch( $stable_id, SQL_VARCHAR ); | |
226 return $self->generic_fetch($constraint); | |
227 } | |
228 | |
229 =head2 fetch_all_by_Slice | |
230 | |
231 Arg [1] : Bio::EnsEMBL::Slice $slice | |
232 The slice to fetch operons on. | |
233 Arg [2] : (optional) string $logic_name | |
234 the logic name of the type of features to obtain | |
235 Arg [3] : (optional) boolean $load_transcripts | |
236 if true, transcripts will be loaded immediately rather than | |
237 lazy loaded later. | |
238 Arg [4] : (optional) string $source | |
239 the source name of the features to obtain. | |
240 Arg [5] : (optional) string biotype | |
241 the biotype of the features to obtain. | |
242 Example : @operons = @{$operon_adaptor->fetch_all_by_Slice()}; | |
243 Description: Overrides superclass method to optionally load transcripts | |
244 immediately rather than lazy-loading them later. This | |
245 is more efficient when there are a lot of operons whose | |
246 transcripts are going to be used. | |
247 Returntype : reference to list of operons | |
248 Exceptions : thrown if exon cannot be placed on transcript slice | |
249 Caller : Slice::get_all_operons | |
250 Status : Stable | |
251 | |
252 =cut | |
253 | |
254 sub fetch_all_by_Slice { | |
255 my ( $self, $slice, $logic_name, $load_transcripts ) = @_; | |
256 | |
257 my $constraint = ''; | |
258 my $operons = | |
259 $self->SUPER::fetch_all_by_Slice_constraint( $slice, $constraint, | |
260 $logic_name ); | |
261 | |
262 # If there are less than two operons, still do lazy-loading. | |
263 if ( !$load_transcripts || @$operons < 2 ) { | |
264 return $operons; | |
265 } | |
266 | |
267 # Preload all of the transcripts now, instead of lazy loading later, | |
268 # faster than one query per transcript. | |
269 | |
270 # First check if transcripts are already preloaded. | |
271 # FIXME: Should check all transcripts. | |
272 if ( exists( $operons->[0]->{'_operon_transcript_array'} ) ) { | |
273 return $operons; | |
274 } | |
275 | |
276 # Get extent of region spanned by transcripts. | |
277 my ( $min_start, $max_end ); | |
278 foreach my $o (@$operons) { | |
279 if ( !defined($min_start) || $o->seq_region_start() < $min_start ) { | |
280 $min_start = $o->seq_region_start(); | |
281 } | |
282 if ( !defined($max_end) || $o->seq_region_end() > $max_end ) { | |
283 $max_end = $o->seq_region_end(); | |
284 } | |
285 } | |
286 | |
287 my $ext_slice; | |
288 | |
289 if ( $min_start >= $slice->start() && $max_end <= $slice->end() ) { | |
290 $ext_slice = $slice; | |
291 } else { | |
292 my $sa = $self->db()->get_SliceAdaptor(); | |
293 $ext_slice = | |
294 $sa->fetch_by_region( $slice->coord_system->name(), | |
295 $slice->seq_region_name(), | |
296 $min_start, | |
297 $max_end, | |
298 $slice->strand(), | |
299 $slice->coord_system->version() ); | |
300 } | |
301 | |
302 # Associate transcript identifiers with operons. | |
303 | |
304 my %o_hash = map { $_->dbID => $_ } @{$operons}; | |
305 | |
306 my $o_id_str = join( ',', keys(%o_hash) ); | |
307 | |
308 my $sth = | |
309 $self->prepare( "SELECT operon_id, operon_transcript_id " | |
310 . "FROM operon_transcript " | |
311 . "WHERE operon_id IN ($o_id_str)" ); | |
312 | |
313 $sth->execute(); | |
314 | |
315 my ( $o_id, $tr_id ); | |
316 $sth->bind_columns( \( $o_id, $tr_id ) ); | |
317 | |
318 my %tr_o_hash; | |
319 | |
320 while ( $sth->fetch() ) { | |
321 $tr_o_hash{$tr_id} = $o_hash{$o_id}; | |
322 } | |
323 | |
324 my $ta = $self->db()->get_OperonTranscriptAdaptor(); | |
325 my $transcripts = | |
326 $ta->fetch_all_by_Slice( $ext_slice, | |
327 1, undef, | |
328 sprintf( "ot.operon_transcript_id IN (%s)", | |
329 join( ',', | |
330 sort { $a <=> $b } | |
331 keys(%tr_o_hash) ) ) ); | |
332 | |
333 # Move transcripts onto operon slice, and add them to operons. | |
334 foreach my $tr ( @{$transcripts} ) { | |
335 if ( !exists( $tr_o_hash{ $tr->dbID() } ) ) { next } | |
336 | |
337 my $new_tr; | |
338 if ( $slice != $ext_slice ) { | |
339 $new_tr = $tr->transfer($slice); | |
340 if ( !defined($new_tr) ) { | |
341 throw( "Unexpected. " | |
342 . "Transcript could not be transfered onto operon slice." | |
343 ); | |
344 } | |
345 } else { | |
346 $new_tr = $tr; | |
347 } | |
348 | |
349 $tr_o_hash{ $tr->dbID() }->add_OperonTranscript($new_tr); | |
350 } | |
351 | |
352 return $operons; | |
353 } ## end sub fetch_all_by_Slice | |
354 | |
355 =head2 fetch_by_transcript_id | |
356 | |
357 Arg [1] : Int $trans_id | |
358 Unique database identifier for the transcript whose operon should | |
359 be retrieved. The operon is returned in its native coord | |
360 system (i.e. the coord_system it is stored in). If the coord | |
361 system needs to be changed, then tranform or transfer should | |
362 be called on the returned object. undef is returned if the | |
363 operon or transcript is not found in the database. | |
364 Example : $operon = $operon_adaptor->fetch_by_transcript_id(1241); | |
365 Description: Retrieves a operon from the database via the database identifier | |
366 of one of its transcripts. | |
367 Returntype : Bio::EnsEMBL::Operon | |
368 Exceptions : none | |
369 Caller : operonral | |
370 Status : Stable | |
371 | |
372 =cut | |
373 | |
374 sub fetch_by_operon_transcript_id { | |
375 my ( $self, $trans_id ) = @_; | |
376 | |
377 # this is a cheap SQL call | |
378 my $sth = $self->prepare( | |
379 qq( | |
380 SELECT tr.operon_id | |
381 FROM operon_transcript tr | |
382 WHERE tr.operon_transcript_id = ? | |
383 ) ); | |
384 | |
385 $sth->bind_param( 1, $trans_id, SQL_INTEGER ); | |
386 $sth->execute(); | |
387 | |
388 my ($operonid) = $sth->fetchrow_array(); | |
389 | |
390 $sth->finish(); | |
391 | |
392 return undef if ( !defined $operonid ); | |
393 | |
394 my $operon = $self->fetch_by_dbID($operonid); | |
395 return $operon; | |
396 } | |
397 | |
398 =head2 fetch_by_operon_transcript_stable_id | |
399 | |
400 Arg [1] : string $trans_stable_id | |
401 transcript stable ID whose operon should be retrieved | |
402 Example : my $operon = $operon_adaptor->fetch_by_operon_transcript_stable_id | |
403 ('ENST0000234'); | |
404 Description: Retrieves a operon from the database via the stable ID of one of | |
405 its transcripts | |
406 Returntype : Bio::EnsEMBL::Operon | |
407 Exceptions : none | |
408 Caller : operonral | |
409 Status : Stable | |
410 | |
411 =cut | |
412 | |
413 sub fetch_by_operon_transcript_stable_id { | |
414 my ( $self, $trans_stable_id ) = @_; | |
415 | |
416 my $sth = $self->prepare( | |
417 qq( | |
418 SELECT operon_id | |
419 FROM operon_transcript | |
420 WHERE stable_id = ? | |
421 ) ); | |
422 | |
423 $sth->bind_param( 1, $trans_stable_id, SQL_VARCHAR ); | |
424 $sth->execute(); | |
425 | |
426 my ($operonid) = $sth->fetchrow_array(); | |
427 $sth->finish; | |
428 | |
429 return undef if ( !defined $operonid ); | |
430 | |
431 my $operon = $self->fetch_by_dbID($operonid); | |
432 return $operon; | |
433 } | |
434 | |
435 sub fetch_by_operon_transcript { | |
436 my ( $self, $trans ) = @_; | |
437 assert_ref( $trans, 'Bio::EnsEMBL::OperonTranscript' ); | |
438 $self->fetch_by_operon_transcript_id( $trans->dbID() ); | |
439 } | |
440 | |
441 =head2 store | |
442 | |
443 Arg [1] : Bio::EnsEMBL::Operon $operon | |
444 The operon to store in the database | |
445 Arg [2] : ignore_release in xrefs [default 1] set to 0 to use release info | |
446 in external database references | |
447 Example : $operon_adaptor->store($operon); | |
448 Description: Stores a operon in the database. | |
449 Returntype : the database identifier (dbID) of the newly stored operon | |
450 Exceptions : thrown if the $operon is not a Bio::EnsEMBL::Operon or if | |
451 $operon does not have an analysis object | |
452 Caller : general | |
453 Status : Stable | |
454 | |
455 =cut | |
456 | |
457 sub store { | |
458 my ( $self, $operon, $ignore_release ) = @_; | |
459 | |
460 if ( !ref $operon || !$operon->isa('Bio::EnsEMBL::Operon') ) { | |
461 throw("Must store a operon object, not a $operon"); | |
462 } | |
463 | |
464 my $db = $self->db(); | |
465 | |
466 if ( $operon->is_stored($db) ) { | |
467 return $operon->dbID(); | |
468 } | |
469 my $analysis = $operon->analysis(); | |
470 throw("Operons must have an analysis object.") if(!defined($analysis)); | |
471 my $analysis_id; | |
472 if ( $analysis->is_stored($db) ) { | |
473 $analysis_id = $analysis->dbID(); | |
474 } else { | |
475 $analysis_id = $db->get_AnalysisAdaptor->store( $analysis ); | |
476 } | |
477 # ensure coords are correct before storing | |
478 #$operon->recalculate_coordinates(); | |
479 | |
480 my $seq_region_id; | |
481 | |
482 ( $operon, $seq_region_id ) = $self->_pre_store($operon); | |
483 | |
484 my $store_operon_sql = qq( | |
485 INSERT INTO operon | |
486 SET seq_region_id = ?, | |
487 seq_region_start = ?, | |
488 seq_region_end = ?, | |
489 seq_region_strand = ?, | |
490 display_label = ?, | |
491 analysis_id = ? | |
492 ); | |
493 | |
494 if ( defined($operon->stable_id()) ) { | |
495 my $created = $self->db->dbc->from_seconds_to_date($operon->created_date()); | |
496 my $modified = $self->db->dbc->from_seconds_to_date($operon->modified_date()); | |
497 $store_operon_sql .= ", stable_id = ?, version = ?, created_date = " . $created . ",modified_date = " . $modified; | |
498 } | |
499 | |
500 # column status is used from schema version 34 onwards (before it was | |
501 # confidence) | |
502 | |
503 my $sth = $self->prepare($store_operon_sql); | |
504 $sth->bind_param( 1, $seq_region_id, SQL_INTEGER ); | |
505 $sth->bind_param( 2, $operon->start(), SQL_INTEGER ); | |
506 $sth->bind_param( 3, $operon->end(), SQL_INTEGER ); | |
507 $sth->bind_param( 4, $operon->strand(), SQL_TINYINT ); | |
508 $sth->bind_param( 5, $operon->display_label(), SQL_VARCHAR ); | |
509 $sth->bind_param( 6, $analysis_id, SQL_INTEGER ); | |
510 | |
511 if ( defined($operon->stable_id()) ) { | |
512 $sth->bind_param( 7, $operon->stable_id(), SQL_VARCHAR ); | |
513 my $version = ($operon->version()) ? $operon->version() : 1; | |
514 $sth->bind_param( 8, $version, SQL_INTEGER ); | |
515 } | |
516 | |
517 $sth->execute(); | |
518 $sth->finish(); | |
519 | |
520 my $operon_dbID = $sth->{'mysql_insertid'}; | |
521 | |
522 my $transcripts = $operon->get_all_OperonTranscripts(); | |
523 | |
524 if ( $transcripts && scalar @$transcripts ) { | |
525 my $transcript_adaptor = $db->get_OperonTranscriptAdaptor(); | |
526 for my $transcript (@$transcripts) { | |
527 $transcript_adaptor->store( $transcript, $operon_dbID ); | |
528 } | |
529 } | |
530 | |
531 # store the dbentries associated with this operon | |
532 my $dbEntryAdaptor = $db->get_DBEntryAdaptor(); | |
533 | |
534 foreach my $dbe ( @{ $operon->get_all_DBEntries } ) { | |
535 $dbEntryAdaptor->store( $dbe, $operon_dbID, "Operon", $ignore_release ); | |
536 } | |
537 | |
538 # store operon attributes if there are any | |
539 my $attrs = $operon->get_all_Attributes(); | |
540 if ( $attrs && scalar @$attrs ) { | |
541 my $attr_adaptor = $db->get_AttributeAdaptor(); | |
542 $attr_adaptor->store_on_Operon( $operon, $attrs ); | |
543 } | |
544 | |
545 # set the adaptor and dbID on the original passed in operon not the | |
546 # transfered copy | |
547 $operon->adaptor($self); | |
548 $operon->dbID($operon_dbID); | |
549 | |
550 return $operon_dbID; | |
551 } ## end sub store | |
552 | |
553 =head2 remove | |
554 | |
555 Arg [1] : Bio::EnsEMBL::Operon $operon | |
556 the operon to remove from the database | |
557 Example : $operon_adaptor->remove($operon); | |
558 Description: Removes a operon completely from the database. All associated | |
559 transcripts, exons, stable_identifiers, descriptions, etc. | |
560 are removed as well. Use with caution! | |
561 Returntype : none | |
562 Exceptions : throw on incorrect arguments | |
563 warning if operon is not stored in this database | |
564 Caller : general | |
565 Status : Stable | |
566 | |
567 =cut | |
568 | |
569 sub remove { | |
570 my $self = shift; | |
571 my $operon = shift; | |
572 | |
573 if ( !ref($operon) || !$operon->isa('Bio::EnsEMBL::Operon') ) { | |
574 throw("Bio::EnsEMBL::Operon argument expected."); | |
575 } | |
576 | |
577 if ( !$operon->is_stored( $self->db() ) ) { | |
578 warning( "Cannot remove operon " | |
579 . $operon->dbID() | |
580 . ". Is not stored in " | |
581 . "this database." ); | |
582 return; | |
583 } | |
584 | |
585 # remove all object xrefs associated with this operon | |
586 | |
587 my $dbe_adaptor = $self->db()->get_DBEntryAdaptor(); | |
588 foreach my $dbe ( @{ $operon->get_all_DBEntries() } ) { | |
589 $dbe_adaptor->remove_from_object( $dbe, $operon, 'Operon' ); | |
590 } | |
591 | |
592 # remove all of the transcripts associated with this operon | |
593 my $transcriptAdaptor = $self->db->get_OperonTranscriptAdaptor(); | |
594 foreach my $trans ( @{ $operon->get_all_OperonTranscripts() } ) { | |
595 $transcriptAdaptor->remove($trans); | |
596 } | |
597 | |
598 # remove this operon from the database | |
599 | |
600 my $sth = $self->prepare("DELETE FROM operon WHERE operon_id = ? "); | |
601 $sth->bind_param( 1, $operon->dbID, SQL_INTEGER ); | |
602 $sth->execute(); | |
603 $sth->finish(); | |
604 | |
605 # unset the operon identifier and adaptor thereby flagging it as unstored | |
606 | |
607 $operon->dbID(undef); | |
608 $operon->adaptor(undef); | |
609 | |
610 return; | |
611 } ## end sub remove | |
612 | |
613 # _objs_from_sth | |
614 | |
615 # Arg [1] : StatementHandle $sth | |
616 # Arg [2] : Bio::EnsEMBL::AssemblyMapper $mapper | |
617 # Arg [3] : Bio::EnsEMBL::Slice $dest_slice | |
618 # Description: PROTECTED implementation of abstract superclass method. | |
619 # responsible for the creation of Operons | |
620 # Returntype : listref of Bio::EnsEMBL::Operon in target coordinate system | |
621 # Exceptions : none | |
622 # Caller : internal | |
623 # Status : Stable | |
624 | |
625 sub _objs_from_sth { | |
626 my ( $self, $sth, $mapper, $dest_slice ) = @_; | |
627 | |
628 # | |
629 # This code is ugly because an attempt has been made to remove as many | |
630 # function calls as possible for speed purposes. Thus many caches and | |
631 # a fair bit of gymnastics is used. | |
632 # | |
633 | |
634 my $sa = $self->db()->get_SliceAdaptor(); | |
635 my $aa = $self->db->get_AnalysisAdaptor(); | |
636 | |
637 my @operons; | |
638 my %analysis_hash; | |
639 my %slice_hash; | |
640 my %sr_name_hash; | |
641 my %sr_cs_hash; | |
642 my ( $stable_id, $version, $created_date, $modified_date, $analysis_id ); | |
643 | |
644 my ( $operon_id, $seq_region_id, $seq_region_start, | |
645 $seq_region_end, $seq_region_strand, $display_label ); | |
646 | |
647 $sth->bind_columns( \$operon_id, \$seq_region_id, | |
648 \$seq_region_start, \$seq_region_end, | |
649 \$seq_region_strand, \$display_label, | |
650 \$analysis_id, \$stable_id, | |
651 \$version, \$created_date, | |
652 \$modified_date ); | |
653 | |
654 my $asm_cs; | |
655 my $cmp_cs; | |
656 my $asm_cs_vers; | |
657 my $asm_cs_name; | |
658 my $cmp_cs_vers; | |
659 my $cmp_cs_name; | |
660 if ($mapper) { | |
661 $asm_cs = $mapper->assembled_CoordSystem(); | |
662 $cmp_cs = $mapper->component_CoordSystem(); | |
663 $asm_cs_name = $asm_cs->name(); | |
664 $asm_cs_vers = $asm_cs->version(); | |
665 $cmp_cs_name = $cmp_cs->name(); | |
666 $cmp_cs_vers = $cmp_cs->version(); | |
667 } | |
668 | |
669 my $dest_slice_start; | |
670 my $dest_slice_end; | |
671 my $dest_slice_strand; | |
672 my $dest_slice_length; | |
673 my $dest_slice_sr_name; | |
674 my $dest_slice_seq_region_id; | |
675 if ($dest_slice) { | |
676 $dest_slice_start = $dest_slice->start(); | |
677 $dest_slice_end = $dest_slice->end(); | |
678 $dest_slice_strand = $dest_slice->strand(); | |
679 $dest_slice_length = $dest_slice->length(); | |
680 $dest_slice_sr_name = $dest_slice->seq_region_name(); | |
681 $dest_slice_seq_region_id = $dest_slice->get_seq_region_id(); | |
682 } | |
683 | |
684 my $count = 0; | |
685 OPERON: while ( $sth->fetch() ) { | |
686 $count++; | |
687 #get the analysis object | |
688 my $analysis = $analysis_hash{$analysis_id} ||= | |
689 $aa->fetch_by_dbID($analysis_id); | |
690 $analysis_hash{$analysis_id} = $analysis; | |
691 #need to get the internal_seq_region, if present | |
692 $seq_region_id = $self->get_seq_region_id_internal($seq_region_id); | |
693 #get the slice object | |
694 my $slice = $slice_hash{ "ID:" . $seq_region_id }; | |
695 | |
696 if ( !$slice ) { | |
697 $slice = $sa->fetch_by_seq_region_id($seq_region_id); | |
698 $slice_hash{ "ID:" . $seq_region_id } = $slice; | |
699 $sr_name_hash{$seq_region_id} = $slice->seq_region_name(); | |
700 $sr_cs_hash{$seq_region_id} = $slice->coord_system(); | |
701 } | |
702 | |
703 my $sr_name = $sr_name_hash{$seq_region_id}; | |
704 my $sr_cs = $sr_cs_hash{$seq_region_id}; | |
705 # | |
706 # remap the feature coordinates to another coord system | |
707 # if a mapper was provided | |
708 # | |
709 if ($mapper) { | |
710 | |
711 | |
712 if (defined $dest_slice && $mapper->isa('Bio::EnsEMBL::ChainedAssemblyMapper') ) { | |
713 ( $seq_region_id, $seq_region_start, | |
714 $seq_region_end, $seq_region_strand ) | |
715 = | |
716 $mapper->map( $sr_name, $seq_region_start, $seq_region_end, | |
717 $seq_region_strand, $sr_cs, 1, $dest_slice); | |
718 | |
719 } else { | |
720 | |
721 ( $seq_region_id, $seq_region_start, | |
722 $seq_region_end, $seq_region_strand ) | |
723 = | |
724 $mapper->fastmap( $sr_name, $seq_region_start, $seq_region_end, | |
725 $seq_region_strand, $sr_cs ); | |
726 } | |
727 | |
728 #skip features that map to gaps or coord system boundaries | |
729 next OPERON if ( !defined($seq_region_id) ); | |
730 | |
731 #get a slice in the coord system we just mapped to | |
732 if ( $asm_cs == $sr_cs | |
733 || ( $cmp_cs != $sr_cs && $asm_cs->equals($sr_cs) ) ) | |
734 { | |
735 $slice = $slice_hash{ "ID:" . $seq_region_id } ||= | |
736 $sa->fetch_by_seq_region_id($seq_region_id); | |
737 } else { | |
738 $slice = $slice_hash{ "ID:" . $seq_region_id } ||= | |
739 $sa->fetch_by_seq_region_id($seq_region_id); | |
740 } | |
741 } | |
742 | |
743 # | |
744 # If a destination slice was provided convert the coords | |
745 # If the dest_slice starts at 1 and is foward strand, nothing needs doing | |
746 # | |
747 if ($dest_slice) { | |
748 if ( $dest_slice_start != 1 || $dest_slice_strand != 1 ) { | |
749 if ( $dest_slice_strand == 1 ) { | |
750 $seq_region_start = | |
751 $seq_region_start - $dest_slice_start + 1; | |
752 $seq_region_end = $seq_region_end - $dest_slice_start + 1; | |
753 } else { | |
754 my $tmp_seq_region_start = $seq_region_start; | |
755 $seq_region_start = $dest_slice_end - $seq_region_end + 1; | |
756 $seq_region_end = | |
757 $dest_slice_end - $tmp_seq_region_start + 1; | |
758 $seq_region_strand *= -1; | |
759 } | |
760 } | |
761 | |
762 #throw away features off the end of the requested slice | |
763 if ( $seq_region_end < 1 | |
764 || $seq_region_start > $dest_slice_length | |
765 || ( $dest_slice_seq_region_id != $seq_region_id ) ) | |
766 { | |
767 # print STDERR "IGNORED DUE TO CUTOFF $dest_slice_seq_region_id ne $seq_region_id . $sr_name\n"; | |
768 next OPERON; | |
769 } | |
770 $slice = $dest_slice; | |
771 } ## end if ($dest_slice) | |
772 | |
773 push( @operons, | |
774 Bio::EnsEMBL::Operon->new( | |
775 -START => $seq_region_start, | |
776 -END => $seq_region_end, | |
777 -STRAND => $seq_region_strand, | |
778 -SLICE => $slice, | |
779 -DISPLAY_LABEL => $display_label, | |
780 -ADAPTOR => $self, | |
781 -DBID => $operon_id, | |
782 -STABLE_ID => $stable_id, | |
783 -VERSION => $version, | |
784 -CREATED_DATE => $created_date || undef, | |
785 -MODIFIED_DATE => $modified_date || undef, | |
786 -ANALYSIS => $analysis ) ); | |
787 | |
788 } ## end while ( $sth->fetch() ) | |
789 | |
790 return \@operons; | |
791 } ## end sub _objs_from_sth | |
792 | |
793 1; | |
794 |