Blast Output Parsing

#!/usr/bin/perl
#

use strict;
#use Data::Dumper;

our @ISA    = qw(Exporter);
our @EXPORT = qw(parseXMLBlast);

sub parseXMLBlast {

	local $/;
	my $BlastXMLOutput = shift;
	
	#$BlastXMLOutput = $$BlastXMLOutput;

	my @parsed_result;
	while ($BlastXMLOutput =~ s/<BlastOutput>(.*?)<\/BlastOutput>//s) {

		push @parsed_result, &parse__BlastOutput($1);



	}
	
	return \@parsed_result;

}



sub parse__BlastOutput() {

	my $BlastOutput = shift;
	my $parsed_result = {};

	$BlastOutput =~ /<BlastOutput_program>(.*?)<\/BlastOutput_program>/s or die "BlastOutput_program nicht gefunden!\n\nString: $BlastOutput";
	$parsed_result->{"BlastOutput_program"} = $1;
	
	$BlastOutput =~ /<BlastOutput_version>(.*?)<\/BlastOutput_version>/s or die "BlastOutput_version nicht gefunden!\n\nString: $BlastOutput";;
	$parsed_result->{"BlastOutput_version"} = $1;

	$BlastOutput =~ /<BlastOutput_reference>(.*?)<\/BlastOutput_reference>/s or die "BlastOutput_reference nicht gefunden!\n\nString: $BlastOutput";;
	$parsed_result->{"BlastOutput_reference"} = $1;

	$BlastOutput =~ /<BlastOutput_db>(.*?)<\/BlastOutput_db>/s or die "BlastOutput_db nicht gefunden!\n\nString: $BlastOutput";;
	$parsed_result->{"BlastOutput_db"} = $1;

	$BlastOutput =~ /<BlastOutput_query-ID>(.*?)<\/BlastOutput_query-ID>/s or die "BlastOutput_query nicht gefunden!\n\nString: $BlastOutput";;
	$parsed_result->{"BlastOutput_query-ID"} = $1;

	$BlastOutput =~ /<BlastOutput_query-def>(.*?)<\/BlastOutput_query-def>/s or die "BlastOutput_query-def nicht gefunden!\n\nString: $BlastOutput";
	$parsed_result->{"BlastOutput_query-def"} = $1;

	$BlastOutput =~ /<BlastOutput_query-len>(.*?)<\/BlastOutput_query-len>/s or die "BlastOutput_query-len nicht gefunden!\n\nString: $BlastOutput";
	$parsed_result->{"BlastOutput_query-len"} = $1;

	$BlastOutput =~ /<BlastOutput_param>(.*?)<\/BlastOutput_param>/s or die "BlastOutput_param nicht gefunden!\n\nString: $BlastOutput";;
	$parsed_result->{"BlastOutput_param"} = &parse__BlastOutput_param($1);
	
	$BlastOutput =~ /<BlastOutput_iterations>(.*?)<\/BlastOutput_iterations>/s or die "BlastOutput_iterations nicht gefunden!\n\nString: $BlastOutput";
	$parsed_result->{"BlastOutput_iterations"} = &parse__BlastOutput_iterations($1);	
	
	return $parsed_result;

}

sub parse__BlastOutput_param() {

	my $	BlastOutput_param = shift;
	return "Not implemented yet!";

}

sub parse__BlastOutput_iterations() {

	my $BlastOutput_iterations = shift;
	my $parsed_result = {};
		
	$BlastOutput_iterations =~ /<Iteration>(.*?)<\/Iteration>/s or die "Iteration nicht gefunden!\n\nString: $BlastOutput_iterations";
	$parsed_result->{Iteration} = &parse__Iteration($1);
	
	return $parsed_result;
}

sub parse__Iteration() {

	my $Iteration = shift;
	my $parsed_result = {};
	
	$Iteration =~ /<Iteration_iter-num>(.*?)<\/Iteration_iter-num>/s or die "Iteration_iter-num nicht gefunden!\n\nString: $Iteration";
	$parsed_result->{"Iteration_iter-num"} = $1;
	
	my $sequence_has_hits = $Iteration =~ /<Iteration_hits>(.*?)<\/Iteration_hits>/s;
	if ($sequence_has_hits) { 
	
		$parsed_result->{Iteration_hits} = &parse__Iteration_hits($1); 
		
	} else {
	
		$Iteration =~ /<Iteration_message>(.*?)<\/Iteration_message>/s;
		$parsed_result->{Iteration_message} = $1;
		
	}
	
	return $parsed_result;

}

sub parse__Iteration_hits() {

	my $Iteration_hits = shift;
	my $parsed_result = {};
	
	#$Iteration_hits =~ /<Hit>(.*?)<\/Hit>/s or die "Hit nicht gefunden!\n\nString: $Iteration_hits";
	#$parsed_result->{Hit} = &parse__Hit($1);
	
	my @Iteration_hits;
	while ($Iteration_hits =~ s/<Hit>(.*?)<\/Hit>//s) {
		push @Iteration_hits, &parse__Hit($1);
	}
	$parsed_result->{Hit} = \@Iteration_hits;

	
	return $parsed_result;
}

