OperonAdaptor.pm 23.4 KB
Newer Older
1 2
=head1 LICENSE

3 4 5 6 7 8 9 10 11 12 13 14 15 16 17
Copyright [1999-2013] Wellcome Trust Sanger Institute and the EMBL-European Bioinformatics Institute

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

     http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.

=cut
18 19 20 21 22 23



=head1 CONTACT

  Please email comments or questions to the public Ensembl
Magali Ruffier's avatar
Magali Ruffier committed
24
  developers list at <http://lists.ensembl.org/mailman/listinfo/dev>.
25 26

  Questions may also be sent to the Ensembl help desk at
Magali Ruffier's avatar
Magali Ruffier committed
27
  <http://www.ensembl.org/Help/Contact>.
28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74

=cut

=head1 NAME

Bio::EnsEMBL::DBSQL::OperonAdaptor - Database adaptor for the retrieval and
storage of Operon objects

=head1 SYNOPSIS

my $operon_adaptor =  Bio::EnsEMBL::DBSQL::OperonAdaptor->new($dba);
$operon_adaptor->store($operon);
my $operon2 = $operon_adaptor->fetch_by_dbID( $operon->dbID() );

=head1 DESCRIPTION

This is a database aware adaptor for the retrieval and storage of operon
objects.

=head1 METHODS

=cut

package Bio::EnsEMBL::DBSQL::OperonAdaptor;

use strict;

use Bio::EnsEMBL::Utils::Exception qw( deprecate throw warning );
use Bio::EnsEMBL::Utils::Scalar qw( assert_ref );
use Bio::EnsEMBL::DBSQL::SliceAdaptor;
use Bio::EnsEMBL::DBSQL::BaseFeatureAdaptor;
use Bio::EnsEMBL::DBSQL::DBAdaptor;
use Bio::EnsEMBL::Operon;

use vars '@ISA';
@ISA = qw(Bio::EnsEMBL::DBSQL::BaseFeatureAdaptor);

# _tables
#  Arg [1]    : none
#  Description: PROTECTED implementation of superclass abstract method.
#               Returns the names, aliases of the tables to use for queries.
#  Returntype : list of listrefs of strings
#  Exceptions : none
#  Caller     : internal
#  Status     : Stable

sub _tables {
Monika Komorowska's avatar
Monika Komorowska committed
75
	return ( [ 'operon', 'o' ] );
76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91
}

# _columns
#  Arg [1]    : none
#  Example    : none
#  Description: PROTECTED implementation of superclass abstract method.
#               Returns a list of columns to use for queries.
#  Returntype : list of strings
#  Exceptions : none
#  Caller     : internal
#  Status     : Stable

sub _columns {
	my ($self) = @_;

	my $created_date =
Monika Komorowska's avatar
Monika Komorowska committed
92
	  $self->db()->dbc()->from_date_to_seconds("o.created_date");
93
	my $modified_date =
Monika Komorowska's avatar
Monika Komorowska committed
94
	  $self->db()->dbc()->from_date_to_seconds("o.modified_date");
95 96 97

	return ( 'o.operon_id',      'o.seq_region_id',     'o.seq_region_start',
			 'o.seq_region_end', 'o.seq_region_strand', 'o.display_label',
Monika Komorowska's avatar
Monika Komorowska committed
98
			 'o.analysis_id',    'o.stable_id',       'o.version',
99
			 $created_date,      $modified_date );
100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133
}

=head2 list_dbIDs 

  Example    : @operon_ids = @{$operon_adaptor->list_dbIDs()};
  Description: Gets an array of internal ids for all operons in the current db
  Arg[1]     : <optional> int. not 0 for the ids to be sorted by the seq_region.
  Returntype : Listref of Ints
  Exceptions : none
  Caller     : general
  Status     : Stable

=cut

sub list_dbIDs {
	my ( $self, $ordered ) = @_;

	return $self->_list_dbIDs( "operon", undef, $ordered );
}

=head2 list_stable_ids

  Example    : @stable_operon_ids = @{$operon_adaptor->list_stable_ids()};
  Description: Gets an listref of stable ids for all operons in the current db
  Returntype : reference to a list of strings
  Exceptions : none
  Caller     : general
  Status     : Stable

