microReticulumTbeam/exercises/22_compass/scripts/fetch_declination.pl

#!/usr/bin/env perl

use strict;
use warnings;

use HTTP::Tiny;
use POSIX qw(strftime);
use Text::ParseWords qw(parse_line);
use URI::Escape qw(uri_escape);

my ($lat, $lon, $outfile, $iso_date) = @ARGV;

die usage() unless defined $lat && defined $lon;

$outfile  ||= "declination.txt";
$iso_date ||= strftime("%Y-%m-%d", gmtime());

die "Latitude must be numeric\n"  unless $lat =~ /\A-?\d+(?:\.\d+)?\z/;
die "Longitude must be numeric\n" unless $lon =~ /\A-?\d+(?:\.\d+)?\z/;
die "Latitude out of range\n"     unless $lat >= -90 && $lat <= 90;
die "Longitude out of range\n"    unless $lon >= -180 && $lon <= 180;
die "Date must be YYYY-MM-DD\n"   unless $iso_date =~ /\A(\d{4})-(\d{2})-(\d{2})\z/;

my ($year, $month, $day) = ($1, $2, $3);

my $base_url = "https://www.ngdc.noaa.gov/geomag-web/calculators/calculateDeclination";
my %query = (
    lat1         => $lat,
    lon1         => $lon,
    model        => "WMM",
    startYear    => $year,
    startMonth   => $month + 0,
    startDay     => $day + 0,
    resultFormat => "csv",
);

my $url = $base_url . "?" . join("&",
    map { uri_escape($_) . "=" . uri_escape($query{$_}) } sort keys %query
);

my $http = HTTP::Tiny->new(
    agent      => "microReticulum-ex22-declination-fetch/1.0",
    timeout    => 30,
    verify_SSL => 1,
);

my $res = $http->get($url);
die "HTTP request failed: $res->{status} $res->{reason}\n" unless $res->{success};

my $body = $res->{content};
my $declination = extract_declination_from_csv($body);
$declination = extract_declination_from_text($body) unless defined $declination;

die "Unable to parse declination from NOAA response\n" unless defined $declination;

my $procured = format_procured_date($year, $month, $day);
open my $fh, ">", $outfile or die "Cannot write $outfile: $!\n";
print {$fh} "# procured: $procured\n";
print {$fh} "# for coordinates: $lat, $lon\n";
print {$fh} "# source: NOAA/NCEI geomagnetic declination calculator\n";
print {$fh} "# date: $iso_date\n";
print {$fh} "# sign convention: east positive, west negative\n";
printf {$fh} "declination_deg=%.6f\n", $declination;
close $fh or die "Cannot close $outfile: $!\n";

print "Wrote $outfile\n";
printf "declination_deg=%.6f\n", $declination;

sub extract_declination_from_csv {
    my ($text) = @_;
    my @lines = grep { /\S/ } split /\r?\n/, $text;
    return undef unless @lines >= 2;

    my @header = parse_line(",", 0, $lines[0] // "");
    my $decl_idx;
    for my $i (0 .. $#header) {
        next unless defined $header[$i];
        if ($header[$i] =~ /\Adeclination\z/i) {
            $decl_idx = $i;
            last;
        }
    }
    return undef unless defined $decl_idx;

    for my $line (@lines[1 .. $#lines]) {
        my @fields = parse_line(",", 0, $line);
        next unless defined $fields[$decl_idx];
        my $value = $fields[$decl_idx];
        $value =~ s/^\s+|\s+$//g;
        $value =~ s/[^\d+.\-]//g;
        return $value + 0 if $value =~ /\A[+-]?\d+(?:\.\d+)?\z/;
    }

    return undef;
}

sub extract_declination_from_text {
    my ($text) = @_;
    return $1 + 0 if $text =~ /declination[^-+0-9]*([+-]?\d+(?:\.\d+)?)/i;
    return undef;
}

sub format_procured_date {
    my ($y, $m, $d) = @_;
    my @month_names = qw(
        January February March April May June
        July August September October November December
    );
    my $name = $month_names[$m - 1] // die "Invalid month\n";
    return sprintf("%s %d, %04d", $name, $d, $y);
}

sub usage {
    return <<"USAGE";
Usage:
  fetch_declination.pl <latitude> <longitude> [outfile] [YYYY-MM-DD]

Example:
  fetch_declination.pl 44.93642012667761 -123.02203699545396 declination.txt 2026-04-16
USAGE
}