#!/usr/local/bin/perl
#	Title:	SpaceTrackTk
#	Author:	T. R. Wyant
#	Date:	07-Mar-2005
#	Remarks:
#		This Perl script provides a Perl/Tk interface to the
#		Astro::SpaceTrack package. Command arguments are passed to
#		the instantiated object, so that you can do things like
#		$ perl SpaceTrackTk 'set username me password secret'
#		to initialize your session.

use strict;
use warnings;

use Astro::SpaceTrack;
use Tk;

our $VERSION = '0.019';

my @pad = qw{-padx 5 -pady 5};

my $st = Astro::SpaceTrack->new (@ARGV);

my ($mw, $row, $col);
$row = $col = 0;
my ($user, $pwd, $rslt);


#	Display the splash window if we need to.

$st->get ('banner')->content and banner ();


#	Display the login window unless 'direct' is set (indicating
#	we want to fetch data from redistributors) or we already have
#	enough information for a valid login.

my $direct = $st->get ('direct')->content ? 1 : 0;
unless ($direct || ($rslt = $st->login ()) && $rslt->is_success) {

    $user = $pwd = '';
    $mw = MainWindow->new (-title => 'Log in to Space Track');

    $mw->Label (-text => 'Username:')
	->grid (-row => $row, -column => $col++, -sticky => 'e', @pad);
    $mw->Entry (-relief => 'sunken', -textvariable => \$user)
	->grid (-row => $row, -column => $col++, -sticky => 'w', @pad);
    $row++; $col = 0;
    $mw->Label (-text => 'Password:')
	->grid (-row => $row, -column => $col++, -sticky => 'e', @pad);
    $mw->Entry (-relief => 'sunken', -textvariable => \$pwd, -show => '*')
	->grid (-row => $row, -column => $col++, -sticky => 'w', @pad);
    $row++; $col = 0;
    my $bf = $mw->Frame->grid (-row => $row, -column => 0,
	-columnspan => 2, -sticky => 'ew');
    $bf->Button (-text => 'Log in', -command => sub {
	$rslt = $st->login (direct => 0, username => $user, password => $pwd);
	$rslt->is_success and do {
	    $mw->destroy;
	    return;
	    };
	$mw->messageBox (-icon => 'error', -type => 'RetryCancel',
		-title => 'Login failure', -message => $rslt->status_line)
		eq 'Cancel' and do {
	    $mw->destroy;
	    return;
	    };
	})
	->grid (-row => 0, -column => $col++, @pad);
    $bf->Button (-text => 'Skip login', -command => sub {
	$st->set (direct => 1);
	$mw->destroy;
	})
	->grid (-row => 0, -column => $col++, @pad);

    MainLoop;

    }


#	We are done unless 'direct' is set or we succeeded in
#	logging in to Space Track.

$direct = $st->get ('direct')->content ? 1 : 0;
exit unless $direct || $rslt && $rslt->is_success;


#	The following main window gets used for everything except
#	actual data display.

my ($command, $current, $data, $label, $names, $settings);
$command = $data = $label = '';
$mw = MainWindow->new (-title => 'Retrieve satellite orbital data');


#	Define various widget data.

my %dsdata;	# Detail data.


#	It is possible that our data comes from a file. Define the
#	widget now.

my $dsfile_widget = $mw->Frame;
$dsfile_widget->Entry (-relief => 'sunken', -textvariable => \$dsdata{file})
	->grid (-row => 0, -column => 0, -padx => 5);
$dsfile_widget->Button (-text => 'Find file ...', -command => sub {
	my $file = $mw->getOpenFile (-filetypes => [
		['Text files', '.txt', 'TEXT'],
		['All files', '*'],
		], -initialfile => $dsdata{$command},
		-defaultextension => '.txt');
	$dsdata{file} = $file if $file;
	})->grid (-row => 0, -column => 1, -padx => 5);


#	Define the label and widget for the detail selector. This
#	is normally a drop list, but varies by data source, and can
#	even be undefined. We have to define this first because
#	the data source selector refers to it.

my %dslbl = (
    celestrak => 'Catalog name:',
    spacetrack => 'Catalog name:',
    iridium_status => 'Data source:',
    file => 'Catalog file:',
    spaceflight => 'Retrieve all elements:',
    search_name => 'Name to search for:',
    search_id => 'International Designator(s):',
    search_date => 'Launch date (year-month-day):',
    retrieve => 'Satellite ID(s):',
    );