=cut

sub list_stable_ids {
	my ($self) = @_;

Monika Komorowska's avatar
Monika Komorowska committed
134
	return $self->_list_dbIDs( "operon", "stable_id" );
135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188
}

sub list_seq_region_ids {
	my $self = shift;

	return $self->_list_seq_region_ids('operon');
}

=head2 fetch_by_name

  Arg [1]    : String $label - name of operon to fetch
  Example    : my $operon = $operonAdaptor->fetch_by_name("accBC");
  Description: Returns the operon which has the given display label or undef if
               there is none. If there are more than 1, only the first is
               reported.
  Returntype : Bio::EnsEMBL::Operon
  Exceptions : none
  Caller     : general
  Status     : Stable

=cut

sub fetch_by_name {
	my $self  = shift;
	my $label = shift;

	my $constraint = "o.display_label = ?";
	$self->bind_param_generic_fetch( $label, SQL_VARCHAR );
	my ($operon) = @{ $self->generic_fetch($constraint) };

	return $operon;
}

=head2 fetch_by_stable_id

  Arg [1]    : String $id 
               The stable ID of the operon to retrieve
  Example    : $operon = $operon_adaptor->fetch_by_stable_id('ENSG00000148944');
  Description: Retrieves a operon object from the database via its stable id.
               The operon will be retrieved in its native coordinate system (i.e.
               in the coordinate system it is stored in the database). It may
               be converted to a different coordinate system through a call to
               transform() or transfer(). If the operon or exon is not found
               undef is returned instead.
  Returntype : Bio::EnsEMBL::Operon or undef
  Exceptions : if we cant get the operon in given coord system
  Caller     : general
  Status     : Stable

=cut

sub fetch_by_stable_id {
	my ( $self, $stable_id ) = @_;

Monika Komorowska's avatar
Monika Komorowska committed
189
	my $constraint = "o.stable_id = ?";
190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205
	$self->bind_param_generic_fetch( $stable_id, SQL_VARCHAR );
	my ($operon) = @{ $self->generic_fetch($constraint) };

	return $operon;
}

=head2 fetch_all

  Example     : $operons = $operon_adaptor->fetch_all();
  Description : Similar to fetch_by_stable_id, but retrieves all
                operons stored in the database.
  Returntype  : listref of Bio::EnsEMBL::Operon
  Caller      : general
  Status      : At Risk

=cut
206

207 208 209 210
sub fetch_all {
	my ($self) = @_;

	my $constraint = '';
211
	my @operons    = @{ $self->generic_fetch($constraint) };
212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232
	return \@operons;
}

=head2 fetch_all_versions_by_stable_id 

  Arg [1]     : String $stable_id 
                The stable ID of the operon to retrieve
  Example     : $operon = $operon_adaptor->fetch_all_versions_by_stable_id
                  ('ENSG00000148944');
  Description : Similar to fetch_by_stable_id, but retrieves all versions of a
                operon stored in the database.
  Returntype  : listref of Bio::EnsEMBL::Operon
  Exceptions  : if we cant get the operon in given coord system
  Caller      : general
  Status      : At Risk

=cut

sub fetch_all_versions_by_stable_id {
	my ( $self, $stable_id ) = @_;

Monika Komorowska's avatar
Monika Komorowska committed
233
	my $constraint = "o.stable_id = ?";
234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349
	$self->bind_param_generic_fetch( $stable_id, SQL_VARCHAR );
	return $self->generic_fetch($constraint);
}

=head2 fetch_all_by_Slice

  Arg [1]    : Bio::EnsEMBL::Slice $slice
               The slice to fetch operons on.
  Arg [2]    : (optional) string $logic_name
               the logic name of the type of features to obtain
  Arg [3]    : (optional) boolean $load_transcripts
               if true, transcripts will be loaded immediately rather than
               lazy loaded later.
  Arg [4]    : (optional) string $source
               the source name of the features to obtain.
  Arg [5]    : (optional) string biotype
                the biotype of the features to obtain.
  Example    : @operons = @{$operon_adaptor->fetch_all_by_Slice()};
  Description: Overrides superclass method to optionally load transcripts
               immediately rather than lazy-loading them later.  This
               is more efficient when there are a lot of operons whose
               transcripts are going to be used.
  Returntype : reference to list of operons 
  Exceptions : thrown if exon cannot be placed on transcript slice
  Caller     : Slice::get_all_operons
  Status     : Stable

