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