#!/usr/local/bin/perl -wT

use strict;

use FileHandle;
use File::Copy;
use File::Basename;
use Image::Magick;

#----------------------------------------------------------------------
# Configuration variables

# Directory where temporary files are created
use constant WORK_DIR => '/tmp';

# Directory containing scripts that this script runs
use constant SCRIPT_DIR => '/opt/httpd/cgi-bin';

# Directory for output plots. Make sure permissions are right
use constant OUTPUT_DIR => '/var/html/observing/data';

# Pattern used to generate output image names
use constant OUTPUT_IMAGE => 'orim*.gif';

# Url of output directory
use constant OUTPUT_URL => 'http://www.stsci.edu/observing/data';
 
# Url of this script
use constant SCRIPT_URL => 'http://www.stsci.edu/cgi-bin/callorient.pl';

# Url of the input form
use constant FORM_URL => 'http://www.stsci.edu/hst/proposing/LargePrograms';

# Error template filename
use constant ERROR_TEMPLATE => 'orienterror.pp';

# Output html template filename
use constant OUTPUT_TEMPLATE => 'orientoutput.pp';

# Snippet of html code used to present images
use constant IMAGE_TEMPLATE =>  <<'EOQ';
<h3>$(blurb)</h3>
<img width="$(width)" height="$(height)" src="$(url)">

EOQ

# Name of file containing count of page accesses
use constant COUNTER_FILE => 'orientcounter.txt';

# Keep temporary files for debugging
use constant KEEP_TEMP => 0;

# Number of days to keep output images before deleting
use constant KEEP_DAYS => 0.5;

# Short descriptions of the three output images

my $description = [
		   'Number of Days Available',
		   'Nominal Orient Plot',
		   'Target Visibility (minutes)',
		   ];

#----------------------------------------------------------------------
# Main procedure

$|=1;
umask (002);
$ENV{PATH}='/usr/bin:/opt/gnu/bin';
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
 
my %form = cgi_parse_form(@ARGV);
my ($ra, $dec) = check_input ($form{ra}, $form{dec});

cgi_redirect (FORM_URL) unless $ra && $dec;

my $counter;
my $images = '';

eval {
    $images = orient ($ra, $dec, $description);
    $counter = bump_counter (OUTPUT_DIR . '/' . COUNTER_FILE);
};

print "Content-type: text/html\n\n";

cgi_error ($@) if $@;

my $output_template = SCRIPT_DIR . '/' . OUTPUT_TEMPLATE;
cgi_template ($output_template, script => SCRIPT_URL, ra => $ra, 
	      dec => $dec, counter => $counter, images => $images);

#----------------------------------------------------------------------
# Build a string containing the optional arguments to the orient report

sub build_orient_options {
    my (%arg) = @_;

    my $args;
    my @options = qw (ofile vfile output-dir spf-file spf-dir);

    foreach my $option (@options) {
	my $value = $arg{$option};
	next unless $value;

	$value .= '/' if $option =~ /-dir$/ && $value =~ /[^\/]$/;
	$args .= ":$option \"$value\" ";
    }

    $args =~ s/\s+$//;
    $args = "'$args'";

    return $args;
}

#----------------------------------------------------------------------
# Read, increment, and write the count of script accesses

sub bump_counter {
    my ($file) = @_;

    my $counter;
    my $fd = FileHandle->new ("+<$file");

    if (defined $fd) {
	flock ($fd, 2);
	$counter = <$fd>;
	chomp $counter;
	$counter = $counter + 1;
	$fd->seek (0, 0);

    } else {
	$fd = FileHandle->new (">$file") or die "Can't open $file: $!";
	flock ($fd, 2);
	$counter = 1;
    }

    print $fd "$counter\n";
    $fd->close;

    return $counter;
}

#------------------------------------------------------------
# Send an error message as an html form

sub cgi_error {
    my $error = join ("\n", @_);

    if ($ENV{'REQUEST_METHOD'}) {
	$error = cgi_subchar ($error);

	my $error_template = SCRIPT_DIR . '/' . ERROR_TEMPLATE;
	cgi_template ($error_template, error => $error);

    } else {
	print "$error\n";
    }

    exit (0);
}

#------------------------------------------------------------
# Default html output when template not found

