File Coverage

blib/lib/GPS/Tracer.pm

Criterion	Covered	Total	%
statement	19	21	90.4
branch			n/a
condition			n/a
subroutine	7	7	100.0
pod			n/a
total	26	28	92.8

#-----------------------------------------------------------------
# GPS::Tracer
# Authors: Martin Senger
#          Kim Senger
# For copyright and disclaimer see below.
#
# $Id: Tracer.pm,v 1.2 2007/04/30 21:52:10 senger Exp $
#-----------------------------------------------------------------

package GPS::Tracer;

use strict;
use warnings;
use vars qw( $VERSION $Revision $AUTOLOAD );

use constant PI => 3.14159;
use constant R  => 6378700;

use Text::CSV::Simple;
use XML::Simple;
use LWP::UserAgent;
use File::Temp qw/ :POSIX /;
use File::Spec;
use Date::Calc qw( Add_Delta_Days );
use GD::Graph::hbars;

$VERSION = '1.2';
$Revision  = '$Id: Tracer.pm,v 1.2 2007/04/30 21:52:10 senger Exp $';

#-----------------------------------------------------------------
# A list of allowed attribute names.
#-----------------------------------------------------------------
{
    my %_allowed =
	(
	 user             => 1,
         passwd           => 1,
	 from_date        => 1,
	 to_date          => 1,
	 login_url        => 1,
	 data_url         => 1,
	 default_id       => 1,
	 min_distance     => 1,
	 result_dir       => 1,
	 result_basename  => 1,
	 input_data       => 1,
	 input_format     => 1,
	 );

    sub _accessible {
	my ($self, $attr) = @_;
	exists $_allowed{$attr};
    }
}

#-----------------------------------------------------------------
# Deal with 'set' and 'get' methods.
#-----------------------------------------------------------------
sub AUTOLOAD {
    my ($self, $value) = @_;
    my $ref_sub;
    if ($AUTOLOAD =~ /.*::(\w+)/ && $self->_accessible ("$1")) {

	# get/set method
	my $attr_name = "$1";
	$ref_sub =
	    sub {
		# get method
		local *__ANON__ = "__ANON__$attr_name" . "_" . ref ($self);
		my ($this, $value) = @_;
		return $this->{$attr_name} unless defined $value;

		# set method
		$this->{$attr_name} = $value;
		return $this->{$attr_name};
	    };

    } else {
	die ("No such method: $AUTOLOAD");
    }

    no strict 'refs';
    *{$AUTOLOAD} = $ref_sub;
    use strict 'refs';
    return $ref_sub->($self, $value);
}

#-----------------------------------------------------------------
# Keep it here! The reason is the existence of AUTOLOAD...
#-----------------------------------------------------------------
sub DESTROY {
}

#-----------------------------------------------------------------
# new
#-----------------------------------------------------------------
sub new {
    my ($class, @args) = @_;

    # create an object
    my $self = bless {}, ref ($class) || $class;

    # initialize the object
    $self->init();

    # set all @args into this object with 'set' values
    my (%args) = (@args == 1 ? (value => $args[0]) : @args);
    foreach my $key (keys %args) {
        no strict 'refs';
        $self->$key ($args {$key});
    }

    # done
    return $self;
}

#-----------------------------------------------------------------
# init
#-----------------------------------------------------------------
sub init {
    my ($self) = shift;

    # some default values
    $self->from_date ('0000-00-00 00:00:00');  # format: 2006-10-28 18:02:20
    $self->to_date ('9999-99-99 23:59:59');    # format: 2006-10-28 18:02:20
    $self->result_basename ('trout');          # as TRacer OUTput
    $self->min_distance (500);                 # in metres
    $self->input_format ('6,7,8,9');           # column indeces for time, lat, lng, alt

}

#-----------------------------------------------------------------
# toString
#-----------------------------------------------------------------
sub toString {
    my $self = shift;
    require Data::Dumper;
    return Data::Dumper->Dump ( [$self], ['Tracer']);
}


# ----------------------------------------
# Subroutines
# ----------------------------------------

my @MONTHS = qw(dummy Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);