sub parse__Hit() {

	my $Hit = shift;
	my $parsed_result = {};
	
	$Hit =~ /<Hit_num>(.*?)<\/Hit_num>/s or die "Hit_num nicht gefunden!\n\nString: $Hit";
	$parsed_result->{"Hit_num"} = $1;	
	
	$Hit =~ /<Hit_id>(.*?)<\/Hit_id>/s or die "Hit_id nicht gefunden!\n\nString: $Hit";;
	$parsed_result->{"Hit_id"} = $1;		
	
	$Hit =~ /<Hit_def>(.*?)<\/Hit_def>/s or die "Hit_def nicht gefunden!\n\nString: $Hit";;
	$parsed_result->{"Hit_def"} = $1;	
	
	$Hit =~ /<Hit_accession>(.*?)<\/Hit_accession>/s or die "Hit_accession nicht gefunden!\n\nString: $Hit";;
	$parsed_result->{"Hit_accession"} = $1;	
	
	$Hit =~ /<Hit_len>(.*?)<\/Hit_len>/s or die "Hit_len nicht gefunden!\n\nString: $Hit";;
	$parsed_result->{"Hit_len"} = $1;	
	
	$Hit =~ /<Hit_hsps>(.*?)<\/Hit_hsps>/s or die "Hit_hsps nicht gefunden!\n\nString: $Hit";;
	$parsed_result->{"Hit_hsps"} = &parse__Hit_hsps($1);
	
	return $parsed_result;
}


sub parse__Hit_hsps {

	my $Hit_hsps = shift;
	my $parsed_result = {};

#	$Hit_hsps =~ /<Hsp>(.*?)<\/Hsp>/s;
#	$parsed_result->{"Hsp"} = &parse__Hsp($1);

	my @Hsp_list;
	while ($Hit_hsps =~ s/<Hsp>(.*?)<\/Hsp>//s) {
		push @Hsp_list, &parse__Hsp($1);
	}
	$parsed_result->{"Hsp"} = \@Hsp_list;

	return $parsed_result;
}


sub parse__Hsp {

	my $Hsp = shift;
	my $parsed_result = {};

	$Hsp =~ /<Hsp_num>(.*?)<\/Hsp_num>/s;
	$parsed_result->{"Hsp_num"} = $1;
	
	$Hsp =~ /<Hsp_bit-score>(.*?)<\/Hsp_bit-score>/s;	
	$parsed_result->{"Hsp_bit-score"} = $1;
	
	$Hsp =~ /<Hsp_score>(.*?)<\/Hsp_score>/s;		
	$parsed_result->{"Hsp_score"} = $1;
	
	$Hsp =~ /<Hsp_evalue>(.*?)<\/Hsp_evalue>/s;		
	$parsed_result->{"Hsp_evalue"} = $1;
	
	$Hsp =~ /<Hsp_query-from>(.*?)<\/Hsp_query-from>/s;	
	$parsed_result->{"Hsp_query-from"} = $1;
	
	$Hsp =~ /<Hsp_query-to>(.*?)<\/Hsp_query-to>/s;	
	$parsed_result->{"Hsp_query-to"} = $1;
	
	$Hsp =~ /<Hsp_hit-from>(.*?)<\/Hsp_hit-from>/s;	
	$parsed_result->{"Hsp_hit-from"} = $1;
	
	$Hsp =~ /<Hsp_hit-to>(.*?)<\/Hsp_hit-to>/s;		
	$parsed_result->{"Hsp_hit-to"} = $1;
	
	$Hsp =~ /<Hsp_query-frame>(.*?)<\/Hsp_query-frame>/s;
	$parsed_result->{"Hsp_query-frame"} = $1;
	
	$Hsp =~ /<Hsp_hit-frame>(.*?)<\/Hsp_hit-frame>/s;	
	$parsed_result->{"Hsp_hit-frame"} = $1;
	
	$Hsp =~ /<Hsp_identity>(.*?)<\/Hsp_identity>/s;	
	$parsed_result->{"Hsp_identity"} = $1;
	
	$Hsp =~ /<Hsp_positive>(.*?)<\/Hsp_positive>/s;	
	$parsed_result->{"Hsp_positive"} = $1;
	
	$Hsp =~ /<Hsp_align-len>(.*?)<\/Hsp_align-len>/s;	
	$parsed_result->{"Hsp_align-len"} = $1;
	
	$Hsp =~ /<Hsp_qseq>(.*?)<\/Hsp_qseq>/s;		
	$parsed_result->{"Hsp_qseq"} = $1;
	
	$Hsp =~ /<Hsp_hseq>(.*?)<\/Hsp_hseq>/s;		
	$parsed_result->{"Hsp_hseq"} = $1;
	
	$Hsp =~ /<Hsp_midline>(.*?)<\/Hsp_midline>/s;	
	$parsed_result->{"Hsp_midline"} = $1;

	return $parsed_result;
}