my %dswdgt = (
    celestrak => $mw->Optionmenu (-options => ($st->names ('celestrak'))[1],
	-variable => \$dsdata{celestrak}),
    spacetrack => $mw->Optionmenu (-options => ($st->names ('spacetrack'))[1],
	-variable => \$dsdata{spacetrack}),
    iridium_status => $mw->Optionmenu (-options => (
	    $st->names ('iridium_status'))[1],
	-variable => \$dsdata{iridium_status}),
    file => $dsfile_widget,
    spaceflight => do {my $frame = $mw->Frame;
		$frame->Checkbutton (-variable => \$dsdata{spaceflight}{all},
		-relief => 'flat')->grid (
		    -row => 0, -column => 0, -sticky => 'w', @pad);
		$frame->Label (-text => 'ISS:')->grid (
		    -row => 0, -column => 1, -sticky => 'e', @pad);
		$frame->Checkbutton (-variable => \$dsdata{spaceflight}{iss},
		    -relief => 'flat')->grid (
		    -row => 0, -column => 2, -sticky => 'w', @pad);
		$frame->Label (-text => 'Shuttle:')->grid (
		    -row => 0, -column => 3, -sticky => 'e', @pad);
		$frame->Checkbutton (-variable => \$dsdata{spaceflight}{sts},
		    -relief => 'flat')->grid (
		    -row => 0, -column => 4, -sticky => 'w', @pad);
		$dsdata{spaceflight}{iss} = $dsdata{spaceflight}{sts} = 1;
		$frame
		},
    search_name => search_options (search_name => 'name'),
##    search_name => $mw->Entry (-relief => 'sunken',
##	-textvariable => \$dsdata{search_name}),
    search_id => $mw->Entry (-relief => 'sunken',
	-textvariable => \$dsdata{search_id}),
    search_date => search_options (search_date => 'date'),
##    search_date => $mw->Entry (-relief => 'sunken',
##	-textvariable => \$dsdata{search_date}),
    retrieve => $mw->Entry (-relief => 'sunken',
	-textvariable => \$dsdata{retrieve}),
    );
my %dsxfrm = (
    search_date => sub {
	my @rslt;
	push @rslt, '-status', $dsdata{search_date}{status};
	my $excl = join ',', grep {$dsdata{search_date}{$_}
	    } qw{debris rocket};
	$excl and push @rslt, '-exclude', $excl;
	push @rslt, $dsdata{search_date}{date};
	@rslt},
    search_name => sub {
	my @rslt;
	push @rslt, '-status', $dsdata{search_name}{status};
	my $excl = join ',', grep {$dsdata{search_name}{$_}
	    } qw{debris rocket};
	$excl and push @rslt, '-exclude', $excl;
	push @rslt, $dsdata{search_name}{name};
	@rslt},
    spaceflight => sub {
	my @rslt;
	push @rslt, '-all' if $dsdata{spaceflight}{all};
	push @rslt, 'iss' if $dsdata{spaceflight}{iss};
	push @rslt, 'shuttle' if $dsdata{spaceflight}{sts};
	@rslt},
    retrieve => sub {(split '\s+', $_[0])},
    );


#	The first drop list in the window selects the data source.
#	Its content depends on whether we are direct-fetching from
#	a redistributor - if so, we omit any option that comes
#	directly from Space Track.

my @mainopts = 
	([  ['Celestrak catalog' => 'celestrak'],
	    ['Space Track catalog' => 'spacetrack'],
	    ['Human Space Flight data' => 'spaceflight'],
	    ['Radio Amateur Satellite Corporation data' => 'amsat'],
	    ['Iridium Status' => 'iridium_status'],
	    ['Local file catalog' => 'file'],
	    ['Space Track name lookup' => 'search_name'],
	    ['Space Track international designator lookup' => 'search_id'],
	    ['Space Track launch date lookup' => 'search_date'],
	    ['Space Track satellite IDs' => 'retrieve'],
	    ],
	 [  ['Celestrak catalog' => 'celestrak'],
	    ['Iridium Status' => 'iridium_status'],
	    ['Human Space Flight data' => 'spaceflight'],
	    ['Radio Amateur Satellite Corporation data' => 'amsat'],
	    ],
	);
$row = $col = 0;
$mw->Label (-text => $direct ? 'Data source:' : 'Object ID source:')
	->grid (-row => $row, -column => $col++, -sticky => 'e', @pad);
my $mainwdgt = $mw->Optionmenu (-options => $mainopts[$direct],
    -variable => \$command, -command => sub {
	$current and $current->gridForget ();	# Drop current detail widget
	$label = $dslbl{$command};		# Change label text to suit
	$current = $dswdgt{$command} or return;	# Get new detail widget.
	$current->grid (-row => 1, -column => 1, -sticky => 'w', @pad);
	},
    )->grid (-row => $row, -column => $col++, -sticky => 'w', @pad);