sub cgi_panic {
    my (%hash) = @_;

    print "<html><head><title>Script Error</title></head>\n";
    print "<body bgcolor=\"#ffffff\">\n";
    print "<h1>Script Error</h1>\n";
    print "<ul>\n";

    while (my ($name, $value) = each %hash) {
	print "<li><b>$name</b> $value</li>\n";
    }

    print "</ul>\n";
    print "</body></html>\n";
    exit (0);
}

#------------------------------------------------------------
# Parse form input passed to script

sub cgi_parse_form {

    my $buf;
    if (@_) {
	$buf = join ('&', @_);

    } elsif ($ENV{'REQUEST_METHOD'} eq 'GET') {
	$buf = $ENV{'QUERY_STRING'};

    } elsif ($ENV{'REQUEST_METHOD'} eq 'POST') {
	read (STDIN, $buf, $ENV{'CONTENT_LENGTH'});

    } else {
	$buf = '';
    }

    my %form;
    my @pairs = split (/&/, $buf);    

    foreach my $pair (@pairs) {
	my ($name, $value);

	if ($pair =~ /=/) {
	    ($name, $value) = split (/=/, $pair);
	} else {
	    $value = $pair;
	    $name = '?';
	}

	$name =~ tr/+/ /;
	$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
	$name =~ s/\n/ /g;

	$value =~ tr/+/ /;
	$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
	$value =~ s/\n/ /g;

	$value =~ s/<!--(.|\n)*-->//g;

	if (exists $form{$name}) {
	    $form{$name} .= ",$value";
	} else {
	    $form{$name} = $value;
	}
    }

    return %form;
}

#------------------------------------------------------------
# Check input for correct format and bounds

sub check_input {
    my @fmt = qw (hms dms);

    my $fmt;
    my @pos;
    while ($fmt = shift @fmt) {
	$_ = shift (@_);

        my $pos;
        if (/^\s*([\+\-]?\d{1,3}:\d{1,2}:\d{1,2}\.?\d*)\s*$/) {
	    $pos = $1;
	    my ($d, $m, $s) = split (/:/, $pos);

	    if ($m >= 60 || $s >= 60) {
		$pos = '';

	    } else {
		my $degrees;
		if ($fmt eq 'hms') {
		    $degrees = (((abs($d) * 15) * 60 + $m) * 60 + $s) / 3600;
		    if (($d =~ /^-/) || $degrees < 0 || $degrees > 360.) {
			$pos = '';
		    }

		} elsif ($fmt eq 'dms') {
		    $degrees =  ((abs($d) * 60 + $m) * 60 + $s) / 3600.;
		    if ($degrees < 0 || $degrees > 90) {
			$pos = '';
		    }
		}
	    } 

        } else {
	    $pos = '';
	}

	push (@pos, $pos);
    }

    return @pos;
}

#------------------------------------------------------------
# Redirect user to another web page

sub cgi_redirect {
    my ($url) = @_;

    print "Location: $url\n\n";
    exit (0);
}

#------------------------------------------------------------
# Substitute character sequence for html metacharacters

sub cgi_subchar {
    my ($line) = @_;

    $line =~ s/&/&amp;/g;
    $line =~ s/</&lt;/g;
    $line =~ s/>/&gt;/g;

    return $line;
}

#------------------------------------------------------------
# Fill in values in an html template to create an html file


sub cgi_template {
    my ($source, %hash) = @_;

    my $in = FileHandle->new ($source);
    cgi_panic (%hash) unless defined $in;

    while (<$in>) {
	# Substitute for variables of form $(name)

	s/\$\(([^\)]*)\)/$hash{$1}/ge;

	# Execute include and set commands

	if (/^\$[^\(]/) {
	    s/\s+$//;
	    my ($cmd, $arg) = split (/ /, $_, 2);

	    if ($cmd eq '$include') {
		# Include command: switch to processing included file

		my $include;
		if ($arg =~ /^\//) {
		    $include = $arg;
		} else {
		    my $dir = dirname ($source);
		    $include = "$dir/$arg";
		}

		cgi_template ($include, %hash) if -r $include;

	    } elsif ($cmd eq '$set') {
		# Set command: add new variable to hash

		my ($name, $value) = split (/\s*=\s*/, $arg, 2);
		$hash{$name} = $value;
	    }

	} else {
	    # Print line if it is not a command
	    print  $_;
	}
    }
}

#----------------------------------------------------------------------
# Convert postscript images to gif format

