Astro-SpaceTrack

 view release on metacpan or  search on metacpan

eg/SpaceTrackTk  view on Meta::CPAN

#!/usr/local/bin/perl

use 5.006002;

use strict;
use warnings;

use Astro::SpaceTrack qw{ :ref };
use IO::File;
use Tk;
use Tk::Pane;

our $VERSION = '0.182';

my @pad = qw{ -padx 5 -pady 5 };	# Standard cell padding

# Instantiate the Space Track accesor class.
my $st = Astro::SpaceTrack->new( @ARGV );

# Display the banner text if desired.
banner();

# Display the main window.
main_window();


# Display the banner text if desired, and wait for the user to dismiss
# it.
sub banner {

    $st->getv( 'banner' ) or return;

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

    MainLoop();

    return 1;
}

sub grid_args {
    my ( $hash, %arg ) = @_;
    my %merged = %{ $hash };
    foreach my $key ( keys %arg ) {
	$merged{$key} = $arg{$key};
    }
    my @rslt;
    while ( my ( $key, $val ) = each %merged ) {
	push @rslt, "-$key", $val;
    }
    exists $hash->{column}
	and $hash->{column} += ( $merged{columnspan} || 1 );
    return @rslt;
}

sub grid_new {
    my ( $row ) = @_;
    defined $row or $row = 0;
    return { row => $row, column => 0, padx => 5, pady => 5 };
}

sub grid_next_row {
    my ( $hash, $row ) = @_;
    if ( defined $row ) {
	$hash->{row} = $row;
    } else {
	$hash->{row}++;
    }
    $hash->{column} = 0;
    return;
}

# Main window
sub main_window {

    my %data;	# Data
    my %widget;	# Widget references

    $widget{main_window} = MainWindow->new(
	-title => 'Retrieve satellite orbital data' );

    # Set up the data frame.
    my $df = $widget{data_frame} = $widget{main_window}->Frame->pack(
	-side => 'top', @pad );

    # Create the data source label and widget, but don't put them in the
    # data frame yet.
    $widget{data_source_label} = $df->Label( -text => 'Data source:' );
    $widget{data_source_widget} = $df->Optionmenu(
	-variable => \$data{data_source},
	-command => sub { load_data_frame( \%widget, \%data ) },
    );
    load_data_source_widget( \%widget );

    # Set up the pushbuttons

    my @buttons;
    $widget{main_buttons} = \@buttons;

    my $bf = $widget{main_window}->Frame->pack(
	-side => 'bottom', @pad );
    my $bg = grid_new();

    push @buttons, $bf->Button(
	-text => 'Exit',
	-command => sub {
	    $widget{main_window}->destroy()
	}
    )->grid( grid_args( $bg ) );

    push @buttons, $bf->Button(
	-text => 'View data ...',

eg/SpaceTrackTk  view on Meta::CPAN

		},
		variable => '-variable',
	    },
	    Entry => {
		default => {
		    -relief => 'sunken',
		},
	    },
	);
    }

    my $settings;

    sub settings {
	my ( $widget, $data ) = @_;

	$settings and Exists( $settings ) and do {
	    $settings->raise();
	    return;
	};

	my %current = map { $_ => $st->getv( $_ ) } qw{ 
	    max_range password username identity verbose verify_hostname
	    webcmd
	};
	my %old = %current;

	$settings = $widget->{main_window}->Toplevel(
	    -title => 'Settings' );

	my $sg = grid_new();

	foreach (
	    'Access',
	    [ username => 'User Name:' ],
	    [ password => 'Password:', Entry => -show => '*' ],
	    [ identity => 'Identity from file:', 'Checkbutton' ],
	    'General',
	    [ max_range => 'Maximum range:' ],
	    [ verbose => 'Verbose Errors:', 'Checkbutton' ],
	    [ verify_hostname => 'Verify Host Name:', 'Checkbutton' ],
	    [ webcmd => 'Web Command:' ],
	) {
	    if ( ARRAY_REF eq ref $_ ) {
		my ( $name, $label, $entry, %args ) = @{ $_ };
		defined $entry or $entry = 'Entry';
		if ( $info{$entry}{default} ) {
		    while(  my ( $key, $val ) = each %{
			    $info{$entry}{default} } ) {
			exists $args{$key}
			    or $args{$key} = $val;
		    }
		}
		my $variable = $info{$entry}{variable} || '-textvariable';
		$settings->Label( -text => $label )->grid(
		    grid_args( $sg, sticky => 'e' ));
		$settings->$entry( %args, $variable => \$current{$name} )->grid(
		    grid_args( $sg, sticky => 'w' ) );
	    } else {
		$settings->Label( -text => $_ )->grid(
		    grid_args( $sg, columnspan => 2, sticky => 'ew' ) );
	    }

	    grid_next_row( $sg );
	}

	my $bf = $settings->Frame()->grid(
	    grid_args( $sg, columnspan => 2, sticky => 'ew' ) );
	my $bg = grid_new();

	$bf->Button( -text => 'Save', -command => sub {
		my $re_login;
		foreach my $key ( keys %current ) {
		    no warnings qw{ uninitialized };
		    $current{$key} eq $old{$key} and next;
		    if ( $key eq 'identity' ) {
			if ( $current{$key} ) {
			    $re_login = 1;
			} else {
			    $st->set( username => '', password => '' );
			    $st->logout();
			}
		    } else {
			$re_login ||= $authen{$key};
		    }
		    $st->set( $key => $current{$key} );
		}
		if ( $re_login ) {
		    my $rslt = $st->login();
		    $rslt->is_success() or do {
			$widget->{main_window}->messageBox(
			    -icon => 'error', -type => 'OK',
			    -title => 'Login failure',
			    -message => $rslt->status_line
			);
			return;
		    };
		    load_data_source_widget( $widget );
		    load_data_frame( $widget, $data );
		}
		$settings->destroy();
	    } )->grid( grid_args( $bg ) );

	$bf->Button( -text => 'Cancel', -command => sub {
		$settings->destroy();
		return;
	    } )->grid( grid_args( $bg ) );

	return;
    }
}