#	Draw the detail widgets for the currently-selected source.

$row++; $col = 0;
$label = $dslbl{$command};
$mw->Label (-textvariable => \$label)
	->grid (-row => $row, -column => $col++, -sticky => 'e', @pad);
$current = $dswdgt{$command};
$current->grid (-row => $row, -column => $col++, -sticky => 'w', @pad);


#	If we're direct-fetching, turn on common names. Otherwise
#	display the common-names checkbox.

{	# Begin local symbol block.
    $row++;
    my $widgetrow = $row;
    my $label = $mw->Label (-text => 'Include common names:');
    my $check = $mw->Checkbutton (-variable => \$names, -relief => 'flat',
	-command => sub {$st->set (with_name => $names)});
    sub common_names {
	if ($direct) {
	    $label->gridForget;
	    $check->gridForget;
	    }
	  else {
	    $label->grid (-row => $widgetrow, -column => 0,
		-sticky => 'e', @pad);
	    $check->grid (-row => $widgetrow, -column => 1,
		-sticky => 'w', @pad);
	    }
	$names = !!$st->get ('with_name')->content;
	}
    }	# End local symbol block.
$direct or common_names ();


#	Insert the pushbuttons at the bottom of the window.

$row++; $col = 0;
my $bf = $mw->Frame->grid (-row => $row, -column => 0,
    -columnspan => 2, -sticky => 'ew');


#	... Exit

$bf->Button (-text => 'Exit', -command => sub {$mw->destroy})
    ->grid (-row => 0, -column => $col++, -sticky => 'ew', @pad);


#	... View data ...

$bf->Button (-text => 'View data ...', -command => sub {
	my @args = $dsxfrm{$command} ?
		($dsxfrm{$command}->($dsdata{$command})) :
		defined $dsdata{$command} ? ($dsdata{$command}) :
		();
	$rslt = $st->$command (@args);
	if ($rslt->is_success) {
	    my $vw = $mw->Toplevel ();
	    my $tx = $vw->Scrolled ('Text', -relief => 'sunken',
		    -scrollbars => 'oe');
	    $tx->pack (-expand => 1, -fill => 'both');
	    $tx->insert ('0.0', $rslt->content);
	    $vw->title ("$command @args");
	}
	  else {
	    $mw->messageBox (-icon => 'error', -type => 'OK',
		-title => 'Data fetch error', -message => $rslt->status_line);
	    }
	})
	->grid (-row => 0, -column => $col++, -sticky => 'ew', @pad);


#	... Save data ...

$bf->Button (-text => 'Save data ...', -command => sub {
	my $file = $mw->getSaveFile (-filetypes => [
		['Text files', '.txt', 'TEXT'],
		['All files', '*'],
		], -initialfile => $dsdata{$command},
		-defaultextension => '.txt');
	return unless defined $file && $file ne '';
	$rslt = $st->$command ($dsxfrm{$command} ?
		($dsxfrm{$command}->($dsdata{$command})) :
		$dsdata{$command});
	if ($rslt->is_success) {
	    my $fh;
	    $fh = FileHandle->new (">$file")
		and print $fh $rslt->content
		or $mw->messageBox (-icon => 'error', -type => 'OK',
		-title => 'File open error', -message => $!);
	    }
	  else {
	    $mw->messageBox (-icon => 'error', -type => 'OK',
		-title => 'Data fetch error', -message => $rslt->status_line);
	    }
	})
	->grid (-row => 0, -column => $col++, -sticky => 'ew', @pad);

#	... Settings ...

$bf->Button (-text => 'Settings ...', -command => \&settings)
	->grid (-row => 0, -column => $col++, -sticky => 'ew', @pad);

#	... Help ...

$bf->Button (-text => 'Help ...', -command => sub {
		$rslt = $st->help ();
		if ($rslt->is_success && !$st->get ('webcmd')->content) {
		    my $vw = $mw->Toplevel ();
		    my $tx = $vw->Scrolled ('Text', -relief => 'sunken',
			    -scrollbars => 'oe');
		    $tx->pack (-expand => 1, -fill => 'both');
		    $tx->insert ('0.0', $rslt->content);
		    $vw->title ("help");
		    }
		})
	->grid (-row => 0, -column => $col++, -sticky => 'ew', @pad);

MainLoop;

########################################################################

#	Subroutines

#	banner()

#	Display the splash screen and wait for the user to dismiss it.