sub convert_images {
    my ($description, @input) = @_;

    my $output;
    my @atrib = qw (width height);
    my $template = OUTPUT_DIR . '/' . OUTPUT_IMAGE;

    foreach my $blurb (@$description) {

	my $img = Image::Magick->new();

	my $ifile = shift (@input);
	my $rc = $img->Read ($ifile);
	die $rc if $rc;

	$rc = $img->Rotate (degrees => 270);
	die $rc if $rc;

	my $ofile = mktemp ($template);
	$rc = $img->Write ($ofile);
	die $rc if $rc;

	my $hash = {file => $ofile, blurb => $blurb};

	foreach my $atrib (@atrib) {
	    $hash->{$atrib} = $img->Get ($atrib);
	}
	
	push (@$output, $hash);
    }

    return $output;
}


#----------------------------------------------------------------------
# Free old image files created by this script

sub free_files {
    my ($output_dir, $file, $days) = @_;

    my $pattern = "$output_dir/$file";
    my @file = glob ($pattern);

    # Find all files not modified recently and delete them

    @file = grep (-M $_ > $days, @file);
    $pattern =~ s/([\*\?])/\.$1/;

    foreach (@file) {
	unlink $1 if /^($pattern)$/; 
    }
}

#----------------------------------------------------------------------
# Create an idl command to run an idl script

sub idl_cmd {
    my $idl = shift (@_);

    copy ($idl, '.') or die "Couldn't copy $idl: $!";
    my ($cmd, $dir, $ext) = fileparse ($idl, qr/\.[^\.]*$/);
    
    my @arg = map ("'$_'", @_);

    return join (',', $cmd, @arg) . "\n";
}

#----------------------------------------------------------------------
# Generate html code to display images

sub image_code {
    my ($output) = @_;

    my $html;
    foreach my $hash (@$output) {
	my $url = OUTPUT_URL . basename ($hash->{file});
	$hash->{url} = $url;

	my $line = IMAGE_TEMPLATE;
	$line =~ s/\$\(([^\)]*)\)/$hash->{$1}/ge;
	$html .= $line;
    }

    return $html;
}

#----------------------------------------------------------------------
# Create a temporary file name that does not colide with a current file

sub mktemp {
    my ($pattern) = @_;

    my ($id, $file);
    do {
	$id = '';
	$id .= sprintf ("%04x", int (rand (65536))) for (1 .. 4);

	($file = $pattern) =~ s/\*/$id/;
    } while -e $file;

    return $file;
}

#----------------------------------------------------------------------
# Executive routine

sub orient {
    my ($ra, $dec, $description) = @_;

    my $temp_dir = mktemp(WORK_DIR . "/*/");
    mkdir ($temp_dir, 0777) || die "Couldn't mkdir $temp_dir: $!\n";
    chdir ($temp_dir) || die "Couldn't cd $temp_dir: $!\n";

    my ($ofile, $vfile) = orient_report ($ra, $dec);

    my ($oplot1, $oplot2, $vplot) = orient_plot ($ofile, $vfile, $ra, $dec);

    my $output = convert_images ($description, $oplot1, $oplot2, $vplot);

    my $images = image_code ($output);
    
    unless (KEEP_TEMP) {
	chdir (WORK_DIR);
	rmtemp ($temp_dir);
	free_files (OUTPUT_DIR, OUTPUT_IMAGE, KEEP_DAYS);
    }

    return $images;
}

#----------------------------------------------------------------------
# Create the orient plots and return their names

sub orient_plot {
    my ($ofile, $vfile, $ra, $dec) = @_;
    my $title = "RA=$ra DEC=$dec";

    my $script = mktemp ('*.pro');
    my $fd = FileHandle->new (">$script");

    print $fd idl_cmd (SCRIPT_DIR . '/orient.pro', $ofile, $title);
    print $fd idl_cmd (SCRIPT_DIR . '/viewing.pro', $vfile, $title);
    print $fd "exit\n";

    $fd->close;

    $ENV{IDL_STARTUP} = $script;
    run_system ('/usr/local/bin/idl');

    return ("${ofile}_1.ps", "${ofile}_2.ps", "${vfile}.ps");
}

#----------------------------------------------------------------------
# Run the orient report and return the output file names

