view release on metacpan or  search on metacpan

lib/Bio/ToolBox/db_helper/alignment_callbacks.pm  view on Meta::CPAN

#### Callback subroutines
# the following are all of the callback subroutines

# we explicitly check that alignment start and/or stop overlap the search coordinates
# to avoid e.g. weird alignments with massive splice junctions that would nevertheless
# be pulled out by the bam index search

sub _all_count_indexed {
	my ( $a, $data ) = @_;
	my $flag = $a->flag;
	return if $flag & $UNWANTED_FLAGS;
	return if $a->qual < $MAPQ;
	my $s = $a->pos + 1;
	my $e = $a->calend;
	return
		unless ( ( $s >= $data->{start} and $s <= $data->{stop} )
			or ( $e >= $data->{start} and $e <= $data->{stop} ) );

	if ( $flag & 0x10 ) {

		# reversed
		$data->{'index'}{$e}++;
	}
	else {
		$data->{'index'}{$s}++;
	}
}

sub _all_precise_count_indexed {
	my ( $a, $data ) = @_;
	my $flag = $a->flag;
	return if $flag & $UNWANTED_FLAGS;
	return if $a->qual < $MAPQ;
	my $s = $a->pos + 1;
	return unless ( $s >= $data->{start} and $a->calend <= $data->{stop} );
	if ( $flag & 0x10 ) {

		# reversed
		$data->{'index'}{$s}++;
	}
	else {
		$data->{'index'}{ $a->calend }++;
	}
}

sub _all_name_indexed {
	my ( $a, $data ) = @_;
	my $flag = $a->flag;
	return if $flag & $UNWANTED_FLAGS;
	return if $a->qual < $MAPQ;
	my $s = $a->pos + 1;
	my $e = $a->calend;
	return
		unless ( ( $s >= $data->{start} and $s <= $data->{stop} )
			or ( $e >= $data->{start} and $e <= $data->{stop} ) );

	if ( $flag & 0x10 ) {

		# reversed
		# since we're working with names, only record the 5' end of fragment
		return if ( ( $flag & 0x1 ) and ( $flag & 0x2 ) );

		# paired and proper
		# not the end we're looking for
		$data->{'index'}{$e} ||= [];
		push @{ $data->{'index'}{$e} }, $a->qname;
	}
	else {
		$data->{'index'}{$s} ||= [];
		push @{ $data->{'index'}{$s} }, $a->qname;
	}
}

sub _all_count_array {
	my ( $a, $data ) = @_;
	my $flag = $a->flag;
	return if $flag & $UNWANTED_FLAGS;
	return if $a->qual < $MAPQ;
	my $s = $a->pos + 1;
	my $e = $a->calend;
	return
		unless ( ( $s >= $data->{start} and $s <= $data->{stop} )
			or ( $e >= $data->{start} and $e <= $data->{stop} ) );
	push @{ $data->{scores} }, 1;
}

sub _all_precise_count_array {
	my ( $a, $data ) = @_;
	my $flag = $a->flag;
	return if $flag & $UNWANTED_FLAGS;
	return if $a->qual < $MAPQ;
	return unless ( $a->pos + 1 >= $data->{start} and $a->calend <= $data->{stop} );
	push @{ $data->{scores} }, 1;
}

sub _all_name_array {
	my ( $a, $data ) = @_;
	my $flag = $a->flag;
	return if $flag & $UNWANTED_FLAGS;
	return if $a->qual < $MAPQ;
	my $s = $a->pos + 1;
	my $e = $a->calend;
	return
		unless ( ( $s >= $data->{start} and $s <= $data->{stop} )
			or ( $e >= $data->{start} and $e <= $data->{stop} ) );
	push @{ $data->{scores} }, $a->qname;
}

sub _forward_count_indexed {
	my ( $a, $data ) = @_;
	my $flag = $a->flag;
	return if $flag & $UNWANTED_FLAGS;
	return if $a->qual < $MAPQ;
	my $reversed = $flag & 0x10;    # reversed
	if ( $flag & 0x1 ) {

		# paired
		my $first = $flag & 0x40;    # true if FIRST_MATE
		return if ( $first     and $reversed );
		return if ( not $first and not $reversed );