sub create_all {
    my ($self) = @_;
    my @files = ();

    my $ra_data = $self->get_data;
    push (@files, $self->convert2xml ($ra_data));
    push (@files, $self->oneperday2xml ($ra_data));

    my $ra_sum = $self->get_summary ($ra_data);
    push (@files, $self->_summary2csv ($ra_sum));
    push (@files, $self->_summary2xml ($ra_sum));
    push (@files, $self->_summary2graph ($ra_sum));

    my $ra_mindist = $self->_min_distance ($ra_data);
    push (@files, $self->_min_distance2xml ($ra_mindist));
    push (@files, $self->_convert2oziwpt ($ra_mindist));

    return @files;

}

#
# save daily distances to a CSV file
#
sub summary2csv {
    my ($self, $ra_data) = @_;
    return $self->_summary2csv ($self->get_summary ($ra_data));
}

sub _summary2csv {
    my ($self, $ra_sum) = @_;

    my @day_names = @{ $$ra_sum{day_names} };
    my @day_dists = @{ $$ra_sum{day_dists} };

    my $filename = $self->_get_filename ('.csv');
    if (open (CSV, ">$filename")) {
	print CSV "Date,Metres\n";
	foreach my $day (0..$#day_names) {
	    print CSV $day_names[$day], ',', $day_dists[$day], "\n";
	}
	close CSV;
    } else {
	warn "Cannot open file '$filename' for writing: $!\n";
    }
    return $filename;
}

#
# save summaries to a short XML file:
#
#
#
#
sub summary2xml {
    my ($self, $ra_data) = @_;
    return $self->_summary2xml ($self->get_summary ($ra_data));
}

sub _summary2xml {
    my ($self, $ra_sum) = @_;

    my @day_names = @{ $$ra_sum{day_names} };
    my $total_distance = $$ra_sum{total_dist};

    my $filename = $self->_get_filename ('-summary.xml');
    my $xs = XML::Simple->new();
    $xs->XMLout ({ 'total' => { days => (@day_names+0), kms => $total_distance / 1000 } },
		 RootName => 'summary',
		 OutputFile => $filename);
    return $filename;
}

#
# let's make a chart
#
sub summary2graph {
    my ($self, $ra_data) = @_;
    return $self->_summary2graph ($self->get_summary ($ra_data));
}

