#!/usr/bin/env perl

package heavens_above_mag;

use 5.010;

use strict;
use warnings;

use Getopt::Long 2.33 qw{ :config auto_version };
use HTML::TreeBuilder;
use List::Util 1.55 qw{ uniqint };
use LWP::UserAgent;
use Pod::Usage;
use YAML 1.25 qw{ Dump Load };

our $VERSION = '0.128_01';

use constant REF_CODE	=> sub {};
use constant VISUAL_URL	=> 'https://celestrak.org/SpaceTrack/query/visual.txt';
use constant VISUAL_YML	=> 'visual.yml';

my %opt = (
    age	=> 86400,	# One day, in seconds
);

unless ( caller ) {	# We're a modulino.
    GetOptions( \%opt,
	qw{ age=i celestrak! open! },
	help => sub { pod2usage( { -verbose => 2 } ) },
    ) or pod2usage( { -verbose => 0 } );

    if ( $opt{celestrak} ) {
	@ARGV and pod2usage( {
		-message	=> 'Arguments forbidden with --celestrak',
		-verbose	=> 0,
	    } );
	process_celestrak();
    } else {
	@ARGV or pod2usage( {
		-message	=> 'Arguments required unless --celestrak specified',
		-verbose	=> 0,
	    } );

	if ( $opt{open} ) {
	    process_open( @ARGV );
	} else {
	    process_perl( @ARGV );
	}
    }
}

# This mess exists because Heavens-Above enclosed multiple table rows in
# a <span>..</span>. This is a standards violation which (e.g.) Firefox
# tolerates, but HTML::TreeBuilder's parse emits such spans as empty
# tags at some indeterminate point in the parse. Unless this is fixed,
# we will have to just hope they continue to honor the Accept-Language
# request header, or that the default language remains English.
sub find_td_by_content {
    my ( $tree, $re ) = @_;

    my $ele = $tree->look_down( _tag => 'td', sub {
	    ( local $_ ) = $_[0]->content_list();
	    defined
		or return $_;
	    return $_ =~ $re;
	} )
	or return;

    my ( $val ) = $ele->content_list();
    $val =~ s/ \A \s+ //smx;
    $val =~ s/ \s+ .* //smx;
    return $val;
}

sub find_span {
    my ( $tree, $id ) = @_;
    my $ele = $tree->look_down( _tag => 'span', id => $id )
	or die "Bug - span id='$id' not found";
    my ( $val ) = $ele->content_list();
    $val =~ s/ \A \s+ //smx;
    $val =~ s/ \s+ \z //smx;
    return $val;
}

sub get_cached {
    my ( $file, $uri ) = @_;

    my $path = "cache/$file";
    -d 'cache'
	or mkdir 'cache'
	or die "Failed to create directory cache/: $!\n";

    {
	my @stat;
	@stat = stat $path
	    and $stat[9] + $opt{age} > time
	    and do {
	    open my $fh, '<:encoding(utf-8)', $path
		or die "Failed to open $path for input: $!\n";
	    local $/ = undef;
	    local $YAML::LoadBlessed = 1;
	    return Load( <$fh> );
	};
    }

    state $ua = LWP::UserAgent->new();
    my $resp = $ua->get( $uri );
    $resp->is_success()
	or die "Failed to fetch $uri: ", $resp->status_line();
    my ( $last_modified ) = $resp->header( 'Last-Modified' );
    my $content = $resp->decoded_content();
    $content =~ s/ \r (?= \n ) //smxg;
    my $data = {
	last_modified	=> $last_modified,
	content		=> $content,
    };
    open my $fh, '>:encoding(utf-8)', $path
	or die "Failed to open $path for output: $!\n";
    print { $fh } Dump( $resp );
    return $resp;
}

sub get_file {
    my ( $fn ) = @_;
    local $/ = undef;
    open my $fh, '<:encoding(utf-8)', $fn
	or die "Unable to open $fn: $!\n";
    my $content = <$fh>;
    close $fh;
    return $content;
}

sub get_html {
    my ( $oid ) = @_;
    my $url = heavens_above_url( $oid );
    my $resp = get_cached( "oid-$oid", $url );
    return $resp->decoded_content();
}

sub heavens_above_url {
    my ( $oid ) = @_;
    $oid =~ m/ \A [0-9]+ \z /smx
	or die "OID '$oid' not numeric\n";
    return sprintf 'https://www.heavens-above.com/SatInfo.aspx?satid=%05d', $oid;
}

sub print_perl {
    my ( $oid, $name, $mag ) = @_;
    if ( defined $mag ) {
	# die "Debug - $oid ($name) '$mag'";
	printf "  '%05d' => %5.1f, # %s\n", $oid, $mag, $name;
    } else {
	printf "# '%05d' => undef, # %s has no recorded magnitude\n", $oid, $name;
    }
    return;
}

