File Coverage

blib/lib/Geo/StormTracker/Data.pm

Criterion	Covered	Total	%
statement	18	438	4.1
branch	0	142	0.0
condition	0	21	0.0
subroutine	6	28	21.4
pod	13	13	100.0
total	37	642	5.7

package Geo::StormTracker::Data;

use Carp;
use Geo::StormTracker::Parser;
use IO::File;
use IO::Dir;
use strict;
use vars qw($VERSION);

$VERSION = '0.02';

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

	my ($msg,$success, $io)=undef;
	my $anon_HR={};

	#Check to see if the path was given
	unless (defined($path)){
		$msg = "The mandatory path argument was not provided to the new method!";
		carp $msg,"\n";
		return (undef,$msg);
	}

	#Make sure the path ends with a single slash.
	$path =~ s!/*$!/!;

	#Now check the path to see if it exists.
	#If not return undefined.
	unless (-e $path){
		$msg="The new method only creates an object if the path already exists!";
		$msg.="Consider using the shiny_new method instead!";
		carp $msg,"\n";
		return (undef,$msg);
	}#if

	#anytime a new data object is created it should contain a
	#the path, year, region, and event number for the weather event in question.

	$io=IO::File->new();
	unless ($io->open("<${path}region")){
		$msg="Couldn't open the ${path}region file!";
		carp $msg, "\n";
		return (undef, $msg);
	}#unless
	$anon_HR->{'region'}=$io->getline();
	chomp $anon_HR->{'region'};
	$io->close();

	unless ($io->open("<${path}year")){
		$msg="Couldn't open the ${path}year file!";
		carp $msg, "\n";
		return (undef, $msg);
	}#unless
	$anon_HR->{'year'}=$io->getline();
	chomp $anon_HR->{'year'};
	$io->close();

	unless ($io->open("<${path}event_number")){
		$msg="Couldn't open the ${path}event_number file!";
		carp $msg, "\n";
		return (undef, $msg);
	}#unless
	$anon_HR->{'event_number'}=$io->getline();
	chomp $anon_HR->{'event_number'};
	$io->close();

	$anon_HR->{'path'} = $path;
	bless $anon_HR, 'Geo::StormTracker::Data';

	return ($anon_HR, undef);

}#new
#------------------------------------------------------------------------------
sub shiny_new {
        my $self=shift;
        my $path=shift;
	my $region=shift;
	my $year=shift;
	my $event_num=shift;

        my ($msg,$success, $io)=undef;
        my $anon_HR={};

        #Check to see if the path was given
        unless (defined($path)){
                $msg = "The mandatory path argument was not provided to the shiny_new method!";
                carp $msg,"\n";
                return (undef,$msg);
        }#unless

	#Check the region argument.
	unless (
		(defined $region) and
		($region =~ m!^\w{2}$!)
		){
		$msg = "The shiny_new method's mandatory region argument was not provided or failed the syntax check!";
		carp $msg,"\n";
                return (undef,$msg);
	}#unless

	#Check the year argument.
	unless (
		(defined $year) and
		($year =~ m!^\d{4}$!)
		){
		$msg = "The shiny_new method's mandatory year argument was not provided or was not a 4 digit number!";
		carp $msg,"\n";
                return (undef,$msg);
	}#unless

	#Check the event_num argument.
	unless (
		(defined $event_num) and
		($event_num =~ m!^\d+$!)
		){
		$msg = "The shiny_new method's mandatory event number argument was not provided or was not a number!";
		carp $msg,"\n";
                return (undef,$msg);
	}#unless

        #Make sure the path ends with a single slash.
        $path =~ s!/*$!/!;

        #Now check the path to see if it exist.
	#If the path already exists, return undefined.
	if (-e $path){
		$msg="The path already exists.  The shiny_new method always fails in this event!";
		return (undef,$msg);
	}#if

        $success=mkdir($path,0776);
        unless ($success) {
		$msg = "Could not create a directory $path!";
		$msg .= "Consider using the new method!";
                carp $msg,"\n";
                return (undef,$msg);
	}#unless

	#Write out the region file.
	$io=IO::File->new();
	unless ($io->open(">${path}region")){
		$msg="Could not create a ${path}region file!";
		$msg.= "  The database is likely in a corrupt state due to this failure!";
		carp $msg, "\n";
		return (undef, $msg);
	}#unless
	$io->print($region);
	$io->close();

	#Write out the year file.
	unless ($io->open(">${path}year")){
		$msg="Could not create a ${path}year file!";
		$msg.= "  The database is likely in a corrupt state due to this failure!";
		carp $msg, "\n";
		return (undef, $msg);
	}#unless
	$io->print($year);
	$io->close();

	#Write out the event_number file.
	unless ($io->open(">${path}event_number")){
		$msg="Could not create a ${path}event_number file!";
		$msg.= "  The database is likely in a corrupt state due to this failure!";
		carp $msg, "\n";
		return (undef, $msg);
	}#unless
	$io->print($event_num);
	$io->close();

        #anytime a new data object is created it should contain a
        #the path, region, year, and event_number for the weather event in question.

        $anon_HR->{'path'} = $path;
	$anon_HR->{'region'}=$region;
	$anon_HR->{'year'}=$year;
	$anon_HR->{'event_number'}=$event_num;
        bless $anon_HR, 'Geo::StormTracker::Data';

        return ($anon_HR, undef);

}#shiny_new
#------------------------------------------------------------------------------
sub get_path {
	my $self=shift;
	return $self->{'path'};
}#get_path
#------------------------------------------------------------------------------
sub get_region {
	my $self=shift;
	return $self->{'region'};
}#get_region
#------------------------------------------------------------------------------
sub get_year {
	my $self=shift;
	return $self->{'year'};
}#get_year
#------------------------------------------------------------------------------
sub get_event_number {
	my $self=shift;
	return $self->{'event_number'};
}#get_event_number
#------------------------------------------------------------------------------
sub is_active {
	my $self=shift;
	my $arg=shift;
	my $ignore_lock=shift;

	my ($activefile,$io,$success,$error,$msg)=undef;

	$ignore_lock=0 if (!defined $ignore_lock);

	$activefile=$self->{'path'}.'activefile';

	if (defined($arg)){
		($success,$error)=$self->_patiently_grab_lock() unless ($ignore_lock);
		unless (($success) or ($ignore_lock)){
			$msg="Couldn't grab write lock for this weather event!";
			$msg.="  error was: $error";
			carp $msg,"\n";
			return (undef,$msg);
		}#unless

		if ($arg){
			$io=IO::File->new();
			unless($io->open(">$activefile")){
				$msg="Couldn't open $activefile in is_active method!";
				carp $msg,"\n";
				return (undef,$msg);
			}
			$io->print($$);
			$io->close();
		}
		else {
			unless(unlink($activefile)){
				$msg="Couldn't unlink $activefile in is_active method!";
				carp $msg,"\n";
				return (undef,$msg);
			}
		}#if/else

		($success,$error)=$self->_patiently_release_lock() unless ($ignore_lock);
		unless (($success) or ($ignore_lock)){
			$msg="Couldn't release write lock for this weather event!";
			$msg.="  error was: $error";
			carp $msg,"\n";
			return (undef,$msg);
		}
		return ($arg,undef);
	}
	else {
		if (-e $activefile){
			return (1,undef);
		}
		else {
			return (0,undef);
		}
	}#if/else
}
#------------------------------------------------------------------------------
#Need to figure out something sensensible to do with the success and error return
#values.
sub insert_advisory {
	my $self=shift;
	my $adv_obj=shift;
	my $force_option=shift;
	my $active_state=shift;

	my ($i,$got_lock,$lost_lock,$success,$error,$msg,$set_to)=undef;

	#attempt to grab a write lock
	($got_lock,$msg)=$self->_patiently_grab_lock();
	unless ($got_lock){
		return (undef,$msg);
	}#unless

	($success,$msg)=$self->_write_advisory($adv_obj,$force_option);
	unless ($success){
	        ($lost_lock,$error)=$self->_patiently_release_lock();
		$msg .= $error unless ($lost_lock);
		return (undef,$msg);
	}#unless

	($success,$msg)=$self->_update_trackfile($adv_obj,$force_option);
        unless ($success){
                ($lost_lock,$error)=$self->_patiently_release_lock();
                $msg .= $error unless ($lost_lock);
                return (undef,$msg);
        }#unless

	if (defined $active_state){
		($set_to,$msg)=$self->is_active($active_state,1);
		unless (defined $set_to){
			($lost_lock,$error)=$self->_patiently_release_lock();
	                $msg .= $error unless ($lost_lock);
			return (undef,$msg);
		}
	}#if

	#attempt to release the write lock
	($success,$error)=$self->_patiently_release_lock();

	if ($success){
		return (1,undef);
	}
	else {
		return (undef,$error);
	}#if/else

}#insert_advisory
#------------------------------------------------------------------------------
sub all_advisories {
	my $self=shift;

	my ($parser,$file,$adv_obj)=undef;
	my @advisory_files=();
	my @adv_obj_array=();

	@advisory_files=$self->_sorted_advisory_files();

	$parser=Geo::StormTracker::Parser->new();

	foreach $file (@advisory_files){
		$adv_obj=$parser->read_file($self->{'path'}.$file);
		push (@adv_obj_array,$adv_obj) if (defined $adv_obj);
	}

	return wantarray ? @adv_obj_array : \@adv_obj_array;
}#all_advisories
#-----------------------------------------------------------------------------
sub current_advisory {
	my $self=shift;

	my ($parser,$current_advisory_file,$adv_obj);
	my @advisory_files=();

	@advisory_files=$self->_sorted_advisory_files();
	$current_advisory_file=$advisory_files[$#advisory_files];

	$parser=Geo::StormTracker::Parser->new();

	$adv_obj=$parser->read_file($self->{'path'}.$current_advisory_file);

	return $adv_obj;
}#current_advisory
#-----------------------------------------------------------------------------
sub advisory_by_number {
	my $self=shift;
	my $advisory_number=shift;

	my ($d,$path,$msg,$file,$target_file,$parser,$number,$adv_obj)=undef;
	my @file_list=();

	$path=$self->{'path'};

	#Check the advisory_number argument
	unless (defined $advisory_number){
		$msg="An advisory number argument must be given to the advisory_by_number method!";
		carp $msg,"\n";
		return undef;
	}

	#Grab list of files in the $path directory.
	$d=IO::Dir->new();
        $d->open($path);
        unless (defined($d)){
                $msg = "Had trouble reading $path directory!";
                carp $msg,"\n";
                return undef;
        }
	@file_list=$d->read();
	$d->close();

	#Figure out which file is has the advisory number we want.
	$target_file=undef;
	foreach $file (@file_list){
		next if $file =~ m!^(\.|\.\.)$!;
		$file =~ m!(\d+[A-Z]*)\.adv!;
		$number=$1;
		#if ((defined $number) and ($advisory_number == $number)){
		if ((defined $number) and ($self->_compare_advisory_numbers($advisory_number,$number) == 0) ){
			$target_file=$file;
			last;
		}#if;
	}#foreach

	#If the desired file wasn't found then return undef.
	return undef unless (defined $target_file);

	#parse the file and obtain its advisory object.
	$parser=Geo::StormTracker::Parser->new();

	$adv_obj=$parser->read_file($self->{'path'}.$target_file);

	#return the advisory object
	return $adv_obj;
}#advisory_by_number
#------------------------------------------------------------------------------
sub _sorted_advisory_files {
	my $self=shift;

	my ($d,$path,$msg,$file)=undef;
	my @unsorted_advisory_files=();
	my @advisory_files=();
	my @file_list=();

	$path=$self->{'path'};

        $d=IO::Dir->new();
        $d->open($path);
        unless (defined($d)){
                $msg = "Had trouble reading $path directory!";
		carp $msg,"\n";
		return undef;
        }

        @file_list=$d->read;
        $d->close();

	foreach $file (@file_list){
		if ($file =~ m!\d+[A-Z]*\.adv$!){
			push(@unsorted_advisory_files,$file);
		}#if
	}#foreach

	@advisory_files=sort {
				$a =~ m!(\d+[A-Z]*)\.adv$!;
				my $num_a=$1;
				$b =~ m!(\d+[A-Z]*)\.adv$!;
				my $num_b=$1;
				#$num_a <=> $num_b;
				$self->_compare_advisory_numbers($num_a,$num_b);
				}
				@unsorted_advisory_files;

	return @advisory_files;

}#_sorted_advisory_files
#------------------------------------------------------------------------------
sub current_position {
	my $self=shift;

	my @position_array=();

	@position_array=$self->position_track();

	return $position_array[$#position_array];

}#current_postion
#------------------------------------------------------------------------------
sub position_track {
	my $self=shift;

	my ($trackfile,$in_line,$lat_digit,$lat_dir,$long_digit,$long_dir,$msg)=undef;
	my @position_array=();

	$trackfile=$self->{'path'}.'trackfile';

	my $io_in=IO::File->new();
	unless ($io_in->open("<$trackfile")){
		$msg="position_track method couldn't read from $trackfile!";
		carp $msg,"\n";
		return undef;
	}
	while (defined($in_line=$io_in->getline)){
		chomp($in_line);
		($lat_digit,$lat_dir,$long_digit,$long_dir)=split(',',(split("\t",$in_line))[5]);
		push (@position_array,[$lat_digit,$lat_dir,$long_digit,$long_dir]);
	}#while

	return wantarray ? @position_array : \@position_array;
}#positon_track
#------------------------------------------------------------------------------
sub _construct_data_line {
	my $self=shift;
	my $adv_obj=shift;

	my ($data_line,$advisory_number,$event_type,$release_time)=undef;
	my ($max_winds,$min_central_pressure,$position_AR)=undef;
	my @data_line=();

	$advisory_number=$adv_obj->advisory_number();
	$event_type=$adv_obj->event_type();
	$release_time=$adv_obj->release_time();
	$max_winds=$adv_obj->max_winds();
	$min_central_pressure=$adv_obj->min_central_pressure();
	$position_AR=$adv_obj->position();

	if (defined $advisory_number){
		push(@data_line,$advisory_number);
	}
	else {
		push(@data_line,'');
	}#if/else

	if (defined($event_type)){
		push(@data_line,$event_type);
	}
	else {
		push(@data_line,'');
	}#if/else

	if (defined $release_time){
		push(@data_line,$release_time);
	}
	else {
		push(@data_line,'');
	}#if/else

	if (defined $max_winds){
		push(@data_line,$max_winds);
	}
	else {
		push(@data_line,'');
	}#if/else

	if (defined $min_central_pressure){
		push(@data_line,$min_central_pressure);
	}
	else {
		push(@data_line,'');
	}#if/else

	if (defined $position_AR){
		push(@data_line,join(',',@{$position_AR}));
	}
	else {
		push(@data_line,'');
	}#if/else

	$data_line=join("\t",@data_line);

	return $data_line;

}#_construct_data_line
#------------------------------------------------------------------------------
sub _update_trackfile {
	my $self=shift;
	my $adv_obj=shift;
	my $force_option=shift;

	my ($msg,$success,$io_in,$io_out,$in_line,$advisory_index,$data_line)=undef;
	my ($adv_comp,$trackfile,$advisory_number,$added_data)=undef;

	$data_line=$self->_construct_data_line($adv_obj);

	$trackfile=$self->{'path'}."trackfile";
	$advisory_number=$adv_obj->advisory_number();

	if (-e $trackfile) {
		$success=rename($trackfile,"$trackfile\.old");
		unless ($success) {
			$msg="Couldn't move $trackfile to $trackfile\.old!";
			croak $msg,"\n";
			#return (0,$msg);
		}#unless

		$io_in=IO::File->new();
		unless ($io_in->open("<$trackfile\.old")){
			$msg="Couldn't open $trackfile\.old for reading!";
			croak $msg,"\n";
			#return (0,$msg);
		}#unless

		$io_out=IO::File->new();
		unless ($io_out->open(">$trackfile")){
			$msg="Couldn't open $trackfile for writting!";
			croak $msg,"\n";
			#return (0,$msg);
		}#unless

		$added_data=0;
		while (defined($in_line=$io_in->getline)){
			chomp($in_line);

			$advisory_index=(split("\t",$in_line))[0];

			$adv_comp=$self->_compare_advisory_numbers($advisory_index,$advisory_number);

			#if ($advisory_index < $advisory_number){
			if ($adv_comp < 0){
				$io_out->print($in_line,"\n");
			}
			#elsif ($advisory_index == $advisory_number){
			elsif ($adv_comp == 0){
				if ($force_option){
					$io_out->print($data_line,"\n");
				}
				else {
					$io_out->print($in_line,"\n");
					$msg="Advisory number $advisory_number already exists and force option is not on!";
					$msg.="  The original track information was not changed!";
					carp $msg,"\n";
				}#if/else

				$added_data=1;
			}
			else {
				unless ($added_data){
					$io_out->print($data_line,"\n");
					$added_data=1;
				}#unless

				$io_out->print($in_line,"\n");
			}#if/elsif/else
		}#while
		$io_out->close();
		$io_in->close();

		unless(unlink("$trackfile\.old")){
			$msg="Couldn't unlink $trackfile\.old!";
			carp $msg,"\n";
		}
	}
	else {
		$io_out=IO::File->new();
		unless ($io_out->open(">$trackfile")){
			$msg="Couldn't open $trackfile for writting!";
			croak $msg,"\n";
			#return (0,$msg);
		}#unless
		$io_out->print($data_line,"\n");
		$io_out->close();
	}#if/else

	return (1,$msg);
}#_update_trackfile
#------------------------------------------------------------------------------
sub _compare_advisory_numbers {
	my $self=shift;
	my $adv_num1=shift;
	my $adv_num2=shift;

	my ($num1_digits,$num1_alpha,$num2_digits,$num2_alpha)=undef;

	$adv_num1 =~ m!(\d+)([A-Z]*)$!;
	$num1_digits=$1;
	$num1_alpha=$2;
	$num1_alpha=uc $num1_alpha if (defined $num1_alpha);
	$num1_alpha =~ tr/ABCDEFGHI/123456789/;
	$adv_num1="$num1_digits\.$num1_alpha";

	$adv_num2 =~ m!(\d+)([A-Z]*)$!;
	$num2_digits=$1;
	$num2_alpha=$2;
	$num2_alpha=uc $num2_alpha if (defined $num2_alpha);
	$num2_alpha =~ tr/ABCDEFGHI/123456789/;
	$adv_num2="$num2_digits\.$num2_alpha";

	return $adv_num1 <=> $adv_num2;
}#_compare_advisory_numbers
#------------------------------------------------------------------------------
sub _write_advisory {
	my $self=shift;
	my $adv_obj=shift;
	my $force_option=shift;

	my ($io,$filename,$msg,$path)=undef;

	#Come up with a filename unique to each advisory number
	#and which has some indicator of storm type
	$path=$self->{'path'};
	$filename =$adv_obj->event_type();
	$filename =~ s!\s!!gs;
	$filename .= $adv_obj->advisory_number();
	$filename .= '.adv';
	$filename = "${path}${filename}";


	if ((-e $filename) and (!$force_option)) {
		$msg="Filename $filename exists and force option is not on!";
		carp $msg,"\n";
		return (0,$msg);
	}
	else {
		$io=IO::File->new();
		unless ($io->open(">$filename")){
			$msg="Couldn't write to file $filename!";
			carp $msg,"\n";
			return (0,$msg);
		}
		$io->print($adv_obj->stringify());
		$io->close();
		return (1,undef);
	}
}#_write_advisory
#------------------------------------------------------------------------------
sub _patiently_grab_lock{
	my $self=shift;

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

	for ($i = 0; $i <= 4; $i++){
		$success=$self->_grab_advisory_lock();
		last if ($success);
		if ($i == 4) {
			$msg="Could not grab a write lock!";
			carp $msg,"\n";
			return (0,$msg);
		}
		else {
			sleep 2;
		}#if/else
	}#for

	return (1,undef);

}#_patiently_grab_lock
#------------------------------------------------------------------------------
sub _patiently_release_lock{
	my $self=shift;

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

	for ($i = 0; $i <= 4; $i++){
		$success=$self->_release_advisory_lock();
		last if ($success);
		if ($i == 4) {
			$msg="Could not release the write lock!";
			carp $msg,"\n";
			return (0,$msg);
		}
		else {
			sleep 2;
		}#if/else
	}#for

	return (1,undef);

}#_patiently_release_lock
#------------------------------------------------------------------------------
#$success=$self->_grab_advisory_lock();
sub _grab_advisory_lock {
	my $self=shift;

	my ($lock_file,$io)=undef;

	$lock_file=$self->{'path'}."lockfile";
	if (-e $lock_file) {
		return 0;
	}
	else {
		$io=IO::File->new();
		$io->open(">$lock_file") or croak "Couldn't write to $lock_file\n";
		$io->print("$$");
		$io->close();
		return 1;
	}#if/else
}#_grab_advisory_lock
#------------------------------------------------------------------------------
#$success=$self->_release_advisory_lock();
sub _release_advisory_lock {
	my $self=shift;

	my $lock_file=undef;

	$lock_file=$self->{'path'}."lockfile";

	if (unlink($lock_file)){
		return 1;
	}
	else {
		return 0;
	}
}#_release_advisory_lock
#------------------------------------------------------------------------------

1;
__END__