#!/usr/bin/perl

use strict;
use warnings;
use URI::URL;
use LWP::Simple qw/get/;
use Tk;
use Tk::DialogBox;
use Tk::Photo;
use Tk::JPEG;

my $TOP = "http://antwrp.gsfc.nasa.gov/apod/";
my $IMGPATH = 'image/\d{4}/\w+.(gif|jpg|jpeg)';
my @timearray = gmtime();
#my $time = sprintf "%02d%02d%04d", ($timearray[4]+1), ($timearray[3]), ($timearray[5]+1900);
my $time = sprintf "%04d%02d%02d",  ($timearray[5]+1900),($timearray[4]+1), ($timearray[3]);
my $titledate=sprintf "%02d-%-02d-%04d", ($timearray[4]+1), ($timearray[3]), ($timearray[5]+1900);

my $content = get $TOP or die "Cannot get APOD Page\n";
my ($imgurl) = $content =~ m!($IMGPATH)!i;
$imgurl = url($imgurl,$TOP)->abs;

print "Acquiring Image File ....\n";
my $picture = get $imgurl or die "Cannot grab image: $!\n";

my $ext=$2;

my $fmt="jpeg";
if ($ext =~ m/(gif)/ig){$fmt="gif";}

my $imgfile="apod$time\.$ext";
print "Saving as $imgfile . \n";
open(OUT, ">$imgfile") or die "Cannot write to file: $!\n";
binmode(OUT);
print OUT $picture;
close OUT;


my $MW=MainWindow->new(-title=>"Astronomy Pic of The Day $titledate");


### --- Prevents Main Window Resizing
$MW->bind('<Configure>' => sub{
        my $xe = $MW->XEvent;
        $MW->maxsize($xe->w, $xe->h);
        $MW->minsize($xe->w, $xe->h);
});


print "generating Tk Window ....\n";
# my $image = $MW->Photo('-format' => 'jpeg', -file=>'apod08222003.jpg');
#my $image = $MW->Photo('-format' => 'jpeg', -file=>$imgfile);
my $image = $MW->Photo('-format' => $fmt, -file=>$imgfile);
$MW->Button(-image=>$image,
	    -command => sub
	     { 
		my $dialogA = $MW->DialogBox( -title   => "About This Image",
                                              -buttons => [ "OK" ],
                                );

    		$dialogA->add("Label",
				
				-borderwidth => '2',
				-background => "#FAEBD7", #ANTIQUE WHITE
                                -font => 'bold',
			        -justify => 'left',
				-relief => 'sunken',
                                -text => "This Image is Produced by: NASA GSFC,\n and can be found along with other Astronomy Related Images here:\nhttp://antwrp.gsfc.nasa.gov/apod/astropix.html")->pack;

### --- Prevents Dialog Box Resizing
$dialogA->bind('<Configure>' => sub{
        my $xeD = $dialogA->XEvent;
        $dialogA->maxsize($xeD->w, $xeD->h);
        $dialogA->minsize($xeD->w, $xeD->h);
});
    		$dialogA->Show;
}
 )->pack;



MainLoop();

## Original Astronomy POD code by OverlordQ 08/22/2003
## http://www.perlmonks.org/index.pl?node_id=285690
## Additional Perl/Tk code by: PERLscienceman 08/24/2003
## Code by PERLscienceman updated 08/26/2003 to compensate for capture of .gif
## http://www.perlmonks.org/index.pl?node_id=243154