sub process_celestrak {
    my $visual = get_cached( VISUAL_YML, VISUAL_URL );
    my ( $last_modified ) = $visual->header( 'Last-Modified' );
    print <<"EOD";
# The following is all the Celestrak visual list that have magnitudes in
# Heavens Above.  These data are generated by the following:
#
#   \$ tools/heavens-above-mag --celestrak
#
# Last-Modified: @{[ $last_modified // 'unknown' ]}

# The following constants are unsupported, and may be modified or
# revoked at any time. They exist to support
# xt/author/magnitude_status.t
use constant _CELESTRAK_VISUAL => @{[ defined $last_modified ?
"'$last_modified'" : 'undef' ]};
use constant _MCCANTS_VSNAMES  => undef;
use constant _MCCANTS_QUICKSAT => undef;

%magnitude_table = (
EOD

    my @arg;
    my $content = $visual->decoded_content();
    open my $fh, '<', \$content;
    local $_ = undef;	# while (<>) ... does not localize $_.
    while ( <$fh> ) {
	push @arg, unpack 'A5';	# NOTE the presence of leading zeroes.

=begin comment

	state $decayed = {
	    15354	=> '2022-01-09',
	};
	if ( my $date = $decayed->{$arg[-1]} ) {
	    my $oid = pop @arg;
	    warn "$oid decaued $date\n";
	}

=end comment

=cut

    }
    @arg = sort { $a <=> $b } uniqint( @arg,
	'53807',	# Bluewalker 3
    );
    close $fh;
    process_perl( @arg );
    say ');';
    return;
}

sub process_get {
    my ( $spec ) = @_;
    my @rslt;
    process_parse(
	sub {
	    push @rslt, [ @_ ];
	    return;
	},
	$spec,
    );
    return @rslt;
}

sub process_open {
    my @arg = @_;
    require Browser::Open;
    my $cmd = Browser::Open::open_browser_cmd();
    foreach my $oid ( @arg ) {
	my $url = heavens_above_url( $oid );
	system { $cmd } $cmd, $url;
    }
    return;
}

sub process_parse {
    my ( $handler, @arg ) = @_;
    foreach my $spec ( @arg ) {
	my $get = $spec =~ m/ \A [0-9]+ \z /smx ? \&get_html : \&get_file;
	my $tree = HTML::TreeBuilder->new_from_content( $get->( $spec ) );
	# print $tree->as_HTML();
	# Should return a <span>..</span> containing the OID
	my $oid = find_span( $tree, 'ctl00_cph1_lblSatID' );
	# Should return a <span>..</span> containing the name
	my $name = find_span( $tree, 'ctl00_cph1_lblOIGName' );
	# We would like to look for id ctl00_cph1_lblBrightness here, but it
	# contains table rows (which it should not), so HTML::TreeBuilder
	# spits it out any old where. Sometimes before the table, sometimes
	# in the middle of it (but still empty). So we just have to hope the
	# default display is English.
	my $mag = find_td_by_content(
	    $tree, qr< \b at \s+ 1000 \s* km \s+ distance \b >smxi );
	$handler->( $oid, $name, $mag );
    }
    return;
}

sub process_perl {
    my ( @arg ) = @_;
    process_parse( \&print_perl, @arg );
    return;
}

1;

__END__

=head1 TITLE

heavens-above-mag - Get magnitudes from Heavens Above

=head1 SYNOPSIS

 heavens-above-mag 25544
 heavens-above-mag --help
 heavens-above-mag --version

=head1 OPTIONS

=head2 --age

 --age 43200

This option specifies the maximum age of the cache, in seconds. Setting
C<--age=0> disables the cache.

The default is C<--age=86400>, i.e. one day.

=head2 --celestrak

If this Boolean option is asserted, the OIDs come from Celestrak's
F<visual.txt> file, and the output is the canned magnitude table in
L<Astro::Coord::ECI::TLE|Astro::Coord::ECI::TLE>. If this option is
asserted, no non-option arguments may be specified, and
L<--open|/--open> is ignored.

The default is C<--no-celestrak>.

=head2 --help

This option displays the documentation for this script. The script then
exits.

=head2 --open

If this Boolean option is asserted, a web browser is spawned, displaying
the Heavens-Above web page of the OIDs specified. You cannot specify
file names if you specify this option.

=head2 --version

This option displays the version of this script. The script then exits.

=head1 DETAILS

This Perl script parses intrinsic magnitude data out of Heavens Above
data. You can specify either an OID (which is fetched) or a file name
(which is read) or a mixture of the two.

Heavens Above defines intrinsic magnitude as the magnitude at a range of
1000km, and 50% illuminated.

All web I/O goes through a cache in top-level project directory
F<cache/>. Data will come from the cache rather than the web if the file
in the cache is newer than the value of the L<--age|/--age> option. The
cache directory will be created if necessary.

=head1 AUTHOR

Thomas R. Wyant, III F<wyant at cpan dot org>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2021-2023 by Thomas R. Wyant, III

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl 5.10.0. For more details, see the Artistic
License 1.0 at
L<https://www.perlfoundation.org/artistic-license-10.html>, and/or the
Gnu GPL at L<http://www.gnu.org/licenses/old-licenses/gpl-1.0.txt>.

This program is distributed in the hope that it will be useful, but
without any warranty; without even the implied warranty of
merchantability or fitness for a particular purpose.

=cut

# ex: set textwidth=72 :