sub banner {
my $mw = MainWindow->new (-title => 'Front Matter');
my $text = "SpaceTrackTk $VERSION" . $st->banner->content;
$text =~ s/^\s+//s;
$text =~ s/[\s\n]+$//s;
$mw->Label (-text => $text)->pack (-side => 'top', @pad);
$mw->Button (-text => 'OK', -command => sub {$mw->destroy})
    ->pack (-side => 'bottom', @pad);

MainLoop;

1;
}

#	settings ()

#	Display the settings window.

sub settings {
if ($settings && Exists ($settings)) {
    $settings->raise;
    return;
    }
my %authen = map {$_ => 1} qw{direct username password};
my %data = (
    direct => $st->get ('direct')->content,
    iridium_status_format => $st->get ('iridium_status_format')->content,
    max_range => $st->get ('max_range')->content,
    password => $st->get ('password')->content,
    username => $st->get ('username')->content,
    verbose => $st->get ('verbose')->content,
    webcmd => $st->get ('webcmd')->content,
    );
my %old = %data;
$settings = $mw->Toplevel ();
$settings->title ('Settings');

my ($row, $col) = (0, 0);
separator ($settings, $row++, 2, 'Access');

$settings->Label (-text => 'Direct-fetch (no login):')->
    grid (-row => $row, -column => $col++, -sticky => 'e', @pad);
$settings->Checkbutton (-variable => \$data{direct}, -relief => 'flat')->
    grid (-row => $row, -column => $col++, -sticky => 'w', @pad);

$row++; $col = 0;
$settings->Label (-text => 'Username:')->
    grid (-row => $row, -column => $col++, -sticky => 'e', @pad);
$settings->Entry (-relief => 'sunken',
	-textvariable => \$data{username})->
    grid (-row => $row, -column => $col++, -sticky => 'w', @pad);
$row++; $col = 0;

$settings->Label (-text => 'Password:')->
    grid (-row => $row, -column => $col++, -sticky => 'e', @pad);
$settings->Entry (-relief => 'sunken',
	-textvariable => \$data{password}, -show => '*')->
    grid (-row => $row, -column => $col++, -sticky => 'w', @pad);

$row++; $col = 0;
separator ($settings, $row++, 2, 'General settings');

$settings->Label (-text => 'Iridium status format:')->
    grid (-row => $row, -column => $col++, -sticky => 'e', @pad);
$settings->Optionmenu (-options => [qw{kelso mccants}],
    -variable => \$data{iridium_status_format})->
    grid (-row => $row, -column => $col++, -sticky => 'w', @pad);

$row++; $col = 0;
$settings->Label (-text => 'Max range:')->
    grid (-row => $row, -column => $col++, -sticky => 'e', @pad);
$settings->Entry (-relief => 'sunken',
	-textvariable => \$data{max_range})->
    grid (-row => $row, -column => $col++, -sticky => 'w', @pad);

$row++; $col = 0;
$settings->Label (-text => 'Verbose errors:')->
    grid (-row => $row, -column => $col++, -sticky => 'e', @pad);
$settings->Checkbutton (-variable => \$data{verbose}, -relief => 'flat')->
    grid (-row => $row, -column => $col++, -sticky => 'w', @pad);

$row++; $col = 0;
$settings->Label (-text => 'Web command:')->
    grid (-row => $row, -column => $col++, -sticky => 'e', @pad);
$settings->Entry (-relief => 'sunken',
	-textvariable => \$data{webcmd})->
    grid (-row => $row, -column => $col++, -sticky => 'w', @pad);

$row++; $col = 0;
my $bf = $settings->Frame->grid (-row => $row, -column => 0,
    -columnspan => 2, -sticky => 'ew');

$bf->Button (-text => 'Save', -command => sub {
		my $who;
		foreach my $key (keys %data) {
		    next if $data{$key} eq $old{$key};
		    $who ||= $authen{$key};
		    $st->set ($key, $data{$key});
		    }
		if ($who) {
		    $direct = $data{direct} ? 1 : 0;
		    unless ($direct) {
			my $rslt = $st->login;
			$rslt->is_success or do {
			    $mw->messageBox (-icon => 'error', -type => 'OK',
				-title => 'Data fetch error',
				-message => $rslt->status_line);
			    return;
			    };
			}
		    }
		$data{direct} eq $old{direct} or do {
		    $mainwdgt->options ($mainopts[$direct]);
		    common_names ();
		    };
		$settings->destroy;
		})
	->grid (-row => 0, -column => $col++, -sticky => 'ew', @pad);

$bf->Button (-text => 'Cancel', -command => sub {$settings->destroy})
	->grid (-row => 0, -column => $col++, -sticky => 'ew', @pad);

=begin comment

x addendum
x banner
  cookie_expires
- direct
x dump_headers
x filter
- max_range
- password
  session_cookie
- username
- verbose
- webcmd
x with_name

=end comment

=cut

}