=cut

sub fetch_all_by_Slice {
	my ( $self, $slice, $logic_name, $load_transcripts ) = @_;

	my $constraint = '';
	my $operons =
	  $self->SUPER::fetch_all_by_Slice_constraint( $slice, $constraint,
												   $logic_name );

	# If there are less than two operons, still do lazy-loading.
	if ( !$load_transcripts || @$operons < 2 ) {
		return $operons;
	}

	# Preload all of the transcripts now, instead of lazy loading later,
	# faster than one query per transcript.

	# First check if transcripts are already preloaded.
	# FIXME: Should check all transcripts.
	if ( exists( $operons->[0]->{'_operon_transcript_array'} ) ) {
		return $operons;
	}

	# Get extent of region spanned by transcripts.
	my ( $min_start, $max_end );
	foreach my $o (@$operons) {
		if ( !defined($min_start) || $o->seq_region_start() < $min_start ) {
			$min_start = $o->seq_region_start();
		}
		if ( !defined($max_end) || $o->seq_region_end() > $max_end ) {
			$max_end = $o->seq_region_end();
		}
	}

	my $ext_slice;

	if ( $min_start >= $slice->start() && $max_end <= $slice->end() ) {
		$ext_slice = $slice;
	} else {
		my $sa = $self->db()->get_SliceAdaptor();
		$ext_slice =
		  $sa->fetch_by_region( $slice->coord_system->name(),
								$slice->seq_region_name(),
								$min_start,
								$max_end,
								$slice->strand(),
								$slice->coord_system->version() );
	}

	# Associate transcript identifiers with operons.

	my %o_hash = map { $_->dbID => $_ } @{$operons};

	my $o_id_str = join( ',', keys(%o_hash) );

	my $sth =
	  $self->prepare(   "SELECT operon_id, operon_transcript_id "
					  . "FROM   operon_transcript "
					  . "WHERE  operon_id IN ($o_id_str)" );

	$sth->execute();

	my ( $o_id, $tr_id );
	$sth->bind_columns( \( $o_id, $tr_id ) );

	my %tr_o_hash;

	while ( $sth->fetch() ) {
		$tr_o_hash{$tr_id} = $o_hash{$o_id};
	}

	my $ta = $self->db()->get_OperonTranscriptAdaptor();
	my $transcripts =
	  $ta->fetch_all_by_Slice( $ext_slice,
							   1, undef,
							   sprintf( "ot.operon_transcript_id IN (%s)",
										join( ',',
											  sort { $a <=> $b }
												keys(%tr_o_hash) ) ) );

	# Move transcripts onto operon slice, and add them to operons.
	foreach my $tr ( @{$transcripts} ) {
		if ( !exists( $tr_o_hash{ $tr->dbID() } ) ) { next }

		my $new_tr;
		if ( $slice != $ext_slice ) {
			$new_tr = $tr->transfer($slice);
			if ( !defined($new_tr) ) {
350 351 352
				throw(   "Unexpected. "
					   . "Transcript could not be transfered onto operon slice."
				);
353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406
			}
		} else {
			$new_tr = $tr;
		}

		$tr_o_hash{ $tr->dbID() }->add_OperonTranscript($new_tr);
	}

	return $operons;
} ## end sub fetch_all_by_Slice

=head2 fetch_by_transcript_id

  Arg [1]    : Int $trans_id
               Unique database identifier for the transcript whose operon should
               be retrieved. The operon is returned in its native coord
               system (i.e. the coord_system it is stored in). If the coord
               system needs to be changed, then tranform or transfer should
               be called on the returned object. undef is returned if the
               operon or transcript is not found in the database.
  Example    : $operon = $operon_adaptor->fetch_by_transcript_id(1241);
  Description: Retrieves a operon from the database via the database identifier
               of one of its transcripts.
  Returntype : Bio::EnsEMBL::Operon
  Exceptions : none
  Caller     : operonral
  Status     : Stable

