File Coverage

blib/lib/Ham/Resources/Propagation.pm

Criterion	Covered	Total	%
statement	136	162	83.9
branch	49	88	55.6
condition	23	60	38.3
subroutine	17	20	85.0
pod	6	6	100.0
total	231	336	68.7

package Ham::Resources::Propagation;

use strict;
use warnings;
use LWP::UserAgent;
use XML::Reader::PP;

use Data::Dumper;

use vars qw($VERSION);

our $VERSION = '0.04';

my $data_url = 'http://www.hamqsl.com/solarxml.php';
my $site_name = 'hamqsl.com';
my $default_timeout = 10;
my $default_description = 'text'; # maybe 'text' or 'numeric'

my @items = ('solar_data', 'hf', 'vhf', 'extended');
my @scale = ('Normal', 'Active', 'Minor', 'Moderate', 'Strong', 'Severe', 'Extreme');

sub new
{
	my $class = shift;
	my %args = @_;
	my $self = {};
	$self->{timeout} = $args{timeout} || $default_timeout;
	$self->{description} = $args{description} || $default_description;

    bless $self, $class;
	_data_init($self);
	return $self;
}

sub get_groups
{
	return \@items;
}

sub get
{
	my ($self, $item) = @_;
	$self->{solar_data}->{$item} || $self->{hf}->{$item} || $self->{vhf}->{$item} || $self->{extended}->{$item} || return ($self->{error_mesage} = "Don't found this key ".$item);
}

sub all_item_names
{
	my ($self, @item_names) = @_;
   foreach my $key (sort(@items)){
		foreach (sort keys %{$self->{$key}})
		{
			push @item_names, $_;
		}
	}
	return \@item_names;
}

sub is_error { my $self = shift; $self->{error_message} }
sub error_message { my $self = shift; $self->{error_message} }

# -----------------------
#	PRIVATE SUBS
# -----------------------

sub _data_init
{
	my $self = shift;
	my $content = $self->_get_content($data_url) or return 0;
	my $data;

	my $xml = XML::Reader::PP->new(\$content) or return $self->{error_message} = "Error to read XML of $site_name - ".$!;
	my $p_data;

	while ($xml->iterate) {
		# Solar datas
		if ($xml->value ne '' && $xml->path !~ /calculated/ && $xml->tag ne '@url' && $xml->tag ne 'source')
		{
			# Rules for add text to some value items
			$data = $xml->value;	# data by default, without text
			if($xml->tag eq 'xray') { $data = $self->_add_xray_text($xml->value); }
			if($xml->tag eq 'kindex') { $data = $self->_add_kindex_text($xml->value); }
			if($xml->tag eq 'aindex') { $data = $self->_add_aindex_text($xml->value); }
			if($xml->tag eq 'protonflux') { $data = $self->_add_protonflux_text($xml->value); }
			if($xml->tag eq 'electonflux') { $data = $self->_add_electronflux_text($xml->value); }
			if($xml->tag eq 'solarflux') { $data = $self->_add_solarflux_text($xml->value); }

			$self->{solar_data}->{$xml->tag} = $data;
		}

		# Propagation
		if ($xml->path =~ /calculated/) {
			$p_data .= $xml->value;
			if ($xml->tag =~ /\@/) {
				$p_data .= " ";
			} else {
				# create a list for HF conditions
				if ($p_data =~ m/(\d+)m(\-\d+m) (day|night) (.+)/i) {
					my $hf_tag = $1.$2."_".$3;
					$self->{hf}->{$hf_tag} = $4;
				}
				# create a list for VHF conditions
				if ($p_data =~ /^(.+)(Band .+)/) {
					$self->{vhf}->{$1} = $2;
				}
				$p_data = undef;
			}
		}
	}
}

sub _get_content
{
	my ($self, $url) = @_;
	my $browser = LWP::UserAgent->new( timeout=>$self->{timeout} );
	$browser->agent("Ham/Resources/Propagation.pm $VERSION");
	my $response = $browser->get($url);

	if (!$response->is_success)
	{
		$self->{is_error} = 1;
		$self->{error_message} = "Error at $site_name - ".$response->status_line;
		return 0;
	}

	return $response->content;
}

sub _add_aindex_text
{
	my ($self, $num) = @_;
	return $num if $self->{description} eq 'numeric';
	return '('.$num.') quiet' if $num <= 7;
	return '('.$num.') unsettled' if $num >= 8 and $num <= 15;
	return '('.$num.') active' if $num >= 16 and $num <= 29;
	return '('.$num.') minor storm' if $num >= 30 and $num <= 49;
	return '('.$num.') major storm' if $num >= 50 and $num <= 99;
	return '('.$num.') severe storm' if $num >= 100 and $num <= 400;
}

sub _add_kindex_text
{
	my ($self, $num) = @_;
	return $num if $self->{description} eq 'numeric';
	return '('.$num.') quiet' if $num <= 2;
	return '('.$num.') unsettled' if $num == 3;
	return '('.$num.') active' if $num == 4;
	return '('.$num.') minor storm' if $num == 5;
	return '('.$num.') major storm' if $num == 6;
	return '('.$num.') severe storm' if $num >= 7 and $num <= 9;
}


