use 5.34.0;
use Feature::Compat::Class;
#==============================================================================
class GeoStream; # see __DATA__ for DB schema
#==============================================================================
# --- Switch Windows console to UTF-8 ---
if ($^O eq 'MSWin32') {
eval {
require Win32::Console;
Win32::Console::OutputCP(65001);
1;
} or warn "⚠ Could not set Windows console to UTF-8: $@";
}
use lib '.';
use NearestTown; # custom module for nearest town lookup (uses cities1000.txt)
use Encode;
use IO::All;
use JSON::PP;
use IO::Handle;
use URI::Escape;
use DBIx::Simple;
use Data::Printer;
use LWP::UserAgent;
use Math::Trig qw/deg2rad/;
use DateTime::Format::Strptime;
use Term::ANSIColor qw/ color RESET :constants :constants256 /;
field $sim_start_time :reader; # writer = set_sim_start_time()
field $deduct_time :reader :param = 0; # time in seconds to deduct from log timestamps
field $simulation :reader :param = 0; # if set, will simulate real-time delays based on log timestamps
field $test_output :reader :param = 0; # if set will output all lines of log.txt
field $sql_trace :reader :param = 0; # if set will output queries
field $dbix = DBIx::Simple->connect( 'dbi:SQLite:dbname=locations.db' );
field $t0; # if simulating real-time delays
ADJUST {
$dbix->dbh->trace('SQL|'.$sql_trace); # say $sql_trace;
# say "simulation: $simulation"; say "deduct_time: $deduct_time";
$t0 = time - $deduct_time; # say "t0: $t0";
}
my $json = JSON::PP->new->utf8;
my $ua = LWP::UserAgent->new( timeout => 10 );
my $osm_url = 'https://nominatim.openstreetmap.org/reverse?format=jsonv2&lat=%s&lon=%s';
my @offsets = ([0.5,0.5],[0.25,0.25],[0.75,0.25],[0.25,0.75],[0.75,0.75]); # offsets to try if no data found
my $nearest_town_finder = NearestTown->new();
my %locations_cache; # cache of lat/lon => location strings
method decode_line ($line) { say $line if $test_output;
# must have simulation start time set before 1st I/SCN line:
$sim_start_time || $self->set_sim_start_time($line);
my $data = $self->parse_log_line($line) || return; # p $data; # aref
my ($timestamp, $ms, $dir_name, $lat, $lon, $tris) = @$data; # p $data;
my ($h,$m,$s) = split /:/, $timestamp;
my $secs = $h * 3600 + $m * 60 + $s; # say "$timestamp: $secs";
if ($simulation) { # if simulating real-time delays
# determine how long to sleep, to match log file timestamps
my $target_time = $t0 + $secs; # warn $target;
while (time < $target_time) {
my $remaining = $target_time - time;
say STDERR FAINT YELLOW, " waiting $remaining seconds ...",
RESET;
sleep 1;
}
}
{ # output DSF file name, load time & triangles info
my $load_time = $ms > 1_100_000
? sprintf '%.1f sec', $ms / 1_000_000
: sprintf '%s ms', int $ms / 1_000;
my $str = sprintf "%s [%s, %d triangles]",
$dir_name, $load_time, $tris;
say STDERR MAGENTA $str, RESET;
}
# formatted lat-lon string (e.g. N70 E18):
my $lat_lon_str = $self->format_lat_lon($lat, $lon); # say "Lat/Lon: $lat_lon_str";
# calculate adjusted time string (start time + seconds from log line)
my $hms = $sim_start_time->clone->add(seconds => $secs)
->strftime('%H:%M:%S'); # warn "time: $hms";
# prepare result message
my %res = ( message => sprintf ' %s (+%s) ', $hms, $timestamp );
# unique id for this lat/lon (no spaces)
my $id = $lat_lon_str =~ s/\s+//r; # say $id; # e.g. N70E18
{ # get location data from cache or lookup
my $tile = Tile->new( # Tile class defined below
id => $id,
lat => $lat,
lon => $lon,
lat_lon_str => $lat_lon_str,
res => \%res,
);
$self->get_location($tile);
}
{ # output result
my $dimensions = $self->tile_dimensions($lat);
$res{message} .= sprintf '%s :: Tile area: %s [H-%s x W-%s] km^2 ',
$lat_lon_str, map int $_, @{$dimensions}{qw/area height width/};
say color($res{colour}), $res{message}, RESET,
' :: ', CYAN, $locations_cache{$id}{data}, RESET;
}
# log co-ordinates if message = 'no data'
if ( $locations_cache{$id}{data} =~ /no data/i ) {
$self->log( join ' :: ', $lat_lon_str, $locations_cache{$id}{data} );
}
# method return value not required
}
method get_location ($tile) {
my $id = $tile->id;
my $lat = $tile->lat;
my $lon = $tile->lon;
my $lat_lon_str = $tile->lat_lon_str;
my $res = $tile->res;
# need to cache location so not duplicating openstreetmap lookups
if ( $locations_cache{$id} ) { # p $locations_cache{$id};
# $res->{message} .= ' loading from cache '; # not needed
$res->{colour} = 'ITALIC FAINT YELLOW';
# say STDERR ITALIC FAINT YELLOW
# "[$timestamp] loading from cache for $lat / $lon", RESET;
}
=begin # using nearest town finder instead of openstreetmap
# try database lookup next
elsif ( my $location = $self->db_lookup($lat, $lon) ) {
$locations_cache{$id}{data} = $location;
$res->{message} .= ' loading from database ';
$res->{colour} = 'ITALIC FAINT GREEN';
# say STDERR ITALIC GREEN
# "[$timestamp] loading from database for $lat / $lon", RESET;
}
# else fetch from openstreetmap
else {
$res->{message} .= ' fetching new location ';
$res->{colour} = 'ITALIC BLUE';
# say STDERR ITALIC FAINT BLUE
# "[$timestamp] fetching new location for $lat / $lon", RESET;
OFFSET: # try up to 5 times to get data, offset by 0.25-degree increments
for my $o (@offsets) {
my $offset_lat = $lat + $o->[0];
my $offset_lon = $lon + $o->[1];
my $url = sprintf( $osm_url, $offset_lat, $offset_lon );
my $res = $ua->get($url, 'User-Agent' => 'GeoStream/1.0');
if ($res->is_success) {
my $data = eval { $json->decode($res->content) }; # p $data; next;
# warn "no data for $offset_lat / $offset_lon, trying next" and
next OFFSET if $data->{error};
# say $dir_name;
if ( my $addr = $data->{address} ) {
my $location = $self->format_address($lat, $lon, $addr);
$locations_cache{$id}{data} = $location;
last OFFSET;
}
}
else {
warn "HTTP error: " . $res->status_line . "\n";
}
}
}
=cut
else { # fetch from nearest_town module
# $res->{message} .= ' fetching from file '; # not needed
$res->{colour} = 'ITALIC FAINT BLUE';
if ( my $location = $nearest_town_finder->nearest_town($lat ,$lon) ) {
$locations_cache{$id}{data} = $location;
}
}
# if still no data, set to 'No data'
$locations_cache{$id}{data} ||= '[No data, likely ocean tile]';
}
method format_lat_lon ($lat, $lon) {
my $lat_dir = $lat >= 0 ? 'N' : 'S';
my $lon_dir = $lon >= 0 ? 'E' : 'W';
my $formatted = sprintf "%s%s %s%s",
abs($lat), $lat_dir, abs($lon), $lon_dir;
return $formatted; # N70 E18
}
# not currently used
method format_time ($t) {
my ($h, $m, $s) = split /:/, $t;
my @parts;
push @parts, "$h hour" . ($h == 1 ? '' : 's') if $h;
push @parts, "$m min" . ($m == 1 ? '' : 's') if $m;
push @parts, "$s sec" . ($s == 1 ? '' : 's') if $s;
return join ' ', @parts;
}
method set_sim_start_time ($line) {
if ( my ($timestr) = $line =~ m/X-Plane Started on (.*)/i ) {
my $strp = DateTime::Format::Strptime->new(
pattern => '%a %b %d %H:%M:%S %Y',
time_zone => 'local',
);
$sim_start_time = $strp->parse_datetime($timestr);
say 'Simulation startup time: ' . $sim_start_time->strftime('%H:%M:%S');
}
}
method format_address ($lat, $lon, $addr) {
# Step 1: Pick first meaningful locality (city, town, village, municipality)
my @first_candidates = qw(city city_district town village municipality);
my ($first) = grep { $self->clean_address($_) }
map { $addr->{$_} } @first_candidates;
# Step 2: Pick the most useful middle field, not repeating first
my @middle_candidates = qw(state county region state_district province);
my ($middle) = grep { $self->clean_address($_) && $_ ne $first }
map { $addr->{$_} } @middle_candidates;
# Step 3: Always pick country
my $country = $self->clean_address($addr->{country});
# Build final parts from non-empty components
my @parts = grep { defined $_ } ($first, $middle, $country);
# Join non-empty parts with comma
my $formatted = join ', ', @parts;
# log if any components missing
if ( @parts < 3 ) {
my $lat_lon_str = $self->format_lat_lon($lat, $lon);
$self->log( join ' :: ', $lat_lon_str, $formatted );
say STDERR YELLOW " [Warning] Incomplete address: $formatted", RESET;
}
# store in database if not already present
else { # using unique key on lat/lon to avoid duplicates
my $sql = q!INSERT OR IGNORE INTO locations (lat, lon, name)
VALUES (??)!; # convert to numbers to avoid leading zero issues
$dbix->query( $sql, $lat + 0, $lon + 0, $formatted );
}
return $formatted;
}
method log ($msg) {
my $io = io('geo_stream_warnings.log');
my @lines = $io->chomp->slurp; # p @lines;
return if grep { $msg eq $_ } @lines;
$io->appendln($msg);
}
# ignore 'unknown' or undefined place names
method clean_address ($place) {
defined $place && $place !~ /^unknown$/i ? $place : ();
}
method parse_log_line {
#0:57:32.110 I/SCN: DSF load time: 5710065 for file D:\XP Map Enhacement\Base packages\XPME_Europe/Earth nav data/+50+000/+53+007.dsf (608040 tris, 134 skipped for -23.8 m^2)
my $line = shift;
if ( $line =~ m{
(\d+:\d+:\d+) # [1] timestamp (e.g. 0:57:32)
\.\d+ # fractional seconds (ignored)
\s+I\/SCN:\s+ # literal " I/SCN: " with spacing
DSF\ load\ time:\s+ # literal "DSF load time:"
(\d+).* # [2] load time in microseconds
[/\\]([^/\\]+) # [3] dir_name (after last / or \)
/Earth\ nav\ data/ # folder
[+-]\d+[+-]\d+/ # folder with lat/lon
([+-]\d+) # [4] latitude
([+-]\d+) # [5] longitude
\.dsf # file extension
\s+\( # opening parenthesis
(\d+) # [6] triangle count
\s+tris,\s+\d+\s+skipped\s+for\s+
(-?[\d\.]+)\s+m\^2\) # [7] area value of skipped triangles (can be negative)
}x ) {
my ($time, $ms, $dir_name, $lat, $lon, $tris) = ($1, $2, $3, $4, $5, $6);
# say join ' :: ', $time, $ms, $dir_name, $lat, $lon, $tris;
return [ $time, $ms, $dir_name, $lat, $lon, $tris ];
}
return undef;
}
method tile_dimensions {
my $lat = shift;
my $height = 111.32; # km per degree latitude
my $width = 111.32 * cos(deg2rad($lat));
my $area = $width * $height;
return { width => $width, height => $height, area => $area };
}
method db_lookup ($lat, $lon) {
my %h = ( lat => int $lat, lon => int $lon ); # convert to integers eg +53
$dbix->select('locations', 'name', \%h )->into(my $location);
$location = decode('utf8', $location) unless Encode::is_utf8($location);
# say 'is_utf8: ' . ( Encode::is_utf8($location) || 'not utf8 encoded' );
return $location;
}
method get_sql_trace_level { $sql_trace }
#==============================================================================
class Tile;
#==============================================================================
use Feature::Compat::Class;
field $id :param :reader;
field $lat :param :reader;
field $lon :param :reader;
field $res :param :reader;
field $lat_lon_str :param :reader
1;
__DATA__
PRAGMA encoding = "UTF-8"
CREATE TABLE locations (
id INTEGER PRIMARY KEY AUTOINCREMENT,
lat TEXT,
lon TEXT,
name TEXT
);
CREATE UNIQUE INDEX lat_lon ON locations(lat, lon);