sub amsat_panel {
    my ( $widget, $data ) = @_;

    my $dg = grid_new( 1 );

    include_common_names( $widget, $data, $dg );

    return;
}

sub box_score_panel {
##  my ( $widget, $data ) = @_;		# Arguments unused
    return;
}

# Adjust the data panel to request Celestrak data.

eg/SpaceTrackTk  view on Meta::CPAN

	# whether we think we have a valid Space Track login cookie.
	$widget->{data_source_widget}->options( $options[
		$st->_check_cookie_generic( 2 ) ? 0 : 1
	    ]
	);
	return;
    }

}

# Retrieve the desired data.
sub retrieve {
    my ( $widget, $data ) = @_;
    my $source = $data->{data_source};
    my @args;
    if ( my $handler = __PACKAGE__->can( $source . '_args' ) ) {
	@args = $handler->( $data );
    } elsif ( defined $data->{$source} ) {
	@args = $data->{$source};
    }
#   warn "Debug - \$st->$source( ", join( ', ', map { "'$_'" } @args ), ' )';
#   use JSON;
#   warn "Debug - \$data is ", to_json( $data, { pretty => 1 } ), ' ';
    my ( $error );
    if ( my $rslt = eval {
	    local $SIG{__WARN__} = sub {
		( my $msg = $_[0] ) =~
		    s/ \S+ \s+ \S* SpaceTrackTk .* //smx;
		$msg =~ s/ \s+ / /smxg;
		$widget->{main_window}->messageBox( -icon => 'warning',
		    -type => 'OK', -title => 'Data fetch warning',
		    -message => $msg,
		);
	    };
	    $st->$source( @args );
	} ) {
	$rslt->is_success()
	    and return ( $rslt->content(), $source, @args );
	$error = $rslt->status_line();
    } else {
	$error = $@ || 'An unknown error occurred';
    }
    $widget->{main_window}->messageBox( -icon => 'error', -type => 'OK',
	-title => 'Data fetch error',
	-message => $error,
    );
    return;
}

{

    my %tabbed;

    BEGIN {

	%tabbed = (
	    box_score => sub {
		my ( $hash ) = @_;
		if ( $hash->{row} == 0 && $hash->{column} > 0 &&
		    $hash->{column} < 9 ) {
		    return grid_args( $hash, columnspan => 4 );
		} else {
		    return grid_args( $hash );
		}
	    },
	    search => \&grid_args,
	);
    }

    sub view_window {
	my ( $widget, $title, $content ) = @_;

	my $vw = $widget->{main_window}->Toplevel(
	    -title => $title,
	    -borderwidth => 8,
	);

	if ( my $grid_args = $tabbed{ $st->content_type() } ) {

	    my $vf = $vw->Scrolled(
		Frame => -scrollbars => 'osoe',
		-width => 600, -height => 400,
	    )->pack( -expand => 1, -fill => 'both' );

	    my $vg = {
		row => 0, column => 0,
		sticky => 'nsew',
		ipadx => 2, ipady => 2,
	    };

	    my @lo = (
		-relief => 'sunken',
		-justify => 'left',
		-wraplength => '20m',
	    );

	    my $loc = 0;
	    while ( $content =~ m/ ( \t | \r \n? | \n ) /smxg ) {
		$vf->Label(
		    -text => substr( $content, $loc, $-[0] - $loc ),
		    @lo,
		)->grid( $grid_args->( $vg ) );
		$loc = $+[0];
		"\t" eq $1 or grid_next_row( $vg );
	    }

	    $loc < length $content
		and $vf->Label(
		    -text => substr( $content, $loc ),
		    @lo,
		)->grid( $grid_args->( $vg ) );

	} else {

	    my $tx = $vw->Scrolled( 'Text',
		-relief => 'sunken',
		-scrollbars => 'oe',
	    )->pack( -expand => 1, -fill => 'both' );
	    $tx->insert( '0.0', $content );

	}