sub search_options {
    my ($name, $data) = @_;
    my $frame = $mw->Frame;
    $frame->Entry (-relief => 'sunken',
	-textvariable => \$dsdata{$name}{$data})->grid (
	-row => 0, -column => 0, @pad);
    $frame->Optionmenu (-options => [
	    [All => 'all'],
	    ['On orbit' => 'onorbit'],
	    [Decayed => 'decayed'],
	], -textvariable => \$dsdata{$name}{status})->grid (
	-row => 0, -column => 1, @pad);
    $dsdata{$name}{status} = 'all';
    $frame->Label (-text => ' Exclude:')->grid (
	-row => 0, -column => 2, @pad);
    $frame->Checkbutton (-variable => \$dsdata{$name}{debris},
	-text => 'debris', -relief => 'flat')->grid (
	-row => 0, -column => 3, -sticky => 'w', @pad);
    $frame->Checkbutton (-variable => \$dsdata{$name}{rocket},
	-text => 'rocket', -relief => 'flat')->grid (
	-row => 0, -column => 4, -sticky => 'w', @pad);
    $dsdata{$name}{debris} = $dsdata{$name}{rocket} = 0;
    $frame
}

sub separator {
my ($parent, $row, $span, $text) = @_;
my $pnl = $parent->Frame->grid (-row => $row, -column => 0,
    -columnspan => $span, -sticky => 'ew');
$pnl->Label (-text => $text)->
    grid (-row => 0, -column => 0, -sticky => 'ew');
$pnl;
}

__END__

=head1 NAME

SpaceTrackTk - Perl/Tk application to fetch satellite orbit data.

=head1 SYNOPSIS

This application provides a windowed interface to the Astro::SpaceTrack
module, based on the Perl/Tk windowing system. All you do is issue the
command

 $ SpaceTrackTk

You will be presented with a splash screen, followed by a login window.
In order to get full functionality, you must have a Space Track
account. It is the username and password of this account that you enter
into the login screen.

You have the option to skip the login. This gives you reduced
functionality, since you are limited to the data provided by
redistributers known to Astro::SpaceTrack. The reduced functionality
is apparent in two ways:

* The Space Track sources do not appear in the "Object ID source" drop
list.

* The "Include common names" checkbox does not appear on the retrieval
window, since you get whatever the redistributer provides.

=head1 ENVIRONMENT

If SPACETRACK_OPT sets direct to 1, the login screen is skipped, and
the functionality is as though you skipped the login (i.e. reduced).
Otherwise, if a username and password are available from either
SPACETRACK_USER or SPACETRACK_OPT, you are logged in automatically
and the login screen is skipped.

Please see L<Astro::SpaceTrack> for the details.

=head1 MODIFICATIONS

 (no version) T. R. Wyant
   initial release.
 0.013 24-Nov-2005 T. R. Wyant
   Added version.
   Added support for direct-fetching of data.
   Added ability to skip login.
   Added POD.
 0.014 22-Feb-2006 T. R. Wyant
   Support iridium_status.
 0.015 30-May-2006 T. R. Wyant
   Support spaceflight and amsat.
 0.016 13-Jul-2006 T. R. Wyant
   Support search_date().
 0.017 25-Jul-2006 T. R. Wyant
   Support spaceflight -all, shuttle, iss.
   Don't display data window when query fails.
 0.018 - 08-Sep-2006 T. R. Wyant
   Add settings window and help window.

=head1 ACKNOWLEDGMENTS

The author wishes to thank Dr. T. S. Kelso of
L<http://celestrak.com/> and the staff of L<http://www.space-track.org/>
(whose names are unfortunately unknown to me) for their co-operation,
assistance and encouragement in the development of the Astro::SpaceTrack
module.

=head1 AUTHOR

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

=head1 COPYRIGHT

Copyright 2005, 2006, 2007 by Thomas R. Wyant, III
(F<wyant at cpan dot org>). All rights reserved.

This script is free software; you can use it, redistribute it
and/or modify it under the same terms as Perl itself.

The data obtained by this script is subject to the Space
Track user agreement (L<http://www.space-track.org/perl/user_agreement.pl>).

This software is provided without any warranty of any kind, express or
implied. The author will not be liable for any damages of any sort
relating in any way to this software.

=cut