=cut

sub fetch_by_operon_transcript_id {
	my ( $self, $trans_id ) = @_;

	# this is a cheap SQL call
	my $sth = $self->prepare(
		qq(
      SELECT tr.operon_id
      FROM operon_transcript tr
      WHERE tr.operon_transcript_id = ?
  ) );

	$sth->bind_param( 1, $trans_id, SQL_INTEGER );
	$sth->execute();

	my ($operonid) = $sth->fetchrow_array();

	$sth->finish();

	return undef if ( !defined $operonid );

	my $operon = $self->fetch_by_dbID($operonid);
	return $operon;
}

Monika Komorowska's avatar
Monika Komorowska committed
407
=head2 fetch_by_operon_transcript_stable_id
408 409 410

  Arg [1]    : string $trans_stable_id
               transcript stable ID whose operon should be retrieved
Monika Komorowska's avatar
Monika Komorowska committed
411
  Example    : my $operon = $operon_adaptor->fetch_by_operon_transcript_stable_id
412 413 414 415 416 417 418 419 420 421 422 423 424 425 426
                 ('ENST0000234');
  Description: Retrieves a operon from the database via the stable ID of one of
               its transcripts
  Returntype : Bio::EnsEMBL::Operon
  Exceptions : none
  Caller     : operonral
  Status     : Stable

=cut

sub fetch_by_operon_transcript_stable_id {
	my ( $self, $trans_stable_id ) = @_;

	my $sth = $self->prepare(
		qq(
Monika Komorowska's avatar
Monika Komorowska committed
427 428 429
        SELECT  operon_id
	FROM	operon_transcript
        WHERE   stable_id = ?
430 431 432 433 434 435 436 437 438 439 440 441 442 443 444
    ) );

	$sth->bind_param( 1, $trans_stable_id, SQL_VARCHAR );
	$sth->execute();

	my ($operonid) = $sth->fetchrow_array();
	$sth->finish;

	return undef if ( !defined $operonid );

	my $operon = $self->fetch_by_dbID($operonid);
	return $operon;
}

sub fetch_by_operon_transcript {
445 446 447
	my ( $self, $trans ) = @_;
	assert_ref( $trans, 'Bio::EnsEMBL::OperonTranscript' );
	$self->fetch_by_operon_transcript_id( $trans->dbID() );
448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477
}

=head2 store

  Arg [1]    : Bio::EnsEMBL::Operon $operon
               The operon to store in the database
  Arg [2]    : ignore_release in xrefs [default 1] set to 0 to use release info 
               in external database references
  Example    : $operon_adaptor->store($operon);
  Description: Stores a operon in the database.
  Returntype : the database identifier (dbID) of the newly stored operon
  Exceptions : thrown if the $operon is not a Bio::EnsEMBL::Operon or if 
               $operon does not have an analysis object
  Caller     : general
  Status     : Stable

=cut

