#!/usr/bin/perl
#
# Run a query on SIMBAD to lookup the coordinates of an object.
#
# MWR 6/22/2004
#
# Updated to use CGI and run from a browser.
# Note: A cron job will need to be added to
# delete the plot files created by this
# script.
#
# CMR 7/06/2004
#
# Modified slightly; biggest change is making a URL which is equivalent
# to the temp file in which the script places the PNG graphic,
# so that external users can look at the plot.
#
# MWR 7/13/2004
use strict;
use POSIX;
use HTTP::Request::Common qw(POST);
use LWP::UserAgent;
use CGI qw( -unique_headers -debug -compile :standard );
use CGI::Carp qw( fatalsToBrowser );
use Benchmark;
# Name the main package
package main;
# Set some CGI security settings
$CGI::POST_MAX = 1024 * 100;
$CGI::DISABLE_UPLOADS = 1;
#####################################################
# Variables that may need updating after installation
#####################################################
my ($site_title) = "Lookup Phased Light Curves From Mark IV Data";
my ($site_url) = "http://spiff.rit.edu/";
my ($www_dir) = "/var/www/html/";
my ($plot_dir) = $www_dir . "temp";
our ($gnuplot) = "/usr/bin/gnuplot";
#####################################################
# Nothing below here should need editing
#####################################################
# Variables
our ($primary_color) = "#ccccff";
our ($secondary_color) = "#cccccc";
my ($background_color) = "white";
my ($time_operations) = 0;
my ($t0, $t1) = (0, 0);
# Global variables
our ($VERSION) = "0.03";
our ($plotfile) = $plot_dir . "/" . "make_phased" . "_" . $$ . "QxQ" . ".";
our ($plot_cmd_file) = $plot_dir . "/" . "make_phased" . "_" . $$ . "QxQ" . "." . "gnu";
our ($plot_data_file) = $plot_dir . "/" . "make_phased" . "_" . $$ . "QxQ" . "." . "dat";
# External links to data and databases
our ($markiv_home) = "http://sallman.tass-survey.org/";
our ($markiv_url) = "http://sallman.tass-survey.org/servlet/markiv/action/DataDownload";
our ($simbad_home) = "http://simbad.u-strasbg.fr/";
our ($simbad_url) = "http://simbad.u-strasbg.fr/sim-id.pl";
our ($tass_img) = "http://www.tass-survey.org/tass/logo/gleeson_smaller.gif";
our ($tass_home) = "http://stupendous.rit.edu/";
our ($lookup_info) = "http://spiff.rit.edu/richmond/tass/lookup/lookup.html";
# flush output immediately
$| = 1;
# Create a CGI object (q = query)
our $q = new CGI;
# Find out if any parameters were passed in that we
# are interested in.
my ($action) = $q->param( "action" );
my ($name) = $q->param( "name" );
my ($ra) = $q->param( "ra" );
my ($dec) = $q->param( "dec" );
my ($epoch_jd) = $q->param( "epoch_jd" );
my ($period) = $q->param( "period" );
my ($multiple_values) = $q->param( "multiple_values" );
our ($debug) = $q->param( "debug" );
my ($status) = 1;
($time_operations) = $q->param( "time_operations" );
# Was going to allow different plot file types to
# be created by radio button, but my gnuplot was not
# able to create jpeg or pdf files.
#my ($file_type) = $q->param( "file_type" );
my ($file_type) = "png";
$plotfile = $plotfile . $file_type;
# Get a benchmark timestamp
if ($time_operations) {
# Get a benchmark
($t0) = new Benchmark;
}
# Print out the header
print $q->header,
$q->start_html( -title => "$site_title"),
$q->h1( {-align=>"center"}, "$site_title" ),
$q->hr;
# Place a pretty TASS image on the page
print $q->img({src=>$tass_img, align=>"right"});
# Show the menu items
&show_menu_items($q);
# Print out given arguments if debug
if ($debug) {
print $q->Dump();
}
# Ok, time to do the real work...
if (($action eq "Submit Single") || ($action eq "Submit Multiple")) {
my (@data) = ();
my ($set) = "";
my ($setid) = 0;
# Gather the data submited into an array
if ($action eq "Submit Multiple") {
@data = split (/;/, $multiple_values);
} else {
push(@data, "$name,$ra,$dec,$epoch_jd,$period");
}
if ($#data < 0) {
print $q->h3("No data submitted");
print $q->h6("I feel so empty...");
} else {
# Now generate the light curves for each set of data
foreach $set (@data) {
# generate a unique set of filenames for the graph we are
# about to make. We modify the contents of the variables
# plotfile, plot_cmd_file, plot_data_file
# so that the section between the capital Qs changes on
# each iteration.
generate_new_filenames($setid++);
# get rid of any control characters (which appear to be
# inserted at the start of the for the second, third, etc.
# lines of multiple submission)
$set = remove_control_chars($set);
my ($name, $ra, $dec, $epoch_jd, $period) = split(/,/, $set);
print $q->h3("Data set: ..$name.., $ra, $dec, $epoch_jd, $period");
# check here to see if any of the information is missing;
# if so, then we use the name to look up all the other
# quantities via SIMBAD.
#
# If the user did supply some, but not all, of the fields --
# for example, if he provided period but not RA and Dec --
# we use the name to look up all quantities via SIMBAD.
# However, we'll only use the SIMBAD values for the fields the
# user left blank; we'll retain the user's values for all
# fields he supplied.
my $ret_simbad = 0;
($ret_simbad, $name, $ra, $dec, $epoch_jd, $period) =
get_variable_info($name, $ra, $dec, $epoch_jd, $period);
if ($ret_simbad != 0) {
print $q->h3("Error looking up data from SIMBAD");
next;
}
my ($ret_plot_file) = &generate_light_curves($q, $file_type, $name, $ra,
$dec, $epoch_jd, $period);
if ($ret_plot_file) {
# the "ret_plot_file" begins with a full path on the local
# machine running this script; that is, in $www_dir. We need
# to create an equivalent URL, pointing to the same file,
# which people can access over HTTP.
my ($plot_url) = create_url_name($ret_plot_file);
if ($plot_url) {
print $q->ul(
"Link to file containing image of plot",
$q->img({src=>"$plot_url"}),
);
}
else {
print $q->h3("Error creating URL for plot file?!");
}
}
}
}
} elsif ($action eq "single_form") {
&show_lookup_form($q, $action);
} elsif ($action eq "multiple_form") {
&show_lookup_form($q, $action);
} elsif ($action eq "about") {
&show_about($q);
} else {
&show_lookup_form($q, "single_form");
}
# Get a benchmark timestamp and find out how long
# this operation took
if ($time_operations) {
# Get the ending benchmark
($t1) = new Benchmark;
my ($min, $sec) = &diff_time($t0, $t1);
print $q->p("Operation took $min:$sec");
}
# Print the end of the HTML page
print $q->end_html;
# Clean up any files created by this script
# Except the plotfile. Apache seems to need
# it until the script exits. A cron job will
# need to delete old files every few hours or so.
#unlink ($plotfile);
#unlink ($plot_cmd_file);
#unlink ($plot_data_file);
exit(0);
###########################################################################
# Display data subroutines
###########################################################################
sub show_menu_items {
my ($q) = @_;
my ($debug) = $main::debug;
my ($primary_color) = $main::primary_color;
my ($secondary_color) = $main::secondary_color;
my ($tass_home) = $main::tass_home;
my ($row) = "";
my ($index) = $q->url();
print $q->start_table();
#print $q->td({bgcolor=>$primary_color}
#print $q->a({href=>$index,"Main");
print "| ";
print "Single lookup";
print " | ";
print "";
print "Multiple lookup";
print " | ";
print "";
print " ";
print " | ";
print "";
print "About";
print " | ";
# $q->td({bgcolor=>$secondary_color}
# $q->a({href=>$index},"Foo"),
# ),
# );
print $q->end_table();
return();
}
###########################################################################
# PROCEDURE: show_lookup_form
#
# DESCRIPTION: Show an HTML form which allows the user to
# enter in data which can be used to generate
# a light curve.
#
# RETURNS:
# Nothing.
#
sub show_lookup_form {
my ($q, $action) = @_;
my ($size) = 20;
my ($max_length) = 80;
my ($rows) = 10;
my ($columns) = 80;
print $q->start_form();
if ($action eq "single_form") {
print $q->h2("Lookup single phased light curve");
print $q->p("This form allows a user to look up a
single phased light curve.
You may
enter a name alone or enter multiple items.");
print $q->start_ul();
print $q->start_table();
print $q->td("Name:"),
$q->td(
$q->textfield(-name=>'name',
-default=>'',
-override=>1,
-size=>$size,
-maxlength=>$max_length),
),
$q->Tr(),
$q->td("RA:"),
$q->td(
$q->textfield(-name=>'ra',
-default=>'',
-override=>1,
-size=>$size,
-maxlength=>$max_length),
),
$q->Tr(),
$q->td("DEC:"),
$q->td(
$q->textfield(-name=>'dec',
-default=>'',
-override=>1,
-size=>$size,
-maxlength=>$max_length),
),
$q->Tr(),
$q->td("Epoch Jd:"),
$q->td(
$q->textfield(-name=>'epoch_jd',
-default=>'',
-override=>1,
-size=>$size,
-maxlength=>$max_length),
),
$q->Tr(),
$q->td("Period:"),
$q->td(
$q->textfield(-name=>'period',
-default=>'',
-override=>1,
-size=>$size,
-maxlength=>$max_length),
);
print $q->end_table();
print $q->end_ul();
print $q->submit(-name=>"action",
-value=>"Submit Single");
print $q->reset;
print $q->br;
# print $q->br("Select plot file type:");
#
#
# print $q->radio_group(-name=>'file_type',
# -values=>['png','jpeg', 'pdf'],
# -default=>'png');
# -linebreak=>'true');
#
# print $q->br;
print $q->checkbox(-name=>'debug',
-checked=>0,
-value=>'1',
-label=>'show debug information');
print $q->br;
print $q->checkbox(-name=>'time_operations',
-checked=>0,
-value=>'1',
-label=>'Time lookup');
}
if ($action eq "multiple_form") {
print $q->h2("Lookup multiple phased light curves");
print $q->p("This form allows a user to look up multiple
phased light curves.");
print $q->p("The textarea below allows the user to enter multiple data sets to
lookup. Each set of data should contain one or more of the
following items in this order: name, ra, dec, epoch_jd, period.
These items should be comma separated (,). Each set of data should
be separated by a semi colons (;).");
print $q->ul("Each set should contain: name,ra,dec,epoch_jd,period;");
print $q->p("Example:");
print $q->ul("RR_Lyr,291.36630375,42.78436,2442923.419300,0.5668677600;
RR_Lyr,291.36630375,42.78436,2442923.419300,0.5668677600;
");
print $q->ul(
$q->textarea(-name=>'multiple_values',
-default=>'',
-rows=>$rows,
-columns=>$columns),
);
print $q->p;
print $q->submit(-name=>"action",
-value=>"Submit Multiple");
print $q->reset;
print $q->br;
print $q->checkbox(-name=>'debug',
-checked=>0,
-value=>'1',
-label=>'show debug information');
print $q->br;
print $q->checkbox(-name=>'time_operations',
-checked=>0,
-value=>'1',
-label=>'Time lookup');
}
print $q->end_form();
return();
}
###########################################################################
# PROCEDURE: show_about
#
# DESCRIPTION: Show a page which describes how this script works.
#
# RETURNS:
# Nothing
#
sub show_about {
my ($q) = @_;
print $q->p("Version: $main::VERSION");
print $q->h2("General Information");
print $q->p("Given the name or position of a variable star,
this script will look
up its properties in SIMBAD, grab measurements from
the Mark IV database, calculate the phase of each Mark IV
measurement, and then create a light curve of the star. This
might be handy for checking the TASS database for several
sorts of errors; it also makes pretty pictures :-)");
print $q->p("More information on the background for this script
can be found at the following urls:");
print $q->ul(
$q->li(
$q->a({href=>$main::tass_home},$main::tass_home), "(TASS home page)"
),
$q->li(
$q->a({href=>$main::lookup_info},$main::lookup_info),
),
);
print $q->h2("Data sources");
print $q->p("This script uses the following data sources");
print $q->ul(
$q->li(
$q->a({href=>$main::markiv_home},"TASS Mark IV Database"),
),
$q->li(
$q->a({href=>$main::simbad_home},"SIMBAD Astronomical Database"),
),
);
return;
}
###########################################################################
# PROCEDURE: generate_light_curves
#
# DESCRIPTION: For each set of given data, generate
# a light curve.
#
# RETURNS:
# ret_plot_file: Filename of the generated plot
#
sub generate_light_curves {
my ($q, $file_type, $name, $ra, $dec, $epoch_jd, $period) = @_;
my ($retval);
my ($num_markiv_lines, @markiv_lines);
my ($debug) = $main::debug;
# now grab data from the Mark IV database (if it exists)
my ($num_markiv_lines, @markiv_lines) = &get_markiv_data($ra, $dec);
if ($num_markiv_lines <= 0) {
print $q->p("get_markiv_data returns no data");
return(0);
}
# make a nice graph showing the measurements phased with the known period
# CMR Note: this subroutine also returns the plot file name.
my ($ret_val, $ret_plot_file) =
&make_phased_graph($name, $ra, $dec, $epoch_jd, $period, $file_type,
$num_markiv_lines, @markiv_lines);
if ($ret_val != 0) {
print $q->p("make_phased_graph returns with error");
return(0);
}
return($ret_plot_file);
}
###########################################################################
# Data crunching subroutines
###########################################################################
###########################################################################
# PROCEDURE: get_markiv_data
#
# DESCRIPTION: go to the Mark IV database and request measurements
# of the star at a given (RA, Dec). Place the
# resulting measurements into an array and return them.
#
# RETURNS:
# (num_lines, @lines)
# num_lines number of lines of data
# lines array of data, one V,I pair per line
#
sub get_markiv_data {
my($i);
my($ra, $dec);
my($ua, $url, $req, $reply);
my($match_radius, $match_scale, $radec_string);
my($retval, $rah, $ram, $ras, $decsign, $decd, $decm, $decs);
my($num_reply_lines, @reply_lines);
my($num_data_lines, @data_lines);
my($q) = $main::q;
$ra = $_[0];
$dec = $_[1];
$ua = LWP::UserAgent->new;
$num_data_lines = 0;
@data_lines = "";
$match_radius = 5;
$match_scale = "Seconds";
# we must convert RA and Dec to sexigesimal notation in order to
# make use of full accuracy of positions (sigh)
($rah, $ram, $ras, $decsign, $decd, $decm, $decs) =
convert_deg_to_baby($ra, $dec);
if ($main::debug > 0) {
print $q->p("get_markiv_data: rah $rah ram $ram ras $ras");
print $q->p("get_markiv_data: decsign $decsign decd $decd decm $decm decs $decs");
}
# now make a nice string that the Mark IV database engine will accept
$radec_string = sprintf "%02d%02d%04.1f%s%02d%02d%04.1f",
$rah, $ram, $ras, $decsign, $decd, $decm, $decs;
if ($main::debug > 0) {
print $q->p("get_markiv_data: radec_string: ..$radec_string..");
}
# make a query to the Mark IV database
$url = $main::markiv_url;
$req = POST $url, [ "header" => 'false',
"compress" => 'false',
"position" => $radec_string,
"radius" => $match_radius,
"scale" => $match_scale
];
$reply = $ua->request($req)->as_string;
if ($main::debug > 0) {
print $q->p("get_markiv_data: reply from Mark IV database follows .. ");
print $q->p("..$reply..");
}
if ($reply =~ /Can't connect/) {
print $q->p("Error returned by $url");
print $q->pre("$reply");
return($num_data_lines, @data_lines);
}
# pick out just the lines with measurements
# first, skip lines until we reach a ""
($num_reply_lines, @reply_lines) = split_reply($reply);
for ($i = 0; $i < $num_reply_lines; $i++) {
if ($reply_lines[$i] =~ //) {
last;
}
}
if ($i == $num_reply_lines) {
# there wasn't any real data
if ($main::debug > 0) {
print $q->p("get_markiv_data: no real data ... ");
}
}
else {
# now, we copy the real data into the "@data_lines" array
for ($i++; $i < $num_reply_lines; $i++) {
if ($reply_lines[$i] =~ /Sorry/) {
last;
}
if ($reply_lines[$i] =~ /<\/pre>/) {
last;
}
$data_lines[$num_data_lines] = " " . $reply_lines[$i];
chomp($data_lines[$num_data_lines]);
if ($main::debug > 0) {
print $q->p("get_markiv_data: data line $num_data_lines is ..$data_lines[$num_data_lines]..");
}
$num_data_lines++;
}
}
# there is a single blank line just before the , so get rid of it
if ($num_data_lines > 0) {
$num_data_lines--;
}
return($num_data_lines, @data_lines);
}
###########################################################################
# PROCEDURE: convert_deg_to_baby
#
# DESCRIPTION: convert (RA, Dec) from decimal degrees to babylonian
# notation: HH MM SS.sss and "sign" DD MM SS.ss.
#
# Note that we return values which are ALWAYS positive
# for decd, decm, decs; only the separate "sign" value
# indicates the sign of the Declination. The "sign"
# will be either "+" or "-".
#
# RETURNS:
# (rah, ram, ras, decsign, decd, decm, decs)
#
sub convert_deg_to_baby {
my($ra, $dec);
my($rah, $ram, $ras, $decsign, $decd, $decm, $decs);
my($q) = $main::q;
$ra = $_[0];
$dec = $_[1];
if ($main::debug > 0) {
print $q->p("convert_deg_to_baby: ra ..$ra.. dec ..$dec.. ");
}
# pick apart the RA first
$rah = int($ra/15.0);
$ram = int(($ra - 15*$rah)*4.0);
$ras = $ra - ($rah*15) - ($ram/4.0);
$ras *= 240.0;
# now figure out the Dec value
if ($dec < 0) {
$decsign = "-";
$dec = 0.0 - $dec;
} else {
$decsign = "+";
}
$decd = int($dec);
$decm = int(($dec - $decd)*60.0);
$decs = $dec - ($decd) - ($decm/60);
$decs *= 3600.0;
if ($main::debug > 0) {
print $q->p("convert_deg_to_baby: RA ..$rah.. ..$ram.. ..$ras.. ");
print $q->p("convert_deg_to_baby: Dec ..$decsign.. ..$decd.. ..$decm.. ..$decs.. ");
}
return($rah, $ram, $ras, $decsign, $decd, $decm, $decs);
}
###########################################################################
# PROCEDURE: convert_baby_to_deg
#
# DESCRIPTION: convert (RA, Dec) from babylonian notation,
# HH MM SS.sss and "sign" DD MM SS.ss, to decimal degrees.
# Expect input in the form of two strings:
#
# "HH MM SS.ss" and "+DD MM SS.s"
#
# and convert to two values: RA and Dec.
# RETURNS:
# (ra, dec)
#
sub convert_baby_to_deg {
my($ra_string, $dec_string);
my($rah, $ram, $ras, $decsign, $decd, $decm, $decs);
my($ra, $dec);
my($q) = $main::q;
$ra_string = $_[0];
$dec_string = $_[1];
if ($main::debug > 0) {
print $q->p("convert_baby_to_deg: ra ..$ra_string.. dec ..$dec_string.. ");
}
# first, we replace any colons in input strings by spaces
$ra_string =~ s/:/ /g;
$dec_string =~ s/:/ /g;
# break up the RA string into three pieces, which are rah, ram, ras
($rah, $ram, $ras) = split(/\s+/, $ra_string);
# break up the Dec string into three pieces, which are decd, decm, decs
($decd, $decm, $decs) = split(/\s+/, $dec_string);
if ($main::debug > 0) {
print $q->p("convert_baby_to_deg: rah ..$rah.. ram ..$ram.. ras ..$ras..");
print $q->p("convert_baby_to_deg: decd ..$decd.. decm ..$decm.. decs ..$decs.. ");
}
# convert RA to decimal degrees
$ra = ($rah*15) + ($ram*(15/60.0)) + ($ras*(15/3600.0));
# convert Dec to decimal degrees; be careful about negative dec values
if ($decd < 0) {
$decsign = -1;
$decd = 0.0 - $decd;
}
else {
$decsign = 1;
}
$dec = $decsign*($decd + ($decm/60.0) + ($decs/3600.0));
if ($main::debug > 0) {
print $q->p("convert_baby_to_deg: RA ..$ra.. ");
print $q->p("convert_baby_to_deg: Dec ..$dec.. ");
}
return($ra, $dec);
}
###########################################################################
# PROCEDURE: is_baby
#
# DESCRIPTION: A very simple test: is the given coordinate in
# Babylonian notation? We answer "yes" if it looks like
#
# "HH MM SS.s"
# or
# "HH:MM:SS.s"
#
# RETURNS:
# 1 if the coordinate _is_ babylonian
# 0 if the coordinate is _not_ babylonian
#
sub is_baby {
my($coord_string, @words);
my($q) = $main::q;
$coord_string = $_[0];
if ($main::debug > 0) {
print $q->p("is_baby: coord ..$coord_string.. ");
}
# first, we replace any colons in input strings by spaces
$coord_string =~ s/:/ /g;
# now, if it has three pieces (separated by spaces), we count
# it as babylonian. That's the only test we make.
@words = split(/\s+/, $coord_string);
if ($#words == 2) {
if ($main::debug > 0) {
print $q->p("is_baby: yes, ..$coord_string.. is baby");
}
return(1);
}
else {
if ($main::debug > 0) {
print $q->p("is_baby: no, ..$coord_string.. is NOT baby");
}
return(0);
}
}
###########################################################################
# PROCEDURE: get_variable_info
#
# DESCRIPTION: We are given a set of fields with info about the star,
#
# name, ra, dec, epoch_jd, period
#
# some of which may be empty. Our job is to fill in any
# fields which are empty with data from SIMBAD.
#
# The two cases we can handle successfully are:
# we are given
# a name: "TT Boo"
# or
# a position: "12.2343 +23.8873"
# (J2000) "12 33 43.7 -02 12 58"
#
# (which we assume is the position of a variable star)
# use SIMBAD to look up information on the star.
# We get 5 quantities:
#
# name official name of variable
# ra Right Ascension (J2000)
# dec Declination (J2000)
# epoch time of max or min (JD)
# period period of variability (days)
#
# We will insert the SIMBAD values into any of these 5 fields
# which were not supplied by the user.
#
# Convert RA and Dec into decimal degrees, if necessary
#
# RETURNS:
# a list of 6 quantities:
# proc_retval 0 if all okay, 1 if error occurs
# name
# ra (decimal degrees)
# dec (decimal degrees)
# epoch
# period
#
#
sub get_variable_info {
my($simbad_search_string);
my($input_name, $input_ra, $input_dec, $input_epoch_jd, $input_period);
my($simbad_name, $simbad_ra, $simbad_dec, $simbad_epoch_jd, $simbad_period);
my($output_name, $output_ra, $output_dec, $output_epoch_jd, $output_period);
my($q);
my($proc_retval);
my($ua);
my($line);
my($num_reply_lines, @reply_lines);
my($search_string);
my ($retval);
my($q) = $main::q;
$input_name = $_[0];
$input_ra = $_[1];
$input_dec = $_[2];
$input_epoch_jd = $_[3];
$input_period = $_[4];
if ($main::debug > 0) {
print $q->p("get_variable_info: input_name ..$input_name..");
print $q->p("get_variable_info: input_ra ..$input_ra..");
print $q->p("get_variable_info: input_dec ..$input_dec..");
print $q->p("get_variable_info: input_epoch_jd ..$input_epoch_jd..");
print $q->p("get_variable_info: input_period ..$input_period..");
}
# by default, we fail
$proc_retval = 1;
# initialize some return values to nonsensical values
$output_name = "NoName";
$output_ra = -99.0;
$output_dec = -99.0;
$output_epoch_jd = -99.0;
$output_period = -99.0;
$ua = LWP::UserAgent->new;
# case 1: the user has provided all five values.
# All we have to do is copy the provided values into the output
if (($input_name ne "") && ($input_ra ne "") && ($input_dec ne "") &&
($input_epoch_jd ne "") && ($input_period ne "")) {
$output_name = $input_name;
# if the user supplied Babylonian coords HH MM SS.s, we need
# to convert to decimal degrees before returning them
if (is_baby($input_ra)) {
($output_ra, $output_dec) = convert_baby_to_deg($input_ra, $input_dec);
}
else {
$output_ra = $input_ra;
$output_dec = $input_dec;
}
$output_epoch_jd = $input_epoch_jd;
$output_period = $input_period;
$proc_retval = 0;
return($proc_retval, $output_name, $output_ra, $output_dec,
$output_epoch_jd, $output_period);
}
# case 2: the user has provided the name, but not all other quantities.
# We will search for information by name.
if (($input_name ne "") &&
( ($input_ra eq "") || ($input_dec eq "") || ($input_epoch_jd eq "") ||
($input_period eq "") )) {
$simbad_search_string = $input_name;
}
# case 3: the user has NOT provided the name, but has provided the
# RA and Dec. We will search for information by position.
if (($input_name eq "") && ( ($input_ra ne "") && ($input_dec ne "") )) {
$simbad_search_string = sprintf "%s %s", $input_ra, $input_dec;
}
# case 4: the user has NOT provided name or position. We must give up.
if (($input_name eq "") && ($input_ra eq "") && ($input_dec eq "")) {
print $q->p("You must provide either name or (RA and Dec) ");
return($proc_retval, $output_name, $output_ra, $output_dec,
$output_epoch_jd, $output_period);
}
# okay, we are ready to query SIMBAD for information about this object
# these are the parameters we'll need for the lookup request to SIMBAD
my $Protocol = "html";
my $Ident = $simbad_search_string;
my $NbIdent = 1;
my $Radius = "5";
my $Radius_unit = "arcsec";
my $CooFrame = "FK5";
my $CooEpoch = 2000;
my $CooEquinox = 2000;
my $Output_max = "all";
my $Output_mesdisp = "N";
my $Bibyear1 = 1983;
my $Bibyear2 = 2004;
my $Frame1 = "FK5";
my $Equi1 = "2000.0";
my $Epoch1 = "2000.0";
my $Frame2 = "none";
my $Equi2 = "2000.0";
my $Epoch2 = "2000.0";
my $Frame3 = "none";
my $Equi3 = "2000.0";
my $Epoch3 = "2000.0";
my $url = $main::simbad_url;
my $req = POST $url, [
# protocol => "ascii",
"Ident" => $Ident,
"NbIdent" => $NbIdent,
"Radius" => $Radius,
"Radius.unit" => $Radius_unit,
"CooFrame" => $CooFrame,
"CooEpoch" => $CooEpoch,
"CooEquinox" => $CooEquinox,
"output.max" => $Output_max,
"output.mesdisp" => $Output_mesdisp,
"Bibyear1" => $Bibyear1,
"Bibyear2" => $Bibyear2,
"Frame1" => $Frame1,
"Equi1" => $Equi1,
"Frame2" => $Frame2,
"Equi2" => $Equi2,
"Frame3" => $Frame3,
"Equi3" => $Equi3
];
my $reply_stuff = $ua->request($req)->as_string;
if ($main::debug > 0) {
print $q->p("SIMBAD reply_stuff is ..$reply_stuff.. ");
}
# split the reply into individual lines
($num_reply_lines, @reply_lines) = split_reply($reply_stuff);
if ($num_reply_lines == 0) {
print $q->p("SIMBAD ID query returns empty?! ");
return($proc_retval, $output_name, $output_ra, $output_dec,
$output_epoch_jd, $output_period);
}
# make the special search through the data for the line
# containing the RA and Dec; if found, we'll get
# back RA and Dec in decimal degrees (J2000)
($retval, $simbad_ra, $simbad_dec) =
get_radec($input_name, $num_reply_lines, @reply_lines);
if ($retval != 0) {
print $q->p("get_radec fails ?! ");
return($proc_retval, $output_name, $output_ra, $output_dec,
$output_epoch_jd, $output_period);
}
# look for the entry for this object in the GCVS,
# to get the name, period and time of max/min
($retval, $simbad_name, $simbad_epoch_jd, $simbad_period) =
get_epoch_period($input_name, $num_reply_lines, @reply_lines);
if ($retval != 0) {
print $q->p("get_variable_info: get_epoch_period fails !? ");
return($proc_retval, $output_name, $output_ra, $output_dec,
$output_epoch_jd, $output_period);
}
# okay, we've looked up information about this star in SIMBAD.
# Now, for every item the user did NOT supply, we insert the SIMBAD value.
# Name
if ($input_name eq "") {
$output_name = $simbad_name;
} else {
$output_name = $input_name;
}
# RA
if ($input_ra eq "") {
$output_ra = $simbad_ra;
} else {
$output_ra = $input_ra;
}
# Dec
if ($input_dec eq "") {
$output_dec = $simbad_dec;
} else {
$output_dec = $input_dec;
}
# Epoch
if ($input_epoch_jd eq "") {
$output_epoch_jd = $simbad_epoch_jd;
} else {
$output_epoch_jd = $input_epoch_jd;
}
# Period
if ($input_period eq "") {
$output_period = $simbad_period;
} else {
$output_period = $input_period;
}
# check to see if we need to convert RA and Dec to decimal degrees;
# if we do, perform the conversion
if (is_baby($output_ra)) {
($output_ra, $output_dec) = convert_baby_to_deg($output_ra, $output_dec);
}
if ($main::debug > 0) {
print $q->p("get_variable_info: output_name ..$output_name..");
print $q->p("get_variable_info: output_ra ..$output_ra..");
print $q->p("get_variable_info: output_dec ..$output_dec..");
print $q->p("get_variable_info: output_epoch_jd ..$output_epoch_jd..");
print $q->p("get_variable_info: output_period ..$output_period..");
}
$proc_retval = 0;
return($proc_retval, $output_name, $output_ra, $output_dec,
$output_epoch_jd, $output_period);
}
############################################################################
# PROCEDURE: get_epoch_period
#
# DESCRIPTION: Given an array of lines containing the reply to our
# request to SIMBAD, search through it for the
# line which contains a URL to _another_ SIMBAD
# bit of info: the entry for this star in the GCVS.
# Post that URL and look in _its_ reply for the
# official GCVS name, period and epoch of maximum/minimum light.
#
# We need to handle two cases:
# a) the user gave the name of the star ("RR Lyr"),
# in which case the reply from SIMBAD has one format
# b) the user gave only a position in RA and Dec,
# in which case the reply from SIMBAD has a different
# format
# Based on the "input_name" value, we parse the SIMBAD
# lines in the appropriate way to find the URL to further
# information.
#
# RETURNS:
# (proc_retval, name, epoch_jd, period)
# where proc_retval = 0 if all OK, = 1 if error occurs
# name official GCVS name of variable
# epoch_jd JD of max/min light
# period period of variable (days)
#
# we use values of -99 for epoch_jd and period by default
# to indicate no real data available
#
#
sub get_epoch_period {
my($proc_retval);
my($i);
my($input_name);
my($num_reply_lines);
my($name);
my($gcvs_num_lines, @gcvs_lines);
my($gcvs_url, $gcvs_reply);
my($simbad_url, $simbad_varname);
my($retval, $search_string, $line);
my($epoch_jd, $period);
my($q) = $main::q;
$input_name = $_[0];
$num_reply_lines = $_[1];
$proc_retval = 1;
$name = "no_name";
$epoch_jd = -99.0;
$period = -99.0;
# check to see which format the SIMBAD reply has
if ($input_name ne "") {
# the user provided a name to SIMBAD. We look for a URL in a line
# signalled by "Catalogue information"
#
for ($i = 0; $i < $num_reply_lines; $i++) {
# skip ahead to the "Catalogue information" line
if ($_[2 + $i] =~ /^\Catalogue information/) {
if ($main::debug > 0) {
print $q->p("get_epoch_period: found Catalogue info in line ..$_[2 + $i]..");
#$_[2 + $i];
}
last;
}
}
if ($i == $num_reply_lines) {
# there wasn't any "Catalogue information" line
if ($main::debug > 0) {
print $q->p("get_epoch_period: no Catalogue info ... ");
}
return($proc_retval, $name, $epoch_jd, $period);
}
# get the RA and Dec, which occur a few lines later ...
for ( ; $i < $num_reply_lines; $i++) {
# CMR Note: You don't really mean "\V" here, do you?
if ($_[2 + $i] =~ /\V\*/) {
if ($main::debug > 0) {
print $q->p("get_epoch_period: found V* in line ..$_[2 + $i].."); #, $_[2 + $i];
}
last;
}
else {
if ($main::debug > 0) {
print $q->p("get_epoch_period: skipping line $i is ..$_[2 + $i]..\n"); #, $_[2 + $i];
}
}
}
if ($i == $num_reply_lines) {
# there wasn't any link to GCVS entry
if ($main::debug > 0) {
print $q->p("get_epoch_period: no GCVS entry ... ");
}
return($proc_retval, $name, $epoch_jd, $period);
}
$line = $_[2 + $i];
chomp($line);
if ($main::debug > 0) {
print $q->p("get_epoch_perod: look for GCVS entry in ..$line.. ");
}
if ($line !~ /.*HREF="(.*)"/) {
# rats! No link to the GCVS query?!
if ($main::debug > 0) {
print $q->p("get_epoch_period: no HREF inside line ..$line.. ?! ");
return($proc_retval, $name, $epoch_jd, $period);
}
}
# the line did have the right format -- here's the URL for GCVS query
$gcvs_url = $1;
if ($main::debug > 0) {
print $q->p("get_epoch_period: gcvs_url is ..$gcvs_url..");
}
}
else {
# the user supplied as input only a position in (RA, Dec). That means
# that SIMBAD's reply has a different format. We key on the line
# starting with "identifier" to find the URL for further information.
#
# Actually, we'll build the URL for GCVS information on this star
# ourselves. All we need from the SIMBAD lines is the proper name
# for the star.
for ($i = 0; $i < $num_reply_lines; $i++) {
# skip ahead to the "identifier" line
if ($_[2 + $i] =~ /^identifier/) {
if ($main::debug > 0) {
print $q->p("get_epoch_period: found 'identifier' info in line ..$_[2 + $i]..");
#$_[2 + $i];
}
last;
}
}
if ($i == $num_reply_lines) {
# there wasn't any "identifier" line
if ($main::debug > 0) {
print $q->p("get_epoch_period: no Catalogue info ... ");
}
return($proc_retval, $name, $epoch_jd, $period);
}
# get the RA and Dec, which occur in the next line ...
for ( ; $i < $num_reply_lines; $i++) {
# CMR Note: You don't really mean "\V" here, do you?
if ($_[2 + $i] =~ /\V\*/) {
if ($main::debug > 0) {
print $q->p("get_epoch_period: found V* in line ..$_[2 + $i].."); #, $_[2 + $i];
}
last;
}
else {
if ($main::debug > 0) {
print $q->p("get_epoch_period: skipping line $i is ..$_[2 + $i]..\n"); #, $_[2 + $i];
}
}
}
if ($i == $num_reply_lines) {
# there wasn't any link to GCVS entry
if ($main::debug > 0) {
print $q->p("get_epoch_period: no GCVS entry ... ");
}
return($proc_retval, $name, $epoch_jd, $period);
}
$line = $_[2 + $i];
chomp($line);
if ($main::debug > 0) {
print $q->p("get_epoch_perod: look for GCVS entry in ..$line.. ");
}
if ($line !~ /.*HREF="(.*)"/) {
# rats! No link to the GCVS query?!
if ($main::debug > 0) {
print $q->p("get_epoch_period: no HREF inside line ..$line.. ?! ");
}
return($proc_retval, $name, $epoch_jd, $period);
}
# the line did have the right format -- here's the link
$simbad_url = $1;
if ($main::debug > 0) {
print $q->p("get_epoch_period: simbad_url is ..$simbad_url..");
}
# we're going to build our own GCVS URL, using the official SIMBAD
# name given in the link we've just isolated.
if ($simbad_url !~ /.*Ident=(V.*?)&/) {
# rats! couldn't parse the variable-star designation?
if ($main::debug > 0) {
print $q->p("get_epoch_period: no var designation inside line ..$simbad_url.. ?! ");
}
return($proc_retval, $name, $epoch_jd, $period);
}
else {
$simbad_varname = $1;
}
# now build a URL for the GCVS entry for this star
if ($main::debug > 0) {
print $q->p("get_epoch_period: simbad_varname is ..$simbad_varname..");
}
$gcvs_url = sprintf "http://vizier.u-strasbg.fr/viz-bin/VizieR-S?%s",
$simbad_varname;
if ($main::debug > 0) {
print $q->p("get_epoch_period: gcvs_url is ..$gcvs_url..");
}
}
# and now we run the GCVS query to get information on the variable star
my $gcvs_ua = LWP::UserAgent->new;
my $gcvs_req = new HTTP::Request ('GET', => $gcvs_url);
$gcvs_reply = $gcvs_ua->request($gcvs_req)->as_string;
if ($main::debug > 0) {
print $q->p("get_epoch_period: gcvs_reply is ..$gcvs_reply.. ");
}
# now we have to scan through the output of the gcvs reply to find
# the values for "Period" and "Epoch"
($gcvs_num_lines, @gcvs_lines) = split_reply($gcvs_reply);
if ($gcvs_num_lines == 0) {
print $q->p("get_epoch_period: gcvs query returns empty?! ");
return($proc_retval, $name, $epoch_jd, $period);
}
# look for the one line which contains the GCVS Name of the variable
$search_string = "Variable star designation";
($retval, $line) = find_reply_line($search_string,
$gcvs_num_lines, @gcvs_lines);
if ($retval != 0) {
print $q->p("get_epoch_period: can't find string $search_string");
return($proc_retval, $name, $epoch_jd, $period);
}
# strip out the name from this line
if ($line !~ /.*Vname=.*?">(.*?)<\/A/) {
print $q->p("get_epoch_period: can't match pattern for name in line ..$line.. ?! ");
return($proc_retval, $name, $epoch_jd, $period);
}
else {
$name = $1;
# and get rid of extra white space
$name =~ s/\s\s+/ /g;
if ($main::debug > 0) {
print $q->p("get_epoch_period: name is ..$name.. ");
}
}
# look for the one line which contains the Epoch of max/min light
$search_string = "Epoch for maximum light";
($retval, $line) = find_reply_line($search_string,
$gcvs_num_lines, @gcvs_lines);
if ($retval != 0) {
print $q->p("get_epoch_period: can't find string $search_string");
return($proc_retval, $name, $epoch_jd, $period);
}
# strip out the Julian Date of max/min light from this line
if ($line !~ /.*\s*([0-9].*)<\/B>/) {
print $q->p("get_epoch_period: can't match pattern for JD in Epoch line ..$line.. ?! ");
return($proc_retval, $name, $epoch_jd, $period);
}
else {
$epoch_jd = $1;
if ($main::debug > 0) {
print $q->p("get_epoch_period: epoch_jd is ..$epoch_jd.. ");
}
}
# look for the one line which contains the Period (in days)
$search_string = "Period of the variable star";
($retval, $line) = find_reply_line($search_string,
$gcvs_num_lines, @gcvs_lines);
if ($retval != 0) {
print $q->p("get_epoch_period: can't find string $search_string");
return($proc_retval, $name, $epoch_jd, $period);
}
# strip out the Period (we assume in days) from this line
if ($line !~ /.*\s*([0-9].*)<\/B>/) {
print $q->p("get_epoch_period: can't match pattern for period in Period line ..$line.. ?! ");
return($proc_retval, $name, $epoch_jd, $period);
return(1);
}
else {
$period = $1;
if ($main::debug > 0) {
print $q->p("get_epoch_period: period is ..$period.. ");
}
}
return($retval, $name, $epoch_jd, $period);
}
###########################################################################
# PROCEDURE: get_radec
#
# DESCRIPTION: We are given an array with lines from the reply to
# our HTTP request to SIMBAD. We scan through them
# for the line with the RA and Dec. After we find it,
# we read the RA and Dec in sexigesimal form and convert
# to decimal degrees.
#
# Actually, there are two possible forms for the data
# returned via SIMBAD. If the user provided a name for the
# star (e.g., "Sirius"), then SIMBAD places the RA and Dec
# of the star in a line signalled by the phrase
# "ICRS 2000.0 coordinates"
#
# On the other hand, if the user didn't provide a name,
# but only (RA, Dec) coordinates, then SIMBAD's reply
# will have a different format. We need to search for
# a line signalled by a line starting with
# "identifier"
#
# So, we check the user's "input_name", and depending
# on its value, we parse the output appropriately.
#
# RETURNS:
# (retval, ra, dec)
# where retval = 0 if all OK, 1 if error
# ra RA (decimal degrees J2000)
# dec Dec (decimal degrees J2000)
#
sub get_radec {
my($input_name);
my($num_lines, $line);
my($i);
my($search_string);
my($retval, $ra, $dec);
my(@words);
my(@words2, $j);
my($rah, $ram, $ras, $decd, $decm, $decs, $sign);
my($q) = $main::q;
$input_name = $_[0];
$num_lines = $_[1];
$retval = 1;
$ra = -99.0;
$dec = -99.0;
# figure out which sort of reply SIMBAD has given ...
if ($input_name ne "") {
# in this case, the user did provide a name, so we key on this
# string in the returned output
$search_string = "ICRS 2000.0 coordinates";
# first, skip lines until we reach a line which starts
# "ICRS 2000.0 coordinates"
for ($i = 0; $i < $num_lines; $i++) {
if ($_[2 + $i] =~ /^$search_string/) {
last;
}
}
if ($i == $num_lines) {
# there wasn't any real data
if ($main::debug > 0) {
print $q->p("get_radec: couldn't find string $search_string ");
}
return($retval, $ra, $dec);
}
# get the RA and Dec, which occur a few lines later ...
$i++;
# skip line
$i++;
# skip line
$i++;
# now we should see a line that starts like this
# 06 45 08.9173 -16 42 58.017
# strip out the , then pick out RA and Dec
$line = $_[2 + $i];
$line =~ s/\//;
@words = split(/\s+/, $line);
$rah = $words[0];
$ram = $words[1];
$ras = $words[2];
$decd = $words[3];
$decm = $words[4];
$decs = $words[5];
if ($main::debug > 0) {
print $q->p("words are rah ..$rah.. ram ..$ram.. ras ..$ras.. ");
print $q->p("words are decd ..$decd.. decm ..$decm.. decs ..$decs.. ");
}
if (substr($decd, 0, 1) eq "-") {
if ($main::debug > 0) {
print $q->p("sign is negative ");
}
$sign = -1;
# make the decd value positive, so we can convert to degrees properly
if ($decd < 0) {
$decd = 0.0 - $decd;
}
}
else {
if ($main::debug > 0) {
print $q->p("sign is positive ");
}
$sign = 1;
}
}
else {
# in this case, the user only provided an (RA, Dec) position. We have
# to sift through the output in a different fashion to get the
# RA and Dec of the star from SIMBAD (which might be more precise
# than that of the user).
$search_string = "identifier";
# first, skip lines until we reach a line which starts
# "identifier"
for ($i = 0; $i < $num_lines; $i++) {
if ($_[2 + $i] =~ /^$search_string/) {
last;
}
}
if ($i == $num_lines) {
# there wasn't any real data
if ($main::debug > 0) {
print $q->p("get_radec: couldn't find string $search_string ");
}
return($retval, $ra, $dec);
}
# get the RA and Dec, which occur in the next line ...
$i++;
# now we should see a line that starts like this
# V* RR Lyr
# this line should have 5 vertical bar field separators in it;
# the RA and Dec lie between the second and third bars,
# in babylonian form with spaces between hours, minutes, seconds
$line = $_[2 + $i];
@words = split(/\|/, $line);
if ($main::debug > 0) {
for ($j = 0; $j <= $#words; $j++) {
print $q->p("words $j is ..$words[$j]..");
}
}
@words2 = split(/\s+/, $words[2]);
$rah = $words2[1];
$ram = $words2[2];
$ras = $words2[3];
$decd = $words2[4];
$decm = $words2[5];
$decs = $words2[6];
if ($main::debug > 0) {
print $q->p("words2 are rah ..$rah.. ram ..$ram.. ras ..$ras.. ");
print $q->p("words2 are decd ..$decd.. decm ..$decm.. decs ..$decs.. ");
}
if (substr($decd, 0, 1) eq "-") {
if ($main::debug > 0) {
print $q->p("sign is negative ");
}
$sign = -1;
# make the decd value positive, so we can convert to degrees properly
if ($decd < 0) {
$decd = 0.0 - $decd;
}
}
else {
if ($main::debug > 0) {
print $q->p("sign is positive ");
}
$sign = 1;
}
}
if ($main::debug > 0) {
print $q->p("get_radec: RA is $rah $ram $ras Dec is $decd $decm $decs");
}
# now convert RA and Dec to decimal degrees
$ra = ($rah*15.0) + ($ram/4.0) + ($ras/240.0);
$dec = abs($decd) + abs($decm/60.0) + abs($decs/3600.0);
$dec *= $sign;
if ($main::debug > 0) {
print $q->p("get_radec: RA is $ra Dec is $dec");
}
# and we're done
$retval = 0;
return($retval, $ra, $dec);
}
#############################################################################
# PROCEDURE: split_reply
#
# DESCRIPTION: Given the entire reply from an HTTP request as a single
# string, break it up into individual lines. Count the lines,
# and create an array with one line per element.
#
# RETURNS:
# (num_of_lines, array_of_lines)
#
sub split_reply {
my($num_reply_lines);
my(@reply_lines);
my($big_reply_string);
my($ll);
my($q) = $main::q;
$big_reply_string = $_[0];
@reply_lines = split(/\n/, $big_reply_string);
$num_reply_lines = 0;
foreach $ll (@reply_lines) {
$num_reply_lines++;
if ($main::debug > 0) {
print $q->p("next ll is ..$ll.. ");
}
}
return($num_reply_lines, @reply_lines);
}
#########################################################################
# PROCEDURE: find_reply_line
#
# DESCRIPTION: Given an array of many lines containing the reply
# from an HTTP request, search them for the (first)
# line containing the given string.
#
# RETURNS:
# (retval, line)
# where retval = 0 if we find it
# 1 if we don't find it
#
# line = the entire line containing the string
#
sub find_reply_line {
my($search_string);
my($num_lines);
my($i);
my($retval, $line);
my($q) = $main::q;
$search_string = $_[0];
$num_lines = $_[1];
# args 2 - N are the lines we'll search
# initialize to "unsuccessful search"
$retval = 1;
for ($i = 0; $i < $num_lines; $i++) {
if ($_[2 + $i] =~ /$search_string/) {
$line = $_[2 + $i];
$retval = 0;
if ($main::debug > 0) {
print $q->p("find_reply_line: found ..$search_string.. in line ");
print $q->p(" ..$line.. ");
}
return($retval, $line);
}
}
# if we get here, there was no match
return($retval, "");
}
###########################################################################
# PROCEDURE: make_phased_graph
#
# DESCRIPTION: Given information about a variable star, including its
# period, and given a bunch of lines with Mark IV measurements,
# create a nice plot of the phased light curve.
#
# RETURNS:
# (proc_retval, plotfile)
# proc_retval = 0 if all goes well, 1 if error
# plotfile name of a file containing the plot
#
sub make_phased_graph {
my($i);
my($proc_retval, $plotfile);
my($name, $ra, $dec, $epoch_jd, $period);
my($num_data_lines, @data_lines);
my($min_v_mag, $max_v_mag);
my($min_i_mag, $max_i_mag);
my($minx, $maxx, $miny, $maxy);
my($retval, $cmd);
my($plotfile) = $main::plotfile;
my($plot_cmd_file) = $main::plot_cmd_file;
my($plot_data_file) = $main::plot_data_file;
my($q) = $main::q;
$proc_retval = 1;
$name = $_[0];
$ra = $_[1];
$dec = $_[2];
$epoch_jd = $_[3];
$period = $_[4];
$file_type = $_[5];
$num_data_lines = $_[6];
for ($i = 0; $i < $num_data_lines; $i++) {
$data_lines[$i] = $_[7 + $i];
}
if ($main::debug > 0) {
print $q->p("make_phased_graph: name is ..$name.. ra is ..$ra.. ");
}
# if there are no data lines, we return with no graph
if ($num_data_lines <= 0) {
print $q->p("make_phased_graph: no data to plot");
return($proc_retval, $plotfile);
}
# if the epoch_jd value is invalid, just pick an arbitrary date for the
# phase = 0. This can happen in the GCVS for some irregular variables
if ($epoch_jd < 0) {
$epoch_jd = 2452000.0;
}
# if the PERIOD is less than zero, then we can't make a phased graph;
# so return with error
if ($period < 0) {
return($proc_retval, $plotfile);
}
# calculate the phase for each observed magnitude, and put data into
# a file with lines that look like this:
#
# JD phase1 phase2 vmag1 vmag2 imag1 imag2
#
if (create_phased_data($plot_data_file, $epoch_jd, $period,
$num_data_lines, @data_lines) != 0) {
print $q->p("make_phased_graph: create_phased_data returns with error");
return($proc_retval, $plotfile);
}
# figure out the min, max values of V-band magnitude
($min_v_mag, $max_v_mag) = find_extreme_mags("V",
$num_data_lines, @data_lines);
($min_i_mag, $max_i_mag) = find_extreme_mags("I",
$num_data_lines, @data_lines);
if ($main::debug > 0) {
print $q->p("min_v_mag is $min_v_mag max_v_mag is $max_v_mag");
}
# figure out the min, max magnitude values on the graph
($minx, $maxx, $miny, $maxy) = find_graph_limits($min_v_mag,
$max_v_mag, $min_i_mag, $max_i_mag);
if ($main::debug > 0) {
print $q->p("graph limits: $minx $maxx $miny $maxy");
}
# open a file to hold GNUPLOT commands
# and put into it all the command necessary to make a nice plot
if (!open(CMD_FILE, ">$plot_cmd_file")) {
print $q->p("make_phased_graph: can't open file $plot_cmd_file");
return($proc_retval, $plotfile);
}
if ($main::debug > 0) {
print $q->p("make_phased_graph: putting commands into $plot_cmd_file");
}
printf CMD_FILE "set output '%s' \n", $plotfile;
#printf CMD_FILE "set term png color \n";
printf CMD_FILE "set term $file_type color \n";
printf CMD_FILE "set grid \n";
printf CMD_FILE "set xlabel 'Phase (two periods shown for clarity)' \n";
printf CMD_FILE "set ylabel 'Magnitude' \n";
printf CMD_FILE "set title 'TASS data on %s using period %.5f' \n",
$name, $period;
# here comes the big command, in which we plot all the data in both bands
# we build this very long line one bit at a time
printf CMD_FILE "plot [%f:%f][%f:%f] '%s' using 2:4 t 'V good' lt 1 pt 1 ",
$minx, $maxx, $miny, $maxy, $plot_data_file;
printf CMD_FILE " , '%s' using 3:4 t '' lt 1 pt 1 ",
$plot_data_file;
printf CMD_FILE " , '%s' using 2:5 t 'V flag' lt 1 pt 4 ps 0.8 " ,
$plot_data_file;
printf CMD_FILE " , '%s' using 3:5 t '' lt 1 pt 4 ps 0.8 " ,
$plot_data_file;
printf CMD_FILE " , '%s' using 2:6 t 'I good' lt 2 pt 1 ",
$plot_data_file;
printf CMD_FILE " , '%s' using 3:6 t '' lt 2 pt 1 ",
$plot_data_file;
printf CMD_FILE " , '%s' using 2:7 t 'I flag' lt 2 pt 4 ps 0.8 ",
$plot_data_file;
printf CMD_FILE " , '%s' using 3:7 t '' lt 2 pt 4 ps 0.8 ",
$plot_data_file;
printf CMD_FILE "\n";
close(CMD_FILE);
# execute the "gnuplot" program on the commands to create
# a file holding the graph
$cmd = "$main::gnuplot $plot_cmd_file";
$retval = `$cmd 2>&1`;
if ($? != 0) {
print $q->p("make_phased_graph: gnuplot returns with error ");
print $q->p("$retval");
return($proc_retval, $plotfile);
}
# all is done
$proc_retval = 0;
return($proc_retval, $plotfile);
}
#############################################################################
# PROCEDURE: find_extreme_mags
#
# DESCRIPTION: Given a passband and an array of data lines from
# Mark IV database, find the min and max values of the
# magnitude in the given band. We have some default
# values which are "sensible" in case there are
# no valid values.
#
# RETURNS:
# (min_mag, max_mag)
#
sub find_extreme_mags {
my($i);
my($default_min_mag, $default_max_mag);
my($bad_min_mag, $bad_max_mag);
my($min_mag, $max_mag);
my($passband);
my($mag, $mag_column);
my($line, @words);
my($num_lines);
my($q) = $main::q;
$passband = $_[0];
$num_lines = $_[1];
if ($main::debug > 0) {
print $q->p("find_extreme_mags: passband ..$passband.. num_lines $num_lines");
}
if ($passband eq "V") {
$mag_column = 7;
}
elsif ($passband eq "I") {
$mag_column = 11;
}
else {
print $q->p("find_extreme_mags: given bad passband $passband -- abort");
return(0);
}
# these will signal no real data if they persist
$bad_min_mag = 100;
$bad_max_mag = -100;
# these are sensible defaults
$default_min_mag = 6.0;
$default_max_mag = 15.0;
# find the min, max values in the data
$min_mag = $bad_min_mag;
$max_mag = $bad_max_mag;
for ($i = 0; $i < $num_lines; $i++) {
$line = " " . $_[2 + $i];
@words = split(/\s+/, $line);
$mag = $words[$mag_column];
if ($main::debug > 0) {
print $q->p("find_extreme_mags: passband $passband line $i mag $mag");
}
# we don't include values of 99
if ($mag > 90) {
next;
}
if ($mag < $min_mag) {
$min_mag = $mag;
}
if ($mag > $max_mag) {
$max_mag = $mag;
}
}
if ($min_mag == $bad_min_mag) {
$min_mag = $default_min_mag;
}
if ($max_mag == $bad_max_mag) {
$max_mag = $default_max_mag;
}
return($min_mag, $max_mag);
}
#############################################################################
# PROCEDURE: find_graph_limits
#
# DESCRIPTION: Given the min,max V and min,max I magnitudes of star,
# figure out good limits for a phased light curve.
# The "x" values are phase, and "y" values are magnitudes
# (with min at top and max at bottom)
#
# RETURNS:
# (minx, maxx, miny, maxy)
#
sub find_graph_limits {
my($extra);
my($min_v, $max_v, $min_i, $max_i);
my($min_mag, $max_mag, $delta_mag);
my($minx, $maxx, $miny, $maxy);
my($q) = $main::q;
$min_v = $_[0];
$max_v = $_[1];
$min_i = $_[2];
$max_i = $_[3];
if ($min_v < $min_i) {
$min_mag = $min_v;
}
else {
$min_mag = $min_i;
}
if ($max_v > $max_i) {
$max_mag = $max_v;
}
else {
$max_mag = $max_i;
}
# the limits in phase are simple
$minx = -0.1;
$maxx = 2.1;
# the limits in magnitude are harder -- we allow a little extra
# room at top and bottom
$delta_mag = $max_mag - $min_mag;
$extra = $delta_mag*0.10;
$miny = $max_mag + $extra;
$maxy = $min_mag - 2.0*$extra;
if ($main::debug > 0) {
print $q->p("find_graph_limits: X $minx $maxx Y $miny $maxy ");
}
return($minx, $maxx, $miny, $maxy);
}
#############################################################################
# PROCEDURE: create_phased_data
#
# DESCRIPTION: Given a filename, epoch, period, an array of data on
# a particular star, calculate the phase for each
# time of measurement. Create a datafile with format
#
# JD phase1 phase+1 vmag1 vmag2 imag1 imag2
#
# where vmag1 is the V-band mag, if no warning flags
# vmag2 is the V-band mag, if warning flag set
# imag1 is the I-band mag, if no warning flags
# imag2 is the I-band mag, if warning flag set
#
# We use a value of 99.0 for any mag which we're not going
# to plot.
#
# Write the datafile to disk.
#
# RETURNS:
# 0 if all goes well
# 1 if an error occurs
#
sub create_phased_data {
my($i);
my($retval);
my($datafile_name);
my($epoch_jd, $period);
my($num_lines);
my($line, @words);
my($jd, $vmag, $vsig, $vflag, $imag, $isig, $iflag);
my($phase, $x);
my($vmag1, $vmag2, $imag1, $imag2);
my($q) = $main::q;
# by default, we haven't succeeded
$retval = 1;
$datafile_name = $_[0];
$epoch_jd = $_[1];
$period = $_[2];
$num_lines = $_[3];
if ($main::debug > 0) {
print $q->p("create_phased_data: file $datafile_name epoch $epoch_jd period $period ");
}
# sanity checks
if ($epoch_jd < 0) {
print $q->p("create_phased_data: bad epoch $epoch_jd");
return($retval);
}
if ($period <= 0) {
print $q->p("create_phased_data: bad period $period");
return($retval);
}
if (!open(PHASED_DATA, ">$datafile_name")) {
print $q->p("create_phased_data: can't open $datafile_name");
return($retval);
}
for ($i = 0; $i < $num_lines; $i++) {
$line = " " . $_[4 + $i];
@words = split(/\s+/, $line);
$jd = $words[5];
$vmag = $words[7];
$vsig = $words[8];
$vflag = $words[9];
$imag = $words[11];
$isig = $words[12];
$iflag = $words[13];
if ($main::debug > 0) {
print $q->p("create_phased_data: jd $jd vmag $vmag imag $imag");
}
$x = ($jd - $epoch_jd)/$period;
$phase = $x - floor($x);
if ($main::debug > 0) {
print $q->p("create_phased_data: phase $phase ");
}
# look at flags, set the quantities we'll print
if ($vflag == 0) {
$vmag1 = $vmag;
$vmag2 = 99.0;
}
else {
$vmag1 = 99.0;
$vmag2 = $vmag;
}
if ($iflag == 0) {
$imag1 = $imag;
$imag2 = 99.0;
}
else {
$imag1 = 99.0;
$imag2 = $imag;
}
# now we print a line into the output datafile
printf PHASED_DATA " %12.5f %7.3f %7.3f %7.3f %7.3f %7.3f %7.3f \n",
$jd, $phase, $phase+1.0, $vmag1, $vmag2, $imag1, $imag2;
}
close(PHASED_DATA);
# if we get here, all is well!
$retval = 0;
return($retval);
}
#############################################################################
# PROCEDURE: create_plot_url
#
# DESCRIPTION: We have created a file on disk which contains a graphical
# image of the light curve, something like this:
#
# /var/www/html/temp/make_phase_3331.png
#
# The start of this full path is the $www_dir. We want to
# replace that portion of the path with an equivalent
# URL, pointing to exactly the same directory, but
# accessible to people on other machines via HTTP.
#
# All we need to do is replace the $www_dir portion
# of the full name with $site_url variable. These are
# globals defined at the top of this source code file.
# We should end up with something that looks like
#
# http://spiff.rit.edu/html/temp/make_phase_3331.png
#
#
# RETURNS:
# the full URL
#
sub create_url_name {
my($plot_file, $plot_url);
$plot_file = $_[0];
if ($main::debug > 0) {
print $q->p("create_url_name: original name is $plot_file");
}
$plot_url = $plot_file;
$plot_url =~ s/$www_dir/$site_url/;
if ($main::debug > 0) {
print $q->p("create_url_name: new name is $plot_url");
}
return($plot_url);
}
###########################################################################
# PROCEDURE: remove_control_chars
#
# DESCRIPTION: Given a string, return a copy from which all "control"
# characters (ASCII code < 32) have been removed.
#
# RETURNS:
# "clean" version of the string
#
sub remove_control_chars {
my($old, $new, $len, $i, $char);
$old = $_[0];
$new = "";
$len = length($old);
for ($i = 0; $i < $len; $i++) {
$char = substr($old, $i, 1);
if (ord($char) >= 32) {
$new .= $char;
}
}
return($new);
}
###########################################################################
# PROCEDURE: generate_new_filenames
#
# DESCRIPTION: We need to create unique versions of the global variables
# plotfile plot_cmd_file plot_data_file
#
# They have values which look something like
#
# make_phased_5123QxQ.dat
#
# What we do is modify the character(s) between the
# capital Qs. We replace those character(s) with
# the argument to this function. For example, if the
# function is called with arg "1", then we get
#
# make_phased_5123Q1Q.dat
#
# or, if called with arg "23", we get
#
#
# make_phased_5123Q23Q.dat
#
# RETURNS:
# 0 to indicate that all went well
#
sub generate_new_filenames {
my($index, $stuff);
$index = $_[0];
if ($plotfile =~ /.*Q(.*)Q/) {
$stuff = $1;
$plotfile =~ s/Q${stuff}Q/Q${index}Q/;
}
else {
print $q->p("generate_new_filenames: bad format for plotfile $plotfile ?!");
print $q->p("aborting ... ");
return(1);
}
if ($plot_cmd_file =~ /.*Q(.*)Q/) {
$stuff = $1;
$plot_cmd_file =~ s/Q${stuff}Q/Q${index}Q/;
}
else {
print $q->p("generate_new_filenames: bad format for plot_cmd_file $plot_cmd_file ?!");
print $q->p("aborting ... ");
return(1);
}
if ($plot_data_file =~ /.*Q(.*)Q/) {
$stuff = $1;
$plot_data_file =~ s/Q${stuff}Q/Q${index}Q/;
}
else {
print $q->p("generate_new_filenames: bad format for plot_data_file $plot_data_file ?!");
print $q->p("aborting ... ");
return(1);
}
return(0);
}
############################################################
# Take two Benchmark timestamps and find out
# the time difference between the two.
#
# Return: time in minutes, time in seconds.
#
sub diff_time {
my ($t0, $t1) = @_;
my ($td) = "";
my ($total_time) = "";
my (@total_time) = ();
my ($total_sec) = "";
my ($total_min) = "";
$td = timediff($t1, $t0);
$total_time = timestr($td);
$total_time =~ tr / //s;
if ($total_time =~ /^ /) { $total_time =~ s/^ //; }
@total_time = split(/ /, $total_time);
my ($time_sec) = @total_time[0];
use integer;
my ($time_min) = $time_sec/60;
no integer;
if (length($time_min) == 1) { $time_min = "0" . $time_min; }
if (length($time_sec) == 1) { $time_sec = "0" . $time_sec; }
return ($time_min, $time_sec);
}
|