sub _add_xray_text
{
	my ($self, $num) = @_;
	my %xray_defs = (
		'A|B'			=> $scale[0].'| No or small flare. No or very minor impact to HF signals.',
		'C'			=> $scale[1].'| Moderate flare Low absortion of HF signals.',
		'M[1-4]'		=> $scale[2].'| 2000 flares per cycle. Occasional loss of radio contact on sunlit side.',
		'M[5-9]'		=> $scale[3].'| 350 flares per cycle. Limited HF blackout on sunlit side for tens of minutes.',
		'X[1-9?]'	=> $scale[4].'| 175 flares per cycle. Wide area HF blackout for about an hour on sunlit side.',
		'X1[0-9]'	=> $scale[5].'| 8 flares per cycle. HF blackout on most of sunlit side for 1 to 2 hours.',
		'X2[0-9?]'	=> $scale[6].'| 1 flare per cycle. Complete HF blackout on entire sunlit side lasting hours.',
	);

	foreach my $xray_key (keys %xray_defs)
	{
		if ($num =~ /$xray_key/i)
		{
			my $xray_complete_data = "(".$num.") ".$xray_defs{$xray_key};

			my $radioblackout = $xray_complete_data;
			my ($category, $text) = $radioblackout	 =~ /^\(.+\)(.+)\|(.+)/;
			$radioblackout = $category.'.'.$text;
			$self->{extended}->{radioblackout} = $radioblackout;
			my ($xray_resume_data) = $xray_complete_data =~ /^(.+)\|.+/;
			$num = $xray_resume_data if $self->{description} ne 'numeric';
			return $num;
		}
	}
	return $num;
}

sub _add_protonflux_text
{
	my ($self, $num) = @_;

	my $exponentation = substr $num, -2;

	my %proton_defs = (
		'00'	=> $scale[0].'| No impacts on HF.',
		'01'	=> $scale[1].'| Very minor impacts on HF in polar regions.',
		'02'	=> $scale[2].'| 50 storms per cycle. Minor impacts on HF in polar regions.',
		'03'	=> $scale[3].'| 25 storms per cycle. Small effects on HF in polar regions.',
		'04'	=> $scale[4].'| 10 storms per cycle. Degraded HF propagation in polar regions.',
		'05'	=> $scale[5].'| 3 storms per cycle. Partial HF blackout in polar regions.',
		'06'	=> $scale[6].'| 1 storm per cycle. Complete HF blackout in polar regions.',
	);

	my $proton_complete_data = "(".$num.") ".$proton_defs{$exponentation};

	my $solarradiotion = $proton_complete_data;
	my ($category, $text) = $solarradiotion	 =~ /^\(.+\)(.+)\|(.+)/;
	$solarradiotion = $category.'.'.$text;
	$self->{extended}->{solarradiation} = $solarradiotion;
	my ($proton_resume_data) = $proton_complete_data =~ /^(.+)\|.+/;
	$num = $proton_resume_data if $self->{description} ne 'numeric';
	return $num;
}

sub _add_electronflux_text
{
	my ($self, $num) = @_;

	my $electron_def;
	$electron_def = $scale[0].'| No impacts on HF.' if $num < 1.0e+01;
	$electron_def = $scale[2].'| Minor impacts on HF in polar regions.' if $num > 1.0e+01 && $num < 1.0e+02;
	$electron_def = $scale[2].'| Degraded HF propagation in polar regions.' if $num > 1.0e+02 && $num < 1.0e+03;
	$electron_def = 'Alert'.'| Partial HF blackout in polar regions.' if $num > 1.0e+03;

	my $electron_complete_data = "(".$num.") ".$electron_def;

	my $electronalert = $electron_complete_data;
	my ($category, $text) = $electronalert	 =~ /^\(.+\)(.+)\|(.+)/;
	$electronalert = $category.'.'.$text;
	$self->{extended}->{electronalert} = $electronalert;
	my ($electron_resume_data) = $electron_complete_data =~ /^(.+)\|.+/;
	$num = $electron_resume_data if $self->{description} ne 'numeric';
	return $num;

}

sub _add_solarflux_text
{
	my ($self, $num) = @_;

	my @sn_ratio = ('0-10', '10-35', '35-70', '70-105', '105-160', '160-250');

	my $solarflux_def;
	if ($num <= 70)
	{
		$solarflux_def = $scale[0].'| Bands above 40m unusuable.';
		$self->{solar_data}->{SN} = $sn_ratio[0];
	};
	if ($num > 70 && $num <= 90)
	{
		$solarflux_def = $scale[1].'| Poor to fair conditions all bands up through.';
		$self->{solar_data}->{SN} = $sn_ratio[1];
	};
	if ($num > 90 && $num <= 120)
	{
		$solarflux_def = $scale[2].'| Fair conditions all bands up through 15m.';
		$self->{solar_data}->{SN} = $sn_ratio[2];
	};
	if ($num > 120 && $num <= 150)
	{
		$solarflux_def = $scale[3].'| Fair to good conditions all bands up through 10m.';
		$self->{solar_data}->{SN} = $sn_ratio[3];
	};
	if ($num > 150 && $num <= 200)
	{
		$solarflux_def = $scale[4].'| Excelent conditions all bands up through 10m w/6m openings.';
		$self->{solar_data}->{SN} = $sn_ratio[4];
	};
	if ($num > 200)
	{
		$solarflux_def = $scale[5].'| Reliable communications all bands up through 6m.';
		$self->{solar_data}->{SN} = $sn_ratio[5];
	};

	my $solarflux_complete_data = "(".$num.") ".$solarflux_def;

	my $bandopenings = $solarflux_complete_data;
	my ($category, $text) = $bandopenings	 =~ /^\(.+\)(.+)\|(.+)/;
	$bandopenings = $category.'.'.$text;
	$self->{extended}->{bandopenings} = $bandopenings;

	my ($solarflux_resume_data) = $solarflux_complete_data =~ /^(.+)\|.+/;
 	$num = $solarflux_resume_data if $self->{description} ne 'numeric';
	return $num;

}


1;

__END__