sub store {
	my ( $self, $operon, $ignore_release ) = @_;

	if ( !ref $operon || !$operon->isa('Bio::EnsEMBL::Operon') ) {
		throw("Must store a operon object, not a $operon");
	}

	my $db = $self->db();

	if ( $operon->is_stored($db) ) {
		return $operon->dbID();
	}
478 479 480 481 482 483 484 485
		    my $analysis = $operon->analysis();
  throw("Operons must have an analysis object.") if(!defined($analysis));
	my $analysis_id;
	if ( $analysis->is_stored($db) ) {
		$analysis_id = $analysis->dbID();
	} else {
		$analysis_id = $db->get_AnalysisAdaptor->store( $analysis );
	}
486 487 488 489 490 491 492 493 494 495 496 497 498
	# ensure coords are correct before storing
	#$operon->recalculate_coordinates();

	my $seq_region_id;

	( $operon, $seq_region_id ) = $self->_pre_store($operon);

	my $store_operon_sql = qq(
        INSERT INTO operon
           SET seq_region_id = ?,
               seq_region_start = ?,
               seq_region_end = ?,
               seq_region_strand = ?,
499 500
               display_label = ?,
               analysis_id = ?
501
  );
Monika Komorowska's avatar
Monika Komorowska committed
502 503 504 505 506 507 508 509
	
	if ( defined($operon->stable_id()) ) {
	    my $created = $self->db->dbc->from_seconds_to_date($operon->created_date());
	    my $modified = $self->db->dbc->from_seconds_to_date($operon->modified_date());
	    $store_operon_sql .= ", stable_id = ?, version = ?, created_date = " . $created . ",modified_date = " . $modified;
	}

        # column status is used from schema version 34 onwards (before it was
510 511 512
	# confidence)

	my $sth = $self->prepare($store_operon_sql);
513 514 515 516 517 518
	$sth->bind_param( 1, $seq_region_id,           SQL_INTEGER );
	$sth->bind_param( 2, $operon->start(),         SQL_INTEGER );
	$sth->bind_param( 3, $operon->end(),           SQL_INTEGER );
	$sth->bind_param( 4, $operon->strand(),        SQL_TINYINT );
	$sth->bind_param( 5, $operon->display_label(), SQL_VARCHAR );
	$sth->bind_param( 6, $analysis_id,             SQL_INTEGER );
519

Monika Komorowska's avatar
Monika Komorowska committed
520 521 522 523 524 525
	if ( defined($operon->stable_id()) ) {
	    $sth->bind_param( 7, $operon->stable_id(), SQL_VARCHAR );
	    my $version = ($operon->version()) ? $operon->version() : 1;
	    $sth->bind_param( 8, $version, SQL_INTEGER ); 
	}

526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608
	$sth->execute();
	$sth->finish();

	my $operon_dbID = $sth->{'mysql_insertid'};

	my $transcripts = $operon->get_all_OperonTranscripts();

	if ( $transcripts && scalar @$transcripts ) {
		my $transcript_adaptor = $db->get_OperonTranscriptAdaptor();
		for my $transcript (@$transcripts) {
			$transcript_adaptor->store( $transcript, $operon_dbID );
		}
	}

	# store the dbentries associated with this operon
	my $dbEntryAdaptor = $db->get_DBEntryAdaptor();

	foreach my $dbe ( @{ $operon->get_all_DBEntries } ) {
		$dbEntryAdaptor->store( $dbe, $operon_dbID, "Operon", $ignore_release );
	}

	# store operon attributes if there are any
	my $attrs = $operon->get_all_Attributes();
	if ( $attrs && scalar @$attrs ) {
		my $attr_adaptor = $db->get_AttributeAdaptor();
		$attr_adaptor->store_on_Operon( $operon, $attrs );
	}

	# set the adaptor and dbID on the original passed in operon not the
	# transfered copy
	$operon->adaptor($self);
	$operon->dbID($operon_dbID);

	return $operon_dbID;
} ## end sub store

=head2 remove

  Arg [1]    : Bio::EnsEMBL::Operon $operon
               the operon to remove from the database
  Example    : $operon_adaptor->remove($operon);
  Description: Removes a operon completely from the database. All associated
               transcripts, exons, stable_identifiers, descriptions, etc.
               are removed as well. Use with caution!
  Returntype : none
  Exceptions : throw on incorrect arguments 
               warning if operon is not stored in this database
  Caller     : general
  Status     : Stable

=cut