sub _summary2graph {
    my ($self, $ra_sum) = @_;

    my @day_names = @{ $$ra_sum{day_names} };
    my @day_dists = @{ $$ra_sum{day_dists} };

    # change metres to kilometres (rounded to 100 metres)
    map { $_ = int (($_ / 1000 + .05) * 10) / 10  } @day_dists;

    # make sure that missing dates are also listed (with 0 value)
    if (@day_names > 0) {
	my $expected_date = $day_names[0];
	my $i = 0;
	while ($i < @day_names) {
	    my $current_date = $day_names[$i];
	    while ($current_date gt $expected_date) {
		$expected_date = $self->increase_date ($expected_date);
		splice (@day_names, $i, 0, 'no data');
		splice (@day_dists, $i, 0, 0);
		$i++;
	    }
	    $i++;
	    $expected_date = $self->increase_date ($expected_date);
	}
    }

    # make dates more human-readable
    map {
	if ($_ ne 'no data') {
	    $_ = $MONTHS [substr ($_, 5, 2)] . ' ' . substr ($_, 8, 2);
	} } @day_names;

    # if there are no data yet
    if (@day_dists == 0) {
	push (@day_dists, 0.001);
	push (@day_names, 'not yet started');
    }

    # create statistical (charts) files
    my $filename = $self->_get_filename ('-chart.png');

    my $width = 400;
    my $height= 100 + 15 * @day_names;
    my $my_graph = GD::Graph::hbars->new ($width, $height);

    my (@g_args) = ();   # for collecting the graph properties
    push (@g_args, y_label => "Travelled km");
    push (@g_args, y_number_format => "%.1f");
    push (@g_args,
	  title           => ' ',
	  x_label         => '',
	  bar_spacing     => 1,
	  shadow_depth    => 0,
	  transparent     => 0,
	  show_values     => 1,
	  box_axis        => 0,
	  r_margin        => 5,
	  l_margin        => 5,
	  fgclr           => 'black',
	  labelclr        => 'black',
	  axislabelclr    => 'black',
	  dclrs           => [ map 'lblue', (0..$#day_names) ],
	  );

    eval {
	# plot the chart...
	$my_graph->set (@g_args);
	my $my_plot = $my_graph->plot ([ \@day_names, \@day_dists ]);

	# ...and save it to a file
	open (IMG, ">$filename")
	    or die "Cannot create file '$filename': $!\n";
	binmode IMG;
	print IMG $my_plot->png;
	close IMG;

    };
    warn "Creating a chart failed: " . ($my_graph->error or $@) . "\n" if $@;
    return $filename;
}

#
sub increase_date {
    my ($self, $date) = @_;
    my ($y, $m, $d) = Add_Delta_Days (substr ($date, 0, 4),
				      substr ($date, 5, 2),
				      substr ($date, 8, 2),
				      1);
    return sprintf "%04u-%02u-%02u", $y, $m, $d;
}

#
# convert degress to radians
#
sub deg2rad {
    my ($deg) = @_;
    return $deg / (180 / PI);
}

sub acos { atan2 ( sqrt (1 - $_[0] * $_[0]), $_[0]) }

#
# calculate distance between two points in meters
#
sub distance {
    my ($prev_lat, $prev_lng, $curr_lat, $curr_lng) = @_;
    my $prev_lat_rad = deg2rad ($prev_lat);
    my $curr_lat_rad = deg2rad ($curr_lat);

    return R * acos (sin ($prev_lat_rad) * sin ($curr_lat_rad) +
		     cos ($prev_lat_rad) * cos ($curr_lat_rad) *
		     cos (deg2rad ($prev_lng - $curr_lng)));
}

#
# return a hashref with two keys ('day_names' and 'day_dists') where
# in both cases the values are arrayrefs of the same size, one with
# dates (YYYY-MM-DD), one with day distances (in metres)
#
sub get_summary {
    my ($self, $ra_data) = @_;

    # here we collect returned values
    my @day_names = ();
    my @day_dists = ();
    my $total_distance = 0;

    my $prev_rec;
    foreach (@$ra_data) {
	$day_dists[$#day_dists] += distance ($$prev_rec{'lat'}, $$prev_rec{'lng'},
					     $$_{'lat'}, $$_{'lng'})
	    if defined $prev_rec;
	$prev_rec = $_;
	if ($$_{'type'} == 1) {
	    push (@day_names, substr ($$_{'time'}, 0, 10));
	    push (@day_dists, 0);
	}
    }

    map { $total_distance += $_ } @day_dists;

    return { day_names  => \@day_names,
	     day_dists  => \@day_dists,
	     total_dist => $total_distance,
	 };
}

#
# convert $ra_data to XML and save the result into
# file $filename - using some precaution
#
sub save2xml {
    my ($self, $ra_data, $filename) = @_;

    # backup the old XML file
    my $backup_file = "$filename.$$";
    -e $filename and rename $filename, $backup_file;

    # convert to XML
    my $xs = XML::Simple->new();
    $xs->XMLout ({ 'marker' => $ra_data },
		 RootName => 'markers',
		 OutputFile => $filename);

    # back to the backup file on failure
    -e $filename or rename $backup_file, $filename;
    unlink $backup_file;
}

#
# take only the first record of each day
#
sub oneperday2xml {
    my ($self, $ra_data) = @_;
    my @unique = grep { $$_{'type'} == 1 } @{$ra_data};

    # ...and the quite last record (if not already taken)
    $self->maybe_add_last_record ($ra_data, \@unique);

    my $outfile = $self->_get_filename ('-oneperday.xml');
    $self->save2xml (\@unique, $outfile);
    return $outfile;
}

#
# return only records with points not too close together
# (but kept there the one-per-day points);
#
sub _min_distance {
    my ($self, $ra_data) = @_;

    my $prev_lat = 1000;
    my $prev_lng = 1000;
    my @unique =
	grep { my $curr_lat = $$_{'lat'};
	       my $curr_lng = $$_{'lng'};
	       if ($prev_lat == 1000 or $$_{'type'} == 1) {
		   $prev_lat = $curr_lat; $prev_lng = $curr_lng;
		   1;
	       } else {
		   my $dist = distance ($prev_lat, $prev_lng, $curr_lat, $curr_lng);
		   $prev_lat = $curr_lat; $prev_lng = $curr_lng;
		   $dist > $self->min_distance;
	       }
	   } @{$ra_data};

    # ...and the quite last record (if not already taken)
    $self->maybe_add_last_record ($ra_data, \@unique);

    return \@unique;
}

#
# convert $ra_data to OziExplorer's waypoints and save the result into
# file $filename - using some precaution
#
sub save2oziwpt {
    my ($self, $ra_data, $filename) = @_;

    # backup the old WPT file
    my $backup_file = "$filename.$$";
    -e $filename and rename $filename, $backup_file;

    # convert to WPT
    if (open (WPT, ">$filename")) {
	local ($\) = "\r\n";   # make newlines as in Windows
	print WPT 'OziExplorer Waypoint File Version 1.1';
	print WPT 'WGS 84';
	print WPT 'Reserved 2';
	print WPT 'magellan';
        foreach (@$ra_data) {
	    my @record = ();
	    push (@record, -1);                                     # 1: wpt number
	    push (@record, $self->wpt_name ($$_{'type'}, $$_{'time'}));    # 2: wpt name
	    push (@record, $$_{'lat'});                             # 3: latitude
	    push (@record, $$_{'lng'});                             # 4: longitude
	    push (@record, '');                                     # 5: date
	    push (@record, $$_{'type'} == 1 ? 10 : 2);              # 6: symbol in GPS
	    push (@record, 1);                                      # 7: status
	    push (@record, 4);                                      # 8: map display format
	    push (@record, 0);                                      # 9: foreground color
	    push (@record, $$_{'type'} == 1 ? 4227327 : 5450740);   # 10: background color
	    push (@record, $$_{'time'});                            # 11: description
	    push (@record, 0);                                      # 12: pointer direction
	    push (@record, 0);                                      # 13: garmin display format
	    push (@record, 0);                                      # 14: proximity distance
	    push (@record, ($$_{'elevation'} or -777));             # 15: altitude
	    push (@record, $$_{'type'} == 1 ? 8 : 6);               # 16: font size
	    push (@record, 0);                                      # 17: font style
	    push (@record, 17);                                     # 18: symbol size
	    print WPT join (', ', @record);
	}
	close WPT;
    }

    # back to the backup file on failure
    -e $filename or rename $backup_file, $filename;
    unlink $backup_file;
}

#
# format waypoint name from the given timestamp $date_time
# 'wpt_type' is 1 for the first waypoint of the day
#
sub wpt_name {
    my ($self, $wpt_type, $date_time) = @_;
    if ($wpt_type == 1) {
	return
	    $MONTHS [substr ($date_time, 5, 2)] . '-' . substr ($date_time, 8, 2)
	    . '/'
	    . substr ($date_time, 11, 5);
    } else {
	# return unchanged
	return substr ($date_time, 11, 5);
    }
}

#
# create a file with OziExplorer waypoints
#
sub convert2oziwpt {
    my ($self, $ra_data) = @_;
    my $ra_mindist = $self->_min_distance ($ra_data);
    return $self->_convert2oziwpt ($ra_mindist);
}
sub _convert2oziwpt {
    my ($self, $ra_data) = @_;
    my $outfile = $self->_get_filename ('-ozi.wpt');
    $self->save2oziwpt ($ra_data, $outfile);
    return $outfile;
}

#
# create a file with more DISTANT points
#
sub min_distance2xml {
    my ($self, $ra_data) = @_;
    my $ra_mindist = $self->_min_distance ($ra_data);
    return $self->_min_distance2xml ($ra_mindist);
}
sub _min_distance2xml {
    my ($self, $ra_data) = @_;
    my $outfile = $self->_get_filename ('-distance.xml');
    $self->save2xml ($ra_data, $outfile);
    return $outfile;
}

#
# add the last record from $ra_from_data to $ra_to_data only if:
#   - there is any record in $ra_from_data, and
#   - the same record is not already in $ra_to_data, and
#   - the new record is "far enough" from the last one in $ra_to_data
#
sub maybe_add_last_record {
    my ($self, $ra_from_data, $ra_to_data) = @_;
    # 'from' array must be non-empty, otherwise there is nothing to copy from
    if (@$ra_from_data > 0) {
	my $last_rec = $$ra_from_data[$#$ra_from_data];
	# if 'to' array is still empty, there is nothing to test
	if (@$ra_to_data == 0) {
	    push (@$ra_to_data, $last_rec);
	    return;
	}
	my $prev_rec = $$ra_to_data[$#$ra_to_data];
	# the last record is already there, nothing to do
	return if $last_rec eq $prev_rec;

	# finally: is the last record far enough from the previous one?
	if (distance ($$prev_rec{'lat'}, $$prev_rec{'lng'},
		      $$last_rec{'lat'}, $$last_rec{'lng'}) > $self->min_distance) {
	    push (@$ra_to_data, $last_rec);
	}
    }
}

#
# convert given $ra_data into XML and save it in a file;
# return the filename;
# do not change existing files if data are empty
#
sub convert2xml {
    my ($self, $ra_data) = @_;
    my $outfile = $self->_get_filename ('-all.xml');
    $self->save2xml ($ra_data, $outfile);
    return $outfile;
}

#
# clean given data $ra_data: remove CSV header, remove records without
# any position, sort by time, remove records that are not in the
# wnated time range, add  key 'type' to each record; return cleaned data
#
# $ra_data is a reference to an array of hashes with the following keys
# (the values are just examples):
#   {
#     'elevation' => '',
#     'lat'       => '78.22259',
#     'time'      => '2006-10-29 16:02:01',
#     'lng'       => '15.65249'
#   },
#
# (the first element in $ra_data contains only headers)
#
sub clean_data {
    my ($self, $ra_data) = @_;

    return unless $ra_data;
    return $ra_data unless (@$ra_data > 1);
    shift @$ra_data;   # skip CSV headers

    # ignore records that do not have position
    # (i.e. where lat="-90.00000" lng="-180.00000")
    my @records =
	grep { $$_{'lat'} !~ /^-90\./ and $$_{'lng'} !~ /^-180\./ }
            @$ra_data;

    # sort by time
    my @sorted =
	grep { $$_{'time'} ge $self->from_date and $$_{'time'} le $self->to_date }
            sort { $$a{'time'} cmp $$b{'time'} } @records;

    # label type of the marker...
    #    type 1 ... the first-in-a-day-points
    #    type 0 ... others
    my $last_time = '0000-00-00';
    foreach (@sorted) {
	my $curr_time = substr ($$_{'time'}, 0, 10);
	if ($curr_time ne $last_time) {
	    $last_time = $curr_time;
	    $$_{'type'} = 1;
	} else {
	    $$_{'type'} = 0;
	}
    }
    return \@sorted;
}

#
# parse data from $filename and extract only wanted fields (columns)
#
sub parse_data {
    my ($self, $filename) = @_;

    my @indeces = split (/\s*,\s*/, $self->input_format);
    my $parser = Text::CSV::Simple->new;

    # field #:    5              6             7         8        9
    # CSV header: Satellite_time Guardian_time Longitude Latitude Altitude
    # XML attr:                  time          lng       lat      elevation
    $parser->want_fields (@indeces);
    $parser->field_map (qw/time lng lat elevation/);
    my @data = $parser->read_file ($filename);
    return \@data;
}

#
# create a file name from existing parameters and from the given
# $suffix; if there is a parameter indicateing result directory but
# this directory does not exist it is created (no error messages if it
# fails, however)
#
sub _get_filename {
    my ($self, $suffix) = @_;

    # make the result directory unless it exists already
    if ($self->result_dir) {
	mkdir $self->result_dir
	    unless -d $self->result_dir;
	return File::Spec->catfile ($self->result_dir,
				    $self->result_basename . $suffix);
    }
    return File::Spec->catfile ($self->result_basename . $suffix);
}

#
# if the input file is defined and it exists, do nothing, just return
# its full name; otherwise use other fields to get data from Guardian,
# put them into a local file and return its full name
#
# die if an error occurs
#
sub fetch_data {
    my $self = shift;

    # input file may be defined
    if ($self->input_data) {
	die "File with input data " . $self->input_data . " does not seem to exists.\n"
	    unless -e $self->input_data;
	return $self->input_data;
    }

    # no input give, let's go to Guardian

    my $ua = LWP::UserAgent->new (agent => 'Mozilla/5.0');

    # --- get login ID (from a user name and password)
    my $response = $ua->post ($self->login_url,
			      { name => $self->user,
				pw   => $self->passwd,
			    });
    $response->is_success or
	die "$self->login_url: ", $response->status_line;
    my $content = $response->content;

    my ($id) = $content =~ /name="id"\s+value="([^"]+)"/; #"
    $id = $self->default_id unless $id;

    # --- get data (using the just received ID)
    my $outfile = $self->_get_filename ('-guardian-raw.csv');
    $response = $ua->post ($self->data_url, {
	id           => $id,
	period       => 'year',
    }, ':content_file' => $outfile);
    $response->is_success or
        die "$self->data_url: ", $response->status_line;

    return $outfile;
}

#
# a convenient method combining fetch_data(), parse_data() and
# clean_data()
#
sub get_data {
    my $self = shift;
    my $datafile = $self->fetch_data;
    return $self->clean_data ($self->parse_data ($datafile));
}

1;
__END__