view release on metacpan or  search on metacpan

ABI.pm  view on Meta::CPAN

	$self->{DATA11}                = undef;
	$self->{DATA12}                = undef;
	$self->{PBAS1}                 = undef;
	$self->{PBAS2}                 = undef;
	$self->{FWO}                   = undef;
	$self->{_mac_header}           = 0;
	$self->{_maximum_trace}        = 0;

	if ( $self->_is_abi() ) {

		#print "ABI FILE\n";
		$self->_set_index();
		$self->_set_base_calls();
		$self->_set_corrected_base_calls();
		$self->_set_seq();
		$self->_set_corrected_seq();
		$self->_set_traces();
		$self->_set_max_trace();
		$self->_set_sample_name();
		close( $self->{_fh} );
	}
	return $self;
}

sub set_file_handle {
	my $self = shift;
	my $path = shift;
	my $fh   = IO::File->new();
	if ( $fh->open("< $path") ) {
		binmode($fh);
		$self->{_fh} = $fh;
	} else {
		croak "Could not open $path in ABITrace::set_file_handle\n";
	}
}

sub _rearrange {
	my ( $self, $order, @param ) = @_;
	return unless @param;
	return @param unless ( defined( $param[0] ) && $param[0] =~ /^-/ );
	for ( my $i = 0 ; $i < @param ; $i += 2 ) {
		$param[$i] =~ s/^\-//;
		$param[$i] =~ tr/a-z/A-Z/;
	}

	# Now we'll convert the @params variable into an associative array.
	local ($^W) = 0;    # prevent "odd number of elements" warning with -w.
	my (%param) = @param;
	my (@return_array);

	# What we intend to do is loop through the @{$order} variable,
	# and for each value, we use that as a key into our associative
	# array, pushing the value at that key onto our return array.
	my ($key);
	foreach $key ( @{$order} ) {
		my ($value) = $param{$key};
		delete $param{$key};
		push( @return_array, $value );
	}

#    print "\n_rearrange() after processing:\n";
#    my $i; for ($i=0;$i<@return_array;$i++) { printf "%20s => %s\n", ${$order}[$i], $return_array[$i]; } <STDIN>;
	return (@return_array);
}

sub _is_abi {
	my $self = shift;
	my $fh   = $self->{"_fh"};
	my $buf;
	seek( $fh, 0, 0 );
	read( $fh, $buf, 3 );

	#my $a = unpack("n*", $buf);
	if ( $buf eq "ABI" ) {
		return 1;
	} else {
		seek( $fh, 128, 0 );
		read( $fh, $buf, 3 );
		if ( $buf eq "ABI" ) {
			$self->_set_mac_header();
			return 1;
		} else {
			return 0;
		}
	}
}

sub _set_mac_header {
	my $self = shift;
	$self->{_mac_header} = 128;
}

sub _set_index {
	my $self         = shift;
	my $data_counter = 0;
	my $pbas_counter = 0;
	my $ploc_counter = 0;
	my ( $num_records, $buf );

	#print $self->{_fh}, "\n";
	#print $self->{_mac_header}, "\n";
	seek( $self->{_fh}, $self->{_abs_index} + $self->{_mac_header}, 0 );
	read( $self->{_fh}, $buf, 4 );
	$self->{_index} = unpack( "N", $buf );

	#print $self->{_index};
	seek( $self->{_fh}, $self->{_abs_index} - 8 + $self->{_mac_header}, 0 );
	read( $self->{_fh}, $buf, 4 );
	$num_records = unpack( "N", $buf );
	for ( my $i = 0 ; $i <= $num_records - 1 ; $i++ ) {
		seek( $self->{_fh}, $self->{_index} + ( $i * 28 ), 0 );
		read( $self->{_fh}, $buf, 4 );
		if ( $buf eq "FWO_" ) {
			$self->{FWO} = $self->{_index} + ( $i * 28 ) + 20;
		}
		if ( $buf eq "DATA" ) {
			$data_counter++;
			if ( $data_counter == 9 ) {
				$self->{DATA9} = $self->{_index} + ( $i * 28 ) + 20;
			}
			if ( $data_counter == 10 ) {