sub remove {
	my $self   = shift;
	my $operon = shift;

	if ( !ref($operon) || !$operon->isa('Bio::EnsEMBL::Operon') ) {
		throw("Bio::EnsEMBL::Operon argument expected.");
	}

	if ( !$operon->is_stored( $self->db() ) ) {
		warning(   "Cannot remove operon "
				 . $operon->dbID()
				 . ". Is not stored in "
				 . "this database." );
		return;
	}

	# remove all object xrefs associated with this operon

	my $dbe_adaptor = $self->db()->get_DBEntryAdaptor();
	foreach my $dbe ( @{ $operon->get_all_DBEntries() } ) {
		$dbe_adaptor->remove_from_object( $dbe, $operon, 'Operon' );
	}

	# remove all of the transcripts associated with this operon
	my $transcriptAdaptor = $self->db->get_OperonTranscriptAdaptor();
	foreach my $trans ( @{ $operon->get_all_OperonTranscripts() } ) {
		$transcriptAdaptor->remove($trans);
	}

	# remove this operon from the database

Monika Komorowska's avatar
Monika Komorowska committed
609
	my $sth = $self->prepare("DELETE FROM operon WHERE operon_id = ? ");
610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643
	$sth->bind_param( 1, $operon->dbID, SQL_INTEGER );
	$sth->execute();
	$sth->finish();

	# unset the operon identifier and adaptor thereby flagging it as unstored

	$operon->dbID(undef);
	$operon->adaptor(undef);

	return;
} ## end sub remove

# _objs_from_sth

#  Arg [1]    : StatementHandle $sth
#  Arg [2]    : Bio::EnsEMBL::AssemblyMapper $mapper
#  Arg [3]    : Bio::EnsEMBL::Slice $dest_slice
#  Description: PROTECTED implementation of abstract superclass method.
#               responsible for the creation of Operons
#  Returntype : listref of Bio::EnsEMBL::Operon in target coordinate system
#  Exceptions : none
#  Caller     : internal
#  Status     : Stable

