File Coverage

blib/lib/Geo/StormTracker/Main.pm

Criterion	Covered	Total	%
statement	15	500	3.0
branch	0	156	0.0
condition	0	63	0.0
subroutine	5	29	17.2
pod	7	8	87.5
total	27	756	3.5

package Geo::StormTracker::Main;

use Carp;
use File::Path;
use Geo::StormTracker::Data;
use strict;
use vars qw($VERSION);

$VERSION = '0.02';

#---------------------------------------------------------
sub new {
	my $self=shift;
	my $base_path=shift;

	my ($msg)=undef;
	my $HR={};

	#Check to see if the base path was given
        unless (( defined($base_path) ) and (-e $base_path)){
                $msg = "The new method's mandatory base path argument was not provided or didn't exist!";
                carp $msg,"\n";
                return (undef,$msg);
        }#unless

	#Insure that the base path has a trailing slash.
	$base_path =~ s!/*$!/!;

	$HR->{'base_path'}=$base_path;

	bless $HR,'Geo::StormTracker::Main';
	return ($HR,undef);
}#new
#---------------------------------------------------------
sub add_advisory {
	my $self=shift;
	my $adv_obj=shift;
	my $force=shift;
	my $counter=shift;

	my ($header_frag,$region_code,$last_digits,$good)=undef;
	my ($data_obj_found,$recent_storms_AR,$recent_frags_AR, $event_num, $region)=undef;
	my ($paths_HR,$success,$error,$year,$msg,$new_path,$root_paths,$new_data_obj)=undef;

	($header_frag,$region_code,$last_digits)=$self->_disect_header($adv_obj);

	($good,$error)=$self->_check_region_syntax($region_code);

	unless ($good){
		return (undef, undef, undef, undef, $error);
	}

	($paths_HR,$error)=$self->_all_paths_by_region($region_code);

	#Directory does not exist so create one.
	if ( (!defined $paths_HR) and ( !$self->_region_dir_exists($region_code) ) ){
		($good,$error)=$self->_create_region_dir($region_code);
		unless ((defined $good) and ($good)){
                        return (undef, undef, undef, undef, $error);
                }#unless
	}#if


	if (defined $paths_HR){

		($recent_storms_AR,$recent_frags_AR)=$self->_recent_storms($paths_HR->{$region_code});

		$data_obj_found=$self->_associate_advisory_with_storm($adv_obj,$recent_storms_AR,$recent_frags_AR);

	}#if

	if ((defined $paths_HR) and (defined $data_obj_found)){
		($success,$error)=$data_obj_found->insert_advisory($adv_obj,$force);
		if ($success){
			($region, $year, $event_num)=$self->_region_year_and_event_number($data_obj_found);
			return ($data_obj_found, $region, $year, $event_num ,$error);
		}
		else {
                        return (undef, undef, undef, undef, $error);
		}#if/else
	}
	else {
		$year=$self->_find_release_year($adv_obj);
		unless (defined($year)) {
			$msg="Advisory has a bad year in its release ";
			$msg.="date and cound not be added to database!";
			carp $msg,"\n";
			return (undef, undef, undef, undef, $msg);
		}#unless

		#Come up with a new path.
		($new_path, $event_num)=$self->_compose_new_path($year,$paths_HR,$region_code);

		$root_paths=$self->_root_paths($new_path);

		unless ($root_paths){
			$msg="Couldn't create root directories to $new_path!";
			carp $msg,"\n";
			return (undef, undef, undef, undef, $msg);
		}#unless

		#Shiny_new method only succeeds if the path doesn't already exist.
		($new_data_obj,$error)=Geo::StormTracker::Data->shiny_new($new_path, $region_code, $year, $event_num);

		#Make sure the new_data_obj is good.
		#If it is not then sleep for 2 seconds and rerun recall this subroutine.
		unless (defined $new_data_obj){
			$counter=$self->_increment_counter($counter);
			if ($counter >3){
				$msg="Failed at adding advisory!";
				carp $msg,"\n";
				return (undef, undef, undef, undef, $msg);
			}
			else {
				sleep 2;
				$self->add_advisory($adv_obj,$force,$counter);
			}
		}#unless

		#If this is the last advisory to be issured then make the storm inactive.
		#Use the secret 3rd argument to insert_advisory to make this happen.
		if ($adv_obj->is_final){
			($success,$error)=$new_data_obj->insert_advisory($adv_obj,$force,1);
		}
		else {
			($success,$error)=$new_data_obj->insert_advisory($adv_obj,$force);
		}

		if ($success){
			($region, $year, $event_num)=$self->_region_year_and_event_number($new_data_obj);
			return ($new_data_obj, $region, $year, $event_num, $error);
		}
		else {
			return (undef, undef, undef, $error);
		}#if/else
	}#if/else

}#add_advisory
#---------------------------------------------------------
sub _region_year_and_event_number {
	my $self=shift;
	my $data_obj=shift;

	my ($region, $year, $event_num, $path)=undef;

	$path=$data_obj->get_path();

	$path =~ m!/(\w+)/(\d{4})/(\d+)/?$!;

	$region=$1;
	$year=$2;
	$event_num=$3;

	if ((defined $region) and (defined $year) and (defined $event_num)){
		return ($region, $year, $event_num);
	}
	else {
		return (undef, undef, undef);
	}#else

}#_year_and_event_number
#---------------------------------------------------------
#$region_exists=$self->_region_dir_exists($region_code)
sub _region_dir_exists {
	my $self=shift;
	my $region_code=shift;

	my $region_path=$self->{'base_path'}."$region_code/";

	if ((-e $region_path) and (-d $region_path)){
		return 1;
	}
	else {
		return 0;
	}#if/else

}#_region_dir_exists
#---------------------------------------------------------
#($good,$error)=$self->_create_region_dir($region_code);
sub _create_region_dir {
	my $self=shift;
	my $region_code=shift;

	my ($region_path, $success, $msg)=undef;

	$region_path=$self->{'base_path'}."$region_code/";

	if ((-e $region_path) and (-d $region_path)){
		$msg="The directory $region_path already exists and will not be created by _create_region_dir!";
		carp $msg,"\n";
		return (undef,$msg);
	}#if

	$success=mkdir($region_path,0777);

	if ((defined $success) and ($success)){
		return (1,undef);
	}
	else {
		$msg="The directory $region_path could not be created by _create_region_dir!";
		carp $msg,"\n";
		return (undef,$msg);
	}
}#_create_region_dir
#---------------------------------------------------------
sub _check_region_syntax {
	my $self=shift;
	my $region_code=shift;

	my $msg=undef;

	unless ($region_code =~ m!^\w{2}$!) {
		$msg="Region code is syntatically incorrect!";
		carp $msg,"\n";
		return (undef, $msg);
	}#unless

	return (1, undef);
}#_check_region_syntax
#---------------------------------------------------------
sub _root_paths {
	my $self=shift;
	my $path=shift;

	my ($short_path)=undef;

	#Make sure path has trailing slash.
	$path=~s!/*$!/!;

	$short_path=$path;
	$short_path=~s!/[^/]*/$!/!;
	mkpath([$short_path], 0, 0777);

	if ((-e $short_path) and (-d $short_path)){
		return 1;
	}
	else {
		return undef;
	}#if/else

}#_root_paths
#---------------------------------------------------------
sub _increment_counter {
	my $self=shift;
	my $counter=shift;
	if (defined $counter){
		$counter++;
	}
	else {
		$counter=1;
	}
	return $counter;
}#_increment_counter
#---------------------------------------------------------
sub _compose_new_path {
	my $self=shift;
	my $year=shift;
	my $paths_HR=shift;
	my $region_code=shift;

	my ($last_used_path, $early_path, $last_used_year)=undef;
	my ($last_used_event, $next_event, $next_path, $matches)=undef;
	my @reversed_paths=();

	if (
		(defined $paths_HR) and
		(defined $paths_HR->{$region_code}) and
		(scalar(@{$paths_HR->{$region_code}}) > 0)
		) {

		@reversed_paths=(reverse @{$paths_HR->{$region_code}});
		$last_used_path=$reversed_paths[$#reversed_paths];

		$last_used_path=~ s!/*$!/!;
		$matches=($last_used_path=~ m!/(\d{4})/(\d+)/$! );

		return (undef, undef) unless ((defined $matches) and ($matches));

		$last_used_year=$1;
		$last_used_event=$2;

		if ($last_used_year == $year){
			$next_event=$last_used_event+1;
		}
		else {
			$next_event=1;
		}
	}
	else {
		$next_event=1;
	}#if/else

	$next_path=$self->{'base_path'}."$region_code/$year/$next_event/";

	return ($next_path, $next_event);
}#_compose_new_path
#---------------------------------------------------------
sub _find_release_year {
	my $self=shift;
	my $adv_obj=shift;

	my ($release_time,$matches)=undef;

	$release_time=$adv_obj->release_time();
	$release_time =~ s!\s*$!!;

	$matches=( $release_time =~ m!\s(\d{4})$! );

	if ((defined $matches) and ($matches)){
		return $1;
	}
	else {
		return undef;
	}#if/else

}#_find_release_year
#---------------------------------------------------------
#Path array must be in the same order as that returned by _all_paths_by_region method.
sub _recent_storms {
	my $self=shift;
	my $paths_AR=shift;

	my ($path,$data_obj,$adv_obj,$header_frag,$region_code,$last_digits)=undef;
	my ($grep_count, $error)=undef;
	my @recent_storms=();
	my @recent_header_frags=();

	unless (defined @{$paths_AR}){
		return (undef,undef);
	}#unless

	foreach $path (reverse @{$paths_AR}){
		($data_obj,$error)=Geo::StormTracker::Data->new($path);
		next unless (defined $data_obj);

		$adv_obj=$data_obj->current_advisory();
		next unless (defined $adv_obj);

		($header_frag,$region_code,$last_digits)=$self->_disect_header($adv_obj);
		$grep_count=grep {$_ eq $header_frag} @recent_header_frags;

		if (!$grep_count){
			push (@recent_header_frags,$header_frag);
			push (@recent_storms,$data_obj);
		}
		else {
			return (\@recent_storms, \@recent_header_frags);
		}#if/else
	}#foreach
	return (\@recent_storms, \@recent_header_frags);
}#_recent_storms
#---------------------------------------------------------
sub _associate_advisory_with_storm {
	my $self=shift;
	my $target_adv_obj=shift;
	my $recent_storms_AR=shift;
	my $recent_frags_AR=shift;

	#$too_old and $way_too_old should be in seconds.
	#These are delta times.
	my $too_old=60*60*24*60;#60 days old
	my $way_too_old=60*60*24*90;#90 days old

	my ($max_i, $i, $target_header_frag, $target_region_code, $target_last_digits)=undef;
	my ($matched_storm_obj, $matched_current_adv_obj, $old_epoch_time, $new_epoch_time)=undef;
	my ($time_delta)=undef;

	( $target_header_frag, $target_region_code, $target_last_digits)=$self->_disect_header($target_adv_obj);

	$max_i = scalar(@{$recent_storms_AR});
	for ($i=0; $i < $max_i; $i++){
		if (@{$recent_frags_AR}[$i] eq $target_header_frag){
			$matched_storm_obj=@{$recent_storms_AR}[$i];
			#return @{$recent_storms_AR}[$i];
		}#if
	}#for

	#If a matching storm was found, make sure it is not an old one.
	#If it is an old one then return undef;
	#Otherwise return the matching storm object.
	if ($matched_storm_obj){

		$matched_current_adv_obj=$matched_storm_obj->current_advisory();

		#$old_epoch_time=$self->_extract_epoch_date($matched_current_adv_obj);
		$old_epoch_time=$matched_current_adv_obj->epoch_date();

		#$new_epoch_time=$self->_extract_epoch_date($target_adv_obj);
		$new_epoch_time=$target_adv_obj->epoch_date();

		if (($old_epoch_time) and ($new_epoch_time)) {

			$time_delta=$new_epoch_time-$old_epoch_time;

			if ($time_delta >= $way_too_old){
				return undef;
			}
			elsif (($time_delta >= $too_old) and ($target_adv_obj->advisory_number == 1)) {
				return undef;
			}
			else {
				return $matched_storm_obj;
			}#if/elsif/else
		}
		else {
			if (
				($target_adv_obj->advisory_number == 1) and
				($matched_current_adv_obj->advisory_number != 1)
				){
				return undef;
			}
			else {
				return $matched_storm_obj;
			}#if/else

		}#if/else
	}
	#If a matching storm wasn't found then return undef.
	else {
		return undef;
	}#if/else

}#_associate_advisory_with_storm
#---------------------------------------------------------
sub _disect_header {
	my $self=shift;
	my $arg=shift;

	my ($wmo_header,$matches,$region_code,$last_digits,$header_frag,$msg)=undef;

	if (ref $arg){
		$wmo_header=$arg->wmo_header();
	}
	else {
		$wmo_header=$arg;
	}

	$matches=($wmo_header =~ m!^(WT(\w{2})(\d{2}))\s!);

	unless ($matches){
		$msg="Bad wmo header in advisory!";
		$msg="  Bad advisory has wmo header of $wmo_header!";
		croak $msg,"\n";
	}
	$region_code=$2;
	$last_digits=$3;
	$header_frag=$1;

	return ($header_frag,$region_code,$last_digits);

}#_disect_header
#---------------------------------------------------------
sub specific_storm {
        my $self=shift;
        my $region_code=shift;
        my $year=shift;
        my $event_number=shift;

        my ($good, $msg, $data_obj, $path)=undef;

        ($good,$msg)=$self->_check_region_syntax($region_code);

        unless ($good){
                return (undef,$msg);
        }

        $path=$self->{'base_path'}."$region_code/$year/$event_number/";

	#new method will fail unless storm already exists.
	($data_obj,$msg)=Geo::StormTracker::Data->new($path);

	return ($data_obj,$msg);

}#specific_storm
#---------------------------------------------------------
#Region is extracted from the abreviated WMO header
#last counter argument is a secret.
sub add_advisory_by_year_and_event {
	my $self=shift;
	my $adv_obj=shift;
	my $year=shift;
	my $event_number=shift;
	my $force=shift;
	my $counter=shift;

	my ($success, $data_obj, $header_frag, $region_code)=undef;
	my ($last_digits, $good, $msg, $error, $path, $root_paths)=undef;

	($header_frag,$region_code,$last_digits)=$self->_disect_header($adv_obj);

	($good,$msg)=$self->_check_region_syntax($region_code);

	unless ($good){
		return (undef,$msg);
	}

	#Make Region directory if necessary
	unless ($self->_region_dir_exists($region_code)){
	        ($good,$error)=$self->_create_region_dir($region_code);
	        return (undef,$error) unless ($good);
	}#unless

	$path=$self->{'base_path'}."$region_code/$year/$event_number/";

	#If the path exists then this should be a pre-existing storm, so use new method.
	if ((-e $path) and (-d $path)){
		($data_obj,$msg)=Geo::StormTracker::Data->new($path);
	}
	#If the path does not exist then this should be a brand new storm, so use shiny_new method.
	else {
		#Make sure all the base paths exist.
		$root_paths=$self->_root_paths($path);
		unless ($root_paths){
                        $msg="Couldn't create root directories to $path!";
                        carp $msg,"\n";
                        return (undef,$msg);
                }#unless
		#Call the shiny_new method.
		($data_obj,$msg)=Geo::StormTracker::Data->shiny_new($path, $region_code, $year, $event_number);
	}#if/else

	#If something went wrong then try several times before failing.
	#This will take account of two processes competing against each other.
	unless (defined $data_obj){
		$counter=$self->_increment_counter($counter);
		if ($counter >3){
			$msg .= "Failed at adding advisory!";
			carp $msg,"\n";
			return (undef,$msg);
		}
		else {
			sleep 2;
			$self->add_advisory_by_year_and_event($adv_obj,$year,$event_number,$force,$counter);
		}#if/else
	}#unless

	#If this is the last advisory to be issured then make the storm inactive.
	#Don't go the other way though, and make it active if it isn't the last advisory.
	#Use the secret 3rd argument to insert_advisory to make this happen.
	if ($adv_obj->is_final){
		($success,$error)=$data_obj->insert_advisory($adv_obj,$force,1);
	}
	else {
		($success,$error)=$data_obj->insert_advisory($adv_obj,$force);
	}#if/else

	return ($success,$error);

}#add_advisory_by_year_and_event
#---------------------------------------------------------
sub _croak_on_bad_region_syntax {
	my $self=shift;
	my $region=shift;

	my $msg=undef;

	unless ((defined $region) and ($region =~ m!^\w{2}$!)) {
		$msg="Target region code $region ";
		$msg .= "is not a two alphanumeric character string!";
		croak $msg,"\n";
	}

	return 1;

}#_croak_on_bad_region_syntax
#---------------------------------------------------------
#Searches base path to find every storm path.
#Paths are sorted lexically by region identifier and
#then subsorted numerically by year and advisory number.
#The oldest paths will first.
#Every directory returned will have a trailing slash.
#In the event that a target region has been specified then only thatd
#region's directory will be searched.
sub _all_paths_by_region {
	my $self=shift;
	my $target_region_code=shift;

	my ($base_path, $possible_region_dir, $region, $region_dir, $year_dir, $event_dir)=undef;
	my ($target_exists, $msg, $good, $error, $path_to_match)=undef;
	my @dir_list=();
	my @region_dirs=();
	my @event_dir_list=();
	my @final_dir_list=();
	my $paths_by_region_HR={};

	#Place base path in an easy to use variable.
	#New method already insured that the base path has a trailing slash.
	$base_path=$self->{'base_path'};

	#Search top level base path dir for various regions.
	@dir_list=$self->_dir_listing($base_path);
	foreach $possible_region_dir (@dir_list){
		next unless $possible_region_dir =~ m!/\w{2}$!;
		push (@region_dirs,$possible_region_dir);
	}#foreach

	#Sort region directories lexically.
	@region_dirs=sort _sort_dirs_lexically @region_dirs;

	#Check to see if a target region code was defined.
	#If so then only check for that region's paths.
	#Do this by modifying @region_dirs to only include the target region.
	if (defined $target_region_code){

		#Check target_region syntax.
		#_croak_on_bad_region_syntax will croak if the region fails the test.
		#$self->_croak_on_bad_region_syntax($target_region_code);
		($good,$error)=$self->_check_region_syntax($target_region_code);

		unless ($good){
			return (undef,$error);
		}

		#Look for the target_region_code in the region directories found.
		$path_to_match=$self->{'base_path'}.$target_region_code;
		$target_exists=grep {$_ eq $path_to_match} @region_dirs;

		if ($target_exists){
			#@region_dirs=($target_region_code);
			@region_dirs=($path_to_match);
		}
		else {
			$msg = "Directory for region $target_region_code was not found!";
			carp $msg,"\n";
			return (undef,$msg);
		}#if/else

	}#if

	#Find every year and event in every region and make one nice big array
	#with all paths found.
	foreach $region_dir (@region_dirs) {

		#Make sure final dir list is clean.
		@final_dir_list=();

		#Find every year directory for this region.
		@dir_list=$self->_dir_listing($region_dir);

		#Only keep directories that look like a 4 digit year.
		@dir_list=grep {m!/\d{4}$!} @dir_list; #notice nice y2k compliance

		#Sort year directories numerically
		@dir_list = sort _sort_dirs_numerically @dir_list;

		foreach $year_dir (@dir_list){
			#Find every weather event directory for this year.
			@event_dir_list=$self->_dir_listing($year_dir);

			#Only keep directories that look like a number;
			@event_dir_list=grep {m!/\d+$!} @event_dir_list;

			#Sort events numerically.
			@event_dir_list=sort _sort_dirs_numerically @event_dir_list;

			#Push the event directories onto the final directory list.
			push (@final_dir_list,@event_dir_list);
		}#foreach

		#Add trailing slash to every directory in the final directory list.
		#@final_dir_list = map {s!/*$!/!} @final_dir_list;
		map {s!/*$!/!} @final_dir_list;

		#Put information into path by region hash ref.
		$region_dir =~ m!/(\w{2})$!;
		$region=$1;
		$paths_by_region_HR->{$region}=[@final_dir_list];
	}#foreach

	return ($paths_by_region_HR, undef);

}#_all_paths_by_region
#---------------------------------------------------------
sub _sort_dirs_numerically {
	$a =~ m!/(\d+)$!;
	my $a_num = $1;
	$b =~ m!/(\d+)$!;
	my $b_num = $1;
	return $a_num <=> $b_num;
}#_sort_dirs_numerically
#---------------------------------------------------------
sub _sort_dirs_lexically {
	$a =~ m!/([^/]+)$!;
	my $a_var = $1;
	$b =~ m!/([^/]+)$!;
	my $b_var = $1;
	return $a_var cmp $b_var;
}#_sort_dirs_lexically
#---------------------------------------------------------
#No trailing slash on directory pathnames returned.
sub _dir_listing {
	my $self=shift;
	my $dir_name=shift;

	my ($d, $msg)=undef;
	my @dir_list=();
	my @dir_clean_list=();

	#Make sure $dir_name has a trailing slash.
	$dir_name =~ s!/*$!/!;

	#Go find out what files are in the dir_name directory.
	$d=IO::Dir->new();
	        $d->open($dir_name);
        unless (defined($d)){
                $msg = "Had trouble reading $dir_name directory!";
                carp $msg,"\n";
                return undef;
        }
        @dir_list=$d->read();
        $d->close();

	#Get rid of . and .. as directory names.
	@dir_clean_list=grep !/^(\.|\.\.)$/, @dir_list;

	#Make dir_clean_list array have full pathnames.
	map {$_=$dir_name.$_} @dir_clean_list;

	#Weed out any files which are not directories.
	@dir_list=();
	@dir_list=grep {-d $_} @dir_clean_list;

	return @dir_list;
}#_dir_listing
#---------------------------------------------------------
sub all_storms_by_region {
	my $self=shift;
	my $target_region_code=shift;

	my ($data_obj,$path,$all_paths_by_region_HR)=undef;
	my ($region,$data_objects_by_region_HR)=undef;
	my ($good,$error)=undef;
	my @all_paths=();
	my @all_data_objects=();

	if (defined $target_region_code){

		($good,$error)=$self->_check_region_syntax($target_region_code);
		unless ($good){
			return (undef,$error);
		}#unless
	}#if

	($all_paths_by_region_HR,$error)=$self->_all_paths_by_region($target_region_code);
	unless (defined $all_paths_by_region_HR){
		return (undef,$error);
	}#unless

	foreach $region (keys %{$all_paths_by_region_HR}) {

		#Make sure @all_data_objects is empty.
		@all_data_objects=();

		foreach $path (@{$all_paths_by_region_HR->{$region}}){
			($data_obj,$error)=Geo::StormTracker::Data->new($path);
			if (defined $data_obj){
				push (@all_data_objects,$data_obj);
			}
			else {
				carp $error,"\n";
			}#if/else
		}#foreach

		$data_objects_by_region_HR->{$region}=[@all_data_objects];

	}#foreach

	return ($data_objects_by_region_HR,undef);

}#all_storms_by_region
#---------------------------------------------------------
sub all_storms_by_region_and_year {
	my $self=shift;
	my $target_region_code=shift;
	my $target_year=shift;

	my ($data_obj,$path,$all_paths_by_region_HR)=undef;
	my ($region,$data_objects_by_region_HR)=undef;
	my ($good,$error, $match, $msg, $year, $event_number)=undef;

	if (defined $target_region_code){

		($good,$error)=$self->_check_region_syntax($target_region_code);
		unless ($good){
			return (undef,$error);
		}#unless
	}#if

	($all_paths_by_region_HR,$error)=$self->_all_paths_by_region($target_region_code);
	unless (defined $all_paths_by_region_HR){
		return (undef, $error);
	}#unless

	foreach $region (keys %{$all_paths_by_region_HR}) {

		#Make sure @all_data_objects is empty.

		foreach $path (@{$all_paths_by_region_HR->{$region}}){

			$match=($path =~ m!/(\d{4})/(\d+)/$!);

			if (!$match){
				$msg="Geo::StormTracker::Main::all_storms_by_region_and_year had trouble with a pattern match.  ";
				$msg.="Returned values may be in error!";
				carp $msg,"\n";
				next;
			}
			else {
				$year=$1;
				$event_number=$2;
			}#if/else

			if (defined $target_year){
				next unless ($year == $target_year);
			}#if

			($data_obj,$error)=Geo::StormTracker::Data->new($path);
			if (defined $data_obj){
				unless (defined $data_objects_by_region_HR->{$region}->{$year}){
					$data_objects_by_region_HR->{$region}->{$year}=[];
				}#unless

				push (@{$data_objects_by_region_HR->{$region}->{$year}},$data_obj);
			}
			else {
				carp $error,"\n";
			}#if/else
		}#foreach
	}#foreach

	return ($data_objects_by_region_HR, undef);

}#all_storms_by_region_and_year
#---------------------------------------------------------
#Unless a target_region is specified the returned has
#will have a key for every region found.
sub all_active_storms_by_region {
        my $self=shift;
        my $target_region_code=shift;

        my ($data_obj,$path,$all_paths_by_region_HR)=undef;
        my ($region,$data_objects_by_region_HR)=undef;
        my ($good, $error, $is_active)=undef;
        my @all_paths=();
        my @all_data_objects=();

        if (defined $target_region_code){

                ($good,$error)=$self->_check_region_syntax($target_region_code);
                unless ($good){
                        return (undef,$error);
                }#unless
        }#if

        ($all_paths_by_region_HR,$error)=$self->_all_paths_by_region($target_region_code);
        unless (defined $all_paths_by_region_HR){
                return (undef,$error);
        }#unless

        foreach $region (keys %{$all_paths_by_region_HR}) {

                #Make sure @all_data_objects is empty.
                @all_data_objects=();

                foreach $path (@{$all_paths_by_region_HR->{$region}}){

                        ($data_obj,$error)=Geo::StormTracker::Data->new($path);

			unless (defined $data_obj){
				carp $error,"\n";
				next;
			}#unless

                        ($is_active,$error)=$data_obj->is_active();

			unless (defined $is_active){
				carp $error,"\n";
				next;
			}#unless

			push (@all_data_objects,$data_obj) if ($is_active);

                }#foreach

                $data_objects_by_region_HR->{$region}=[@all_data_objects];

        }#foreach

        return ($data_objects_by_region_HR,undef);

}#all_active_storms_by_region
#---------------------------------------------------------
#Every storm with a current advisory >= $epoch_retire
#and every active storm will be in the list.
#Unless a target_region is specified the returned hash ref
#will have a key for every region found.
#($data_HR, $error)=$main_obj->current_storms_by_region($epoch_retire, $region_code);
sub current_storms_by_region {
        my $self=shift;
	my $epoch_retire=shift;
        my $target_region_code=shift;

        my ($data_obj,$path,$all_paths_by_region_HR)=undef;
        my ($region,$data_objects_by_region_HR)=undef;
        my ($good, $error, $is_active, $msg)=undef;
        my ($current_adv, $epoch_date)=undef;
        my @all_paths=();
        my @all_data_objects=();

        if (defined $target_region_code){

                ($good,$error)=$self->_check_region_syntax($target_region_code);
                unless ($good){
                        return (undef,$error);
                }#unless
        }#if

	unless (defined $epoch_retire){
		$msg="Epoch retire date was not specified!";
		carp $msg, "\n";
		return (undef, $msg);
	}#unless

        ($all_paths_by_region_HR,$error)=$self->_all_paths_by_region($target_region_code);
        unless (defined $all_paths_by_region_HR){
                return (undef,$error);
        }#unless

        foreach $region (keys %{$all_paths_by_region_HR}) {

                #Make sure @all_data_objects is empty.
                @all_data_objects=();

                foreach $path (@{$all_paths_by_region_HR->{$region}}){

                        ($data_obj,$error)=Geo::StormTracker::Data->new($path);

			unless (defined $data_obj){
				carp $error,"\n";
				next;
			}#unless

                        ($is_active,$error)=$data_obj->is_active();

			unless (defined $is_active){
				carp $error,"\n";
				next;
			}#unless

			$current_adv=$data_obj->current_advisory();

			unless (defined $current_adv){
				carp "One of the data objects does not have any advisories!";
				next;
			}#unless

			$epoch_date=$current_adv->epoch_date();

			carp "Epoch date not defined for one of the advisories!" unless (defined $epoch_date);

			if (
				($is_active) or
				( (defined $epoch_date) and ($epoch_date >= $epoch_retire) )
				){
				push (@all_data_objects,$data_obj);
			}#if

                }#foreach

                $data_objects_by_region_HR->{$region}=[@all_data_objects];

        }#foreach

        return ($data_objects_by_region_HR,undef);

}#current_storms_by_region
#---------------------------------------------------------

1;
__END__