#!/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