sub _objs_from_sth {
	my ( $self, $sth, $mapper, $dest_slice ) = @_;

	#
	# This code is ugly because an attempt has been made to remove as many
	# function calls as possible for speed purposes.  Thus many caches and
	# a fair bit of gymnastics is used.
	#

	my $sa = $self->db()->get_SliceAdaptor();
644
	my $aa = $self->db->get_AnalysisAdaptor();
645 646 647 648 649 650

	my @operons;
	my %analysis_hash;
	my %slice_hash;
	my %sr_name_hash;
	my %sr_cs_hash;
651
	my ( $stable_id, $version, $created_date, $modified_date, $analysis_id );
652

653 654
	my ( $operon_id,      $seq_region_id,     $seq_region_start,
		 $seq_region_end, $seq_region_strand, $display_label );
655 656 657 658

	$sth->bind_columns( \$operon_id,         \$seq_region_id,
						\$seq_region_start,  \$seq_region_end,
						\$seq_region_strand, \$display_label,
659 660 661
						\$analysis_id,       \$stable_id,
						\$version,           \$created_date,
						\$modified_date );
662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695

	my $asm_cs;
	my $cmp_cs;
	my $asm_cs_vers;
	my $asm_cs_name;
	my $cmp_cs_vers;
	my $cmp_cs_name;
	if ($mapper) {
		$asm_cs      = $mapper->assembled_CoordSystem();
		$cmp_cs      = $mapper->component_CoordSystem();
		$asm_cs_name = $asm_cs->name();
		$asm_cs_vers = $asm_cs->version();
		$cmp_cs_name = $cmp_cs->name();
		$cmp_cs_vers = $cmp_cs->version();
	}

	my $dest_slice_start;
	my $dest_slice_end;
	my $dest_slice_strand;
	my $dest_slice_length;
	my $dest_slice_sr_name;
	my $dest_slice_seq_region_id;
	if ($dest_slice) {
		$dest_slice_start         = $dest_slice->start();
		$dest_slice_end           = $dest_slice->end();
		$dest_slice_strand        = $dest_slice->strand();
		$dest_slice_length        = $dest_slice->length();
		$dest_slice_sr_name       = $dest_slice->seq_region_name();
		$dest_slice_seq_region_id = $dest_slice->get_seq_region_id();
	}

	my $count = 0;
  OPERON: while ( $sth->fetch() ) {
		$count++;
696 697 698 699
		#get the analysis object
		my $analysis = $analysis_hash{$analysis_id} ||=
		  $aa->fetch_by_dbID($analysis_id);
		$analysis_hash{$analysis_id} = $analysis;
700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719
		#need to get the internal_seq_region, if present
		$seq_region_id = $self->get_seq_region_id_internal($seq_region_id);
		#get the slice object
		my $slice = $slice_hash{ "ID:" . $seq_region_id };

		if ( !$slice ) {
			$slice = $sa->fetch_by_seq_region_id($seq_region_id);
			$slice_hash{ "ID:" . $seq_region_id } = $slice;
			$sr_name_hash{$seq_region_id}         = $slice->seq_region_name();
			$sr_cs_hash{$seq_region_id}           = $slice->coord_system();
		}

		my $sr_name = $sr_name_hash{$seq_region_id};
		my $sr_cs   = $sr_cs_hash{$seq_region_id};
		#
		# remap the feature coordinates to another coord system
		# if a mapper was provided
		#
		if ($mapper) {

720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735

		    if (defined $dest_slice && $mapper->isa('Bio::EnsEMBL::ChainedAssemblyMapper')  ) {
			( $seq_region_id,  $seq_region_start,
			  $seq_region_end, $seq_region_strand )
			    =
			    $mapper->map( $sr_name, $seq_region_start, $seq_region_end,
					  $seq_region_strand, $sr_cs, 1, $dest_slice);

		    } else {

			( $seq_region_id,  $seq_region_start,
			  $seq_region_end, $seq_region_strand )
			    =
			    $mapper->fastmap( $sr_name, $seq_region_start, $seq_region_end,
					      $seq_region_strand, $sr_cs );
		    }
736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781

			#skip features that map to gaps or coord system boundaries
			next OPERON if ( !defined($seq_region_id) );

			#get a slice in the coord system we just mapped to
			if ( $asm_cs == $sr_cs
				 || ( $cmp_cs != $sr_cs && $asm_cs->equals($sr_cs) ) )
			{
				$slice = $slice_hash{ "ID:" . $seq_region_id } ||=
				  $sa->fetch_by_seq_region_id($seq_region_id);
			} else {
				$slice = $slice_hash{ "ID:" . $seq_region_id } ||=
				  $sa->fetch_by_seq_region_id($seq_region_id);
			}
		}

	   #
	   # If a destination slice was provided convert the coords
	   # If the dest_slice starts at 1 and is foward strand, nothing needs doing
	   #
		if ($dest_slice) {
			if ( $dest_slice_start != 1 || $dest_slice_strand != 1 ) {
				if ( $dest_slice_strand == 1 ) {
					$seq_region_start =
					  $seq_region_start - $dest_slice_start + 1;
					$seq_region_end = $seq_region_end - $dest_slice_start + 1;
				} else {
					my $tmp_seq_region_start = $seq_region_start;
					$seq_region_start = $dest_slice_end - $seq_region_end + 1;
					$seq_region_end =
					  $dest_slice_end - $tmp_seq_region_start + 1;
					$seq_region_strand *= -1;
				}
			}

			#throw away features off the end of the requested slice
			if (    $seq_region_end < 1
				 || $seq_region_start > $dest_slice_length
				 || ( $dest_slice_seq_region_id != $seq_region_id ) )
			{
#	print STDERR "IGNORED DUE TO CUTOFF  $dest_slice_seq_region_id ne $seq_region_id . $sr_name\n";
				next OPERON;
			}
			$slice = $dest_slice;
		} ## end if ($dest_slice)

782 783 784 785 786 787 788 789 790 791 792 793 794 795
		push( @operons,
			  Bio::EnsEMBL::Operon->new(
									  -START         => $seq_region_start,
									  -END           => $seq_region_end,
									  -STRAND        => $seq_region_strand,
									  -SLICE         => $slice,
									  -DISPLAY_LABEL => $display_label,
									  -ADAPTOR       => $self,
									  -DBID          => $operon_id,
									  -STABLE_ID     => $stable_id,
									  -VERSION       => $version,
									  -CREATED_DATE  => $created_date || undef,
									  -MODIFIED_DATE => $modified_date || undef,
									  -ANALYSIS      => $analysis ) );
796 797 798 799 800 801 802

	} ## end while ( $sth->fetch() )

	return \@operons;
} ## end sub _objs_from_sth

1;
Monika Komorowska's avatar
Monika Komorowska committed
803