sub orient_report {
    my ($ra, $dec) = @_;

    my @args = (
		'/usr/local/acl61/alisp',
		'-I', 
		SCRIPT_DIR . '/casm.image',  
		'-qq',
		'--',  
		':orient-report',
	       );

    my @pos = split (':', $ra);
    push (@pos, split (':', $dec));
    push (@args, @pos);

    push (@args, build_orient_options('spf-dir' => SCRIPT_DIR));

    run_system (@args);

    my ($ofile) = glob ('orpt*.txt');
    die "No orpt file produced" unless $ofile;
    $ofile =~ s/\.txt$//;

    my ($vfile) = glob ('vrpt*.txt');
    die "No vrpt file produced" unless $vfile;
    $vfile =~ s/\.txt$//;

    return ($ofile, $vfile);
}

#----------------------------------------------------------------------
# Remove a temporary file previously created

sub rmtemp {
    my ($file) = @_;

    if (-d $file) {
	run_system ('/usr/bin/rm', '-rf', $file);

    } else {
	unlink ($file);
    }

    die "Could not delete temp file: $file\n" if -e $file;
}

#----------------------------------------------------------------------
# Do a system call with error reporting. Wheels within wheels

sub run_system {
    my (@args) = @_;

    my $cmd = join (' ', @args) . " 2>&1";
    die "Relative path: $cmd" unless $cmd =~ /^\//;

    my $log = `$cmd`;
    die "$cmd\n$log\nExecution halted" if $?; 
}

=pod

=head1 SYNOPSIS

Callorient is a cgi script that produces orientation plots

=head1 ARGUMENTS

The script takes two arguments: ra and dec, which represent right
ascension and declination. Right ascension is in hour, minutes, and
seconds. Declination is in degrees, minutes, and second. Colons
separate the fields, i.e. ra=8:23:17.2, dec=-46:32:15.7. 

=head1 SETUP

The script uses three directories: SCRIPT_DIR, WORK_DIR, and
OUTPUT_DIR. They are defined in the configuration section at the top
of the file. Three separate directories are used because each
directory requires different permissions.

=over 4

=item SCRIPT_DIR

SCRIPT_DIR contains this script, the lisp and idl code, and the html
template code. This directory should not be accessible from the web
and should be protected so that the webadm account has read and
execute but not write permission.

=item WORK_DIR

This script creates a subdirectory in WORK_DIR that contains all the
temporary files produced by this script. This directory should not be
accessible from the web and should be protected so that the webadm
account has all permissions to read, write, and execute.

=item OUTPUT_DIR

OUTPUT_DIR contains the GIF images produced by this script and the access 
counter file. It should be accessible from the web and the webadm
account should have read and write permissions on it.

=back

You will also have to configure the URLs this script uses.

=over 4

=item SCRIPT_URL

The url used to invoke this script

=item FORM_URL

The url of the page containing the form that is used to invoke this
script.

=item OUTPUT_URL

The url of the directory OUTPUT_DIR

=back

=head1 TEMPLATE SYNTAX

The html produced by this script is generated using a simple
templating language. The templating language allows you to substitute
for the values of variables, set the values of variables, and include
the contents of other files. Variable substitution replaces strings of 
the form 

    $(NAME)

with the value of the variable NAME. The variable substitution strings
can occur anywhere in the file, but cannot be nested within one
another. Variable values can be set with the command

    $set NAME = VALUE

The set command must be on a separate line and the dollar sign must be
at the start of the line. The set command allows small pieces of
repeated content in the template to be defined in a single place. It
is not used in the template I distribute with this script.

File inclusion is triggered by the command

    $include FILENAME

The contents of the file replace the include command. Contents are
interpreted using the templating language, just as if the contents
were in the main file. This means the include file can contain other
include commands. The purpose of the include command is to allow the
constant html markup which frames the output page to be defined
separately from the variable content. Just as with the set command,
the include command must be on a separate line and the dollar sign
must start the line.

The script defines the following variables to be palced in the output

=over 4

=item script

The url of that invokes this script

=item ra

The right ascension passed to this script

=item dec

The declination passed to this script

=item counter

A count of the number of times this script has been run

=item images

The html markup generated by this script that displays the output
images.

=back

This html markup is generated by a snippet of templating code defined
by IMAGE_TEMPLATE. It is evaluated three times, once for each ouput
image. It in turn uses four other variables.

=over 4

=item blurb

A short description of the image. It is defined by the array
$description.

=item width

The width of the image in pixels

=item height 

The height of the image in pixels

=item url

The url of the image

=back

=cut

