package Subs::UvotProduct;
##############################################################################
#
# DESCRIPTION: Produce UVOT products: 2 gif lightcurve files
#
# NOTE: By this point in the processing, the job.par "target" parameter
# has been adjusted so that it agrees with the sequence id, if it
# didn't initially (eg. for remapped sequences).
#
# NOTE: The get*coord* methods are also called (illegally!) by
# XrtGrbLc::make_xrt_grb_lc and XrtProducts::GetRaDec, and the getTrig*
# methods by XrtGrbLc::make_xrt_grb_lc and BATImages::plotimages.
# Therefore calls to other methods in this package by get*coord* and
# getTrig* (currently only convertRA/DecStringToDegrees and convertTG)
# need to be "fully qualified" with Subs::UvotProduct::methodname.
# These methods ought to be split out into their own packages and either
# instantiated as objects or inheritted by UvotProduct, XrtGrbLc, and
# XrtProducts.
#
# HISTORY:
# $Log: UvotProduct.pm,v $
# Revision 1.21 2013/07/16 05:35:23 apsop
# Get URLs for querying JD's GRB catalog from parameters JDCatCoords
# and JDCatTrigs, in get_grb_coord and getTrigFromJDCatalog.
#
# Revision 1.20 2013/06/11 20:55:52 apsop
# sub getTrigFromJDCatalog now reads the GRB name
# from the catalog to get the burst date, fixing an
# issue trying to get the trigger time when we don't yet
# have a standard GRB name. It uses the new lookup
# program grb_lookupLC3.php. Also expanded some comments.
#
# Revision 1.19 2013/04/29 22:05:56 apsop
# getTrigFromJDCatalog: Check that $GRB has the YYMMDDL format
# before trying to convert trigger_time to MET.
#
# Revision 1.18 2013/04/03 21:50:51 apsop
# Bug fixes, sub getTrigFromJDCatalog: 1 don't strip "GRB" from
# $GRB until see whether need to use trigid; 2.fixed sense of
# test for $catErrors.
#
# Revision 1.17 2013/01/30 04:51:38 apsop
# Bug fix: $procpar wasn't defined in get_grb_coord and getTRrigFromJDCatalog
#
# Revision 1.16 2012/10/17 08:12:02 apsop
# Bug fix: watchers_JDcat is in $procpar not $jobpar.
#
# Revision 1.15 2012/10/05 07:30:34 apsop
# - Remove all leading 0s from target/trigger id's not just first 2
# (eg. GRBs Discovered Elsewhere may be in 0002xxxx range).
# - Compare target/trigids vs. database numerically, in case database
# entry had leading 0s. Check that field we parsed from database
# is a number, to handle missing data.
# - In sub convertTG, allow trigtime to have optional fractional
# seconds and separate the date/time parts with either T or spaces.
# - Tweaked up the log entries so can tell if matched on GRB name or
# trigger/target id.
#
# Revision 1.14 2012/08/31 08:34:03 apsop
# JRG:
# - Lots of extra log entries to tell which GRB coordinates are
# used, why, and from which catalog.
# - Read name of Lorella's/Davide's catalog from sw0.par param GrbCat
# instead of being hardcoded. (get_swiftgrb_coord,getTrigFromSWIFTCatalog)
# - Only copy the catalogs in if don't already have them.
# (get_swiftgrb_coord, get_grb_coord_local, getTrigFromSWIFTCatalog,
# getTrigFromLocalCatalog)
# - Bug fix: Keep trailing null fields when split catalog lines, to
# prevent crash when catalog has the entry but it hasn't been filled
# in yet. (get_swiftgrb_coord, get_grb_coord_local,
# getTrigFromSWIFTCatalog, getTrigFromLocalCatalog)
# - Sanity checks that values read from catalogs are numbers.
# (get_swiftgrb_coord, get_grb_coord_local)
# - (No change here, but queries of JD's catalog by trig_id are fixed.)
# - Report source of trigger time. (AddTrigtime)
# - Lots of formatting and comment improvements.
#
# Revision 1.13 2012/02/15 01:36:01 apsop
# Call convertRA/DecStringToDegrees as self->Subs::UvotProduct::..., so they
# work when get_grb_coord is called by XrtGrbLc and XrtProducts (which it
# shouldn't be, but is). I think all the other method calls that need to do
# this already do.
#
# Revision 1.12 2012/01/12 06:52:03 apsop
# Changes going to proc3.15.03
#
# 2011-12-13 JRG: Checking if is a number with eval($value * 1.0) didn't
# work (just gave a warning, not trappable errors); replaced with
# Scalar::Util::looks_like_number(). Also added some diagnostic outputs.
# 2011-12-11 JRG: convertRA/DecSTringToDegrees always returns string,
# null if success; check as boolean. Improved regex for determining
# if should call convertRA/Dec routines.
# 2011-11-03 JRG: Made convertRAStringToDegrees, convertDecStringToDegrees
# into methods (needed to use $log), called with $self->.
# Changed warnings that GRBs not found in individual catalogs into
# informational entries. Added warning if not found in any catalog
# to AddTrigtime.
# 2011-10-12 JRG: Email watchers_JDcat if find trigger_time problem in
# JD's catalog. convertTG now returns undef if error.
# 2011-10-07 JRG: Email watchers_JDcat if problem in JD's catalog.
# 2011-09-30 JRG: In getTrigFromJDCatalog, search for trigger_time only.
# 2011-09-26 JRG: Add checks on results in convertRA/DecStringToDegrees
# 2011-09-23 JRG: Make get_grb_coord and getTrigFromJDCatalog generally
# more robust, in particular check for decimal numbers.
# 2011-09-21 JRG: In get_grb_coord and getTrigFromJDCatalog, check for
# retrieved values = "TBD".
# - In convertRAStringToDegrees and convertDecStringToDegrees, replace
# regex for decimal numbers with "Frank's standard".
# 2011-08-17 by JRG: - Read sw0.par targetsSkipFC (Skip Finder Charts)
# to set fcprefix=NONE so uvotproduct skips ds9 calls
# - When reading catalogs, upcase GRB because object par may have lower
# - Added some info msgs when reading catalogs
# - Fixed bugs pattern matching GRB vs tgrb from catalogs
#
# VERSION: 0.0
#
#
#
##############################################################################
use Subs::Sub;
use Util::Log;
use Scalar::Util "looks_like_number";
#@ISA = ("Subs::Sub","Util::Log");
@ISA = ("Subs::Sub");
use strict;
sub new {
my $proto=shift;
my $self=$proto->SUPER::new();
$self->{DESCRIPTION}="Make UVOT products: 2 gif lightcurves";
return $self;
}
##################
# METHODS:
##################
sub body {
my $self=shift;
my $log = $self->log();
my $filename = $self->filename();
my $jobpar = $self->jobpar();
##################################
# make uvot 2 lightcurve gif files
##################################
$self->make_uvot_gif_files();
} # end of body method
#############################################################################
# produce 2 uvot grb light curve gif files
#############################################################################
sub make_uvot_gif_files {
my $self=shift;
my $log = $self->log();
my $filename = $self->filename();
my $jobpar = $self->jobpar();
my $procpar = $self->procpar();
my $watchers = $procpar->read("watchers");
my $trigtime = $jobpar->read('burst_time');
###########FIND GRB only
my $trigid =$jobpar->read('sequence');
$trigid =~ s/\d{3}$//;
$trigid = $trigid * 1; # converts to number
my $key1=0;
my $key2=0;
if (20000<=$trigid && $trigid<30000) {
$key1=1;
}
if ($trigid>=100000) {
$key2=1;
}
if ( ! ($key1 + $key2) ) {
$log->error(1, "This is not GRB, not making UVOT GIF files: exit 1");
return;
}
########CHECK IF WE HAVE ALL FILES NEEDED##############
my @imglist1=$filename->get('filterimg', 'uvot', '*', '*');
if (! @imglist1) {
$log->error(1, "No Uvot image file not exist, exit 1");
return ;
}
my @imglist2=();
foreach my $f (@imglist1) {
if ($f =~m/\S+ugu*/) {
next;
} #exclude grism files
push(@imglist2, $f);
}
if (! @imglist2) {
$log->error(1, "No Uvot image file not exist other than grism, exit 1");
return ;
}
#################################ADD KEYWORDS
$self->Subs::XrtGrbLc::write_standard_keyword(@imglist2);
#################################ADD KEYWORDS
my $rv = $self->AddTrigtime(\@imglist2, $trigtime, $trigid);
my $trigstr = 'TRIGTIME';
if($rv == 0){
$log->error(1, "TRIGTIME not defined, Unable to proceed");
my $enddate = $jobpar->read("enddate");
my $endtime = $jobpar->read("endtime");
my $dateobj = Util::Date->new($enddate, $endtime);
my $emjd = $dateobj->mjd();
my $ndateobj = Util::Date->new();
my $nmjd = $ndateobj->mjd();
my $alerT = $procpar->read("alerTime");
if (!defined $alerT ) {
$alerT = 2.0;
}
my $dt = $nmjd - $emjd;
if ($dt > $alerT) {
my $object = $jobpar->read('object');
my $trigid = $jobpar->read('sequence');
my $target = $jobpar->read('target');
my $subject = "Unable to obtain TRIGTIME from database or GRB catalog";
my $msg = "Unable to find info about TRIGTIME (burst_time) in either database\nor GRB catalogs for the following GRB:\n\nobject= $object\nsequence= $trigid\ntarget= $target\n\n\tPlease, make sure that such info is actually available.\n\n\tYou can add the required info to the local GRB catalog\nby using\n\n/data/sdc/local/data/sdc4/apsop/Processman/PMT/bin/AddGRB.pl\n\n";
$self->Subs::XrtGrbLc::sendEmail($subject, $msg, $watchers);
}
return;
}
my $imglist = join(',', @imglist2);
my ($batpos,$xrtpos,$uvotpos,$groundpos)=0;
my($t,$t1,@table,@t8)=0;
my($i,$x,$xx,$y,$z,$zz)=0;
my ($batra,$batdec,$baterr,$xrtra,$xrtdec,$xrterr,$uvotra,$uvotdec,$uvoterr)=0;
##########GET GRB COORD
#
# First try local catalog, if it fails try Lorella's catalog,
# then try JD's catalog, and finally send an email.
# Read local catalog. Returns refPL=-1 if not a GRB.
my $refPL = $self->Subs::UvotProduct::get_grb_coord_local();
if (defined $refPL and $refPL == -1){
return;
}
# Lorella's catalog
my $refP = $self->Subs::UvotProduct::get_swiftgrb_coord();
my $catRead = "Lorella";
# JD's catalog
if (!defined $refP){
$refP = $self->Subs::UvotProduct::get_grb_coord();
$catRead = "JD";
}
if (!defined $refP and !defined $refPL) {
my $enddate = $jobpar->read("enddate");
my $endtime = $jobpar->read("endtime");
my $dateobj = Util::Date->new($enddate, $endtime);
my $emjd = $dateobj->mjd();
my $ndateobj = Util::Date->new();
my $nmjd = $ndateobj->mjd();
my $alerT = $procpar->read("alerTime");
if (!defined $alerT ) {
$alerT = 2.0;
}
my $dt = $nmjd - $emjd;
if ($dt > $alerT) {
my $object = $jobpar->read('object');
my $trigid = $jobpar->read('sequence');
my $target = $jobpar->read('target');
my $subject = "GRB not found in catalogs";
my $msg = "Unable to find GRB info in all catalogs for:\n" .
"object= $object\n" .
"sequence= $trigid\n" .
"target= $target\n\n" .
"\tPlease, make sure that such info is actually available.\n\n" .
"\tYou can add the required info to the local GRB catalog\n" .
"by using\n\n" .
"/data/sdc/local/data/sdc4/apsop/Processman/PMT/bin/AddGRB.pl\n\n";
$self->Subs::XrtGrbLc::sendEmail($subject, $msg, $watchers);
}
$log->error(1, "Unable to find GRB in catalogs. Email notice sent to $watchers");
return;
}
my @rItems = qw/bat_ra bat_dec bat_pos_err xrt_ra xrt_dec xrt_pos_err
uvot_ra uvot_dec uvot_pos_err ot_ra ot_dec ot_pos_err/;
if (defined $refPL){
if (!defined $refP){
foreach my $it (@rItems){
$refP->{$it} = $refPL->{$it};
}
$log->entry("Using all coordinates from Local Catalog");
} else {
if ((defined $refPL->{bat_over} and $refPL->{bat_over} == 1) or
(!defined $refP->{bat_ra} or !defined $refP->{bat_dec})) {
$refP->{bat_ra} = $refPL->{bat_ra};
$refP->{bat_dec} = $refPL->{bat_dec};
$refP->{bat_pos_err} = $refPL->{bat_pos_err};
$log->entry("BAT invalid in $catRead cat, or Local override");
$log->entry("Using BAT coordinates from Local Catalog");
} else {
$log->entry("Using BAT coordinates from $catRead Catalog");
}
if ((defined $refPL->{xrt_over} and $refPL->{xrt_over} == 1) or
(!defined $refP->{xrt_ra} or !defined $refP->{xrt_dec})) {
$refP->{xrt_ra} = $refPL->{xrt_ra};
$refP->{xrt_dec} = $refPL->{xrt_dec};
$refP->{xrt_pos_err} = $refPL->{xrt_pos_err};
$log->entry("XRT invalid in $catRead cat, or Local override");
$log->entry("Using XRT coordinates from Local Catalog");
} else {
$log->entry("Using XRT coordinates from $catRead Catalog");
}
if ((defined $refPL->{ot_over} and $refPL->{ot_over} == 1) or
(!defined $refP->{ot_ra} or !defined $refP->{ot_dec})) {
$refP->{ot_ra} = $refPL->{ot_ra};
$refP->{ot_dec} = $refPL->{ot_dec};
$refP->{ot_pos_err} = $refPL->{ot_pos_err};
$log->entry("OPT invalid in $catRead cat, or Local override");
$log->entry("Using OPT coordinates from Local Catalog");
} else {
$log->entry("Using OPT coordinates from $catRead Catalog");
}
if ((defined $refPL->{uvot_over} and $refPL->{uvot_over} == 1) or
(!defined $refP->{uvot_ra} or !defined $refP->{uvot_dec})) {
$refP->{uvot_ra} = $refPL->{uvot_ra};
$refP->{uvot_dec} = $refPL->{uvot_dec};
$refP->{uvot_pos_err} = $refPL->{uvot_pos_err};
$log->entry("UVOT invalid in $catRead cat, or Local override");
$log->entry("Using UVOT coordinates from Local Catalog");
} else {
$log->entry("Using UVOT coordinates from $catRead Catalog");
}
}
} else {
$log->entry("Using all coordinates from $catRead Catalog");
}
if ( defined($refP->{bat_ra}) and defined($refP->{bat_dec}) and
defined($refP->{bat_pos_err}) ) {
$log->entry("BAT RA, Dec, Err used = " . $refP->{bat_ra} . ", " .
$refP->{bat_dec} . ", " . $refP->{bat_pos_err});
} else {
$log->entry("No BAT coordinates.");
}
if ( defined($refP->{xrt_ra}) and defined($refP->{xrt_dec}) and
defined($refP->{xrt_pos_err}) ) {
$log->entry("XRT RA, Dec, Err used = " . $refP->{xrt_ra} . ", " .
$refP->{xrt_dec} . ", " . $refP->{xrt_pos_err});
} else {
$log->entry("No XRT coordinates.");
}
if ( defined($refP->{ot_ra}) and defined($refP->{ot_dec}) and
defined($refP->{ot_pos_err}) ) {
$log->entry("OPT RA, Dec, Err used = " . $refP->{ot_ra} . ", " .
$refP->{ot_dec} . ", " . $refP->{ot_pos_err});
} else {
$log->entry("No OPT coordinates.");
}
if ( defined($refP->{uvot_ra}) and defined($refP->{uvot_dec}) and
defined($refP->{uvot_pos_err}) ) {
$log->entry("UVOT RA, Dec, Err used = " . $refP->{uvot_ra} . ", " .
$refP->{uvot_dec} . ", " . $refP->{uvot_pos_err});
} else {
$log->entry("No UVOT coordinates.");
}
############ARRAY OF ALL GRB COORD AND ERRORS @t8:
# 0 1 2 3 4 5 6 7 8
@t8=($batra,$batdec,$baterr,$xrtra,$xrtdec,$xrterr,$uvotra,$uvotdec,$uvoterr);
############INIT :
$batpos=$xrtpos=$uvotpos=""; $groundpos='NONE';
###########IF XRT COORD NOT AVAILABLE THEN EXIT :
if ((!defined $refP->{xrt_ra} or !defined $refP->{xrt_dec} or
!defined $refP->{xrt_pos_err}) or
(defined $refPL->{xrt_bad_data} and $refPL->{xrt_bad_data} == 1)){
$log->entry("make_uvot_gif_files: No good XRT coordinates found, bailing!");
$log->error(1, "BAT coordinates only not enough: exit 1");
return ;
}
#########DEC>90 <-90
if ((defined $refP->{bat_dec} and abs($refP->{bat_dec}) > 90) ||
(defined $refP->{xrt_dec} and abs($refP->{xrt_dec}) > 90) ||
(defined $refP->{uvot_dec} and abs($refP->{uvot_dec}) > 90)){
$log->error(2, "DEC coordinates >90, <-90 need fix: exit 1");
return ;
}
###########ERR TOO BIG
if ((defined $refP->{xrt_pos_err} and $refP->{xrt_pos_err} > 10) or
(defined $refP->{uvot_pos_err} and $refP->{uvot_pos_err} > 5)) {
$log->error(2, "XRT err>10, UVOT err>5 need fix: exit 1");
return ;
}
###########ERR TOO BIG >3
# if($t8[2]>3 || $t8[5]>3 || $t8[8]>3){#or >4 ?
# $log->error(2, "BAT,XRT,UVOT err>3, uvotproduct not ran: exit 1");
# return ;
# }
###########IF UVOT COORD NOT AVAILABLE REPLACE WITH NONE :
if ((!defined $refP->{uvot_ra} or !defined $refP->{uvot_dec} or !defined $refP->{uvot_pos_err}) or
(defined $refPL->{uvot_bad_data} and $refPL->{uvot_bad_data} == 1)){
$uvotpos='NONE';
} else {
$uvotpos='FOUND';
}
if ((!defined $refP->{ot_ra} or !defined $refP->{ot_dec} or !defined $refP->{ot_pos_err}) or
(defined $refPL->{ot_bad_data} and $refPL->{ot_bad_data} == 1)){
$groundpos='NONE';
} else {
$groundpos='FOUND';
}
###########PREPARE GRB COORD TO UVOTPRODUCT :
# 0 1 2 3 4 5 6 7 8
#@t8=($batra,$batdec,$baterr,$xrtra,$xrtdec,$xrterr,$uvotra,$uvotdec,$uvoterr);
my $srcreg='';
if($uvotpos ne 'NONE'){
$uvotpos=($refP->{uvot_dec}>0 ?
$refP->{uvot_ra}.'+'.$refP->{uvot_dec}.'~'.$refP->{uvot_pos_err} :
$refP->{uvot_ra}.$refP->{uvot_dec}.'~'.$refP->{uvot_pos_err});
if ($srcreg eq '') {
$srcreg="fk5;circle\(".$refP->{uvot_ra}.','.
$refP->{uvot_dec}.','.$refP->{uvot_pos_err}."\")";
}
}
#my($gr,$grra,$grdec,$grerr,$grb)=0;
if ($groundpos ne 'NONE') {
$groundpos=($refP->{ot_dec}>0 ?
$refP->{ot_ra}.'+'.$refP->{ot_dec}.'~'.$refP->{ot_pos_err} :
$refP->{ot_ra}.$refP->{ot_dec}.'~'.$refP->{ot_pos_err} );
if ($srcreg eq '') {
$srcreg="fk5;circle\(".$refP->{ot_ra}.','.$refP->{ot_dec}.','.
$refP->{ot_pos_err}."\")";
}
}
if (defined $refP->{xrt_dec} and
defined $refP->{xrt_ra} and
defined $refP->{xrt_pos_err}) {
$xrtpos =($refP->{xrt_dec}>0 ?
$refP->{xrt_ra}.'+'.$refP->{xrt_dec}.'~'.$refP->{xrt_pos_err} :
$refP->{xrt_ra}.$refP->{xrt_dec}.'~'.$refP->{xrt_pos_err});
if (!$srcreg) {
$srcreg="fk5;circle\(".$refP->{xrt_ra}.','.$refP->{xrt_dec}.','.
$refP->{xrt_pos_err}."\")";
}
}
if (defined $refP->{bat_ra} and
defined $refP->{bat_dec} and
defined $refP->{bat_pos_err}) {
$refP->{bat_pos_err} = $refP->{bat_pos_err} * 60.0;
$batpos =($refP->{bat_dec}>0 ?
$refP->{bat_ra}.'+'.$refP->{bat_dec}.'~'.$refP->{bat_pos_err} :
$refP->{bat_ra}.$refP->{bat_dec}.'~'.$refP->{bat_pos_err});
} else {
$batpos = 'NONE';
}
if (defined $refP->{xrt_pos_err} && $uvotpos eq 'NONE' && $refP->{xrt_pos_err} >3) {
my $xer = $refP->{xrt_pos_err};
$srcreg=~s/(\S+\d+\.\d+),(\d+\.\d+),(\d+\.\d+)\"\)/$1,$2,$xer\"\)/;
}
open(F,">src.reg");
print F "$srcreg\n";
close(F);
########MAKE UVOT GRB LIGHT CURVE 2 GIF FILES##############
################NEW DEVELOP UVOTPRODUCT :
#my $cmd="uvotproduct infile=$imglist outfile=maghist.fits plotfile=maghist.gif batpos=$batpos xrtpos=$xrtpos uvotpos=$uvotpos reportfile=summary.txt chatter=5 groundpos=$groundpos, srcreg=src.reg bkgreg=DEFAULT ";
# system("source /software/lheasoft/develop/headas.sh;$cmd");
#################RELEASE UVOTPRODUCT :
my $plotfile = $filename->get("lcplot", "uvot", "sr", 0);
my $maghist = $filename->get("lightcurve","uvot","sr",0);
# Set finder-chart prefix; to NONE if target is in sw0.par parameter
# targetsSkipFC, which will prevent the uvotproduct ftool from trying
# to call ds9.
my $targetsSkipFC = $procpar->read('targetsSkipFC');
$targetsSkipFC =~ s/^ *//; # remove leading WS
$targetsSkipFC =~ s/[\s,]*$//; # remove trailing , or WS
my @skipFcList = split( /[\s,]+/, $targetsSkipFC ); #split on , or WS
my $fcprefix = $jobpar->read('mission'). $jobpar->read('sequence');
# look for $trigid in @skipFcList, AS NUMBERS (==)
if ( grep($_ == $trigid, @skipFcList) ) {
$fcprefix = "NONE";
$log->entry( "UvotProduct.pm: trigid $trigid found in targetsSkipFC: uvotproduct fcprefix=NONE, finder charts not created");
}
my $uvotproduct=Util::HEAdas->new("uvotproduct")->is_script(1);
$uvotproduct->params({
infile => $imglist,
outfile => $maghist,
plotfile => $plotfile,
srcreg => 'src.reg',
bkreg => 'DEFAULT',
batpos => $batpos,
xrtpos => $xrtpos,
uvotpos => $uvotpos,
groundpos=> $groundpos,
reportfile => 'report.txt',
timezero => $trigstr,
plotmag => 'yes',
fcprefix => $fcprefix,
zerofile => 'CALDB',
coinfile => 'CALDB',
psffile => 'CALDB',
lssfile => 'NONE',
apercorr => 'CURVEOFGROWTH',
nsigma => 3.0,
exclude => 'DEFAULT',
frametime => 'DEFAULT',
centroid => 'no',
fwhmsig => -1,
rebin => 'DEFAULT',
clobber => 'yes',
cleanup => 'yes',
chatter => 5,
qdpfile => 'NONE',
mode => 'ql'
});
$uvotproduct->verbose( 2 );
$uvotproduct->seriousness( 1 );
$uvotproduct->run();
my $plotfile1 = $filename->get("lcplot", 'uvot', 'sr', 1);
my $plotfile2 = $filename->get("lcplot", 'uvot', 'sr', 2);
my $prefix = (split/\./, $plotfile)[0];
my $p1 = $prefix.'1.gif';
my $p2 = $prefix.'2.gif';
my $p3 = $prefix.'3.gif';
my $plotfile3 = $filename->get("lcplot", 'uvot', 'sr', 3);
if(-e $p1){
rename $p1, $plotfile1;
}
if(-e $p2){
rename $p2, $plotfile2;
}
if(-e $p3){
rename $p3, $plotfile3;
}
if(-e $fcprefix.'_dss.jpg'){
my $infile = $fcprefix.'_dss.jpg';
my $ofile = $fcprefix.'udss_skim.gif';
system("/usr/bin/convert $infile $ofile");
if(-e $ofile){
unlink $infile;
}
}
if(-e $fcprefix.'_uvot.jpg'){
my $infile = $fcprefix.'_uvot.jpg';
my $ofile = $fcprefix.'ufc_skim.gif';
system("/usr/bin/convert $infile $ofile");
if(-e $ofile){
unlink $infile;
}
}
}# end of make_uvot_gif_files method
##########################################################
# convertRAStringToDegrees -
#
# converts RA in HH:MM:SS.SSSS, HH MM SS.SSSS, HHhMMmSS.SSSSs
# or DDD.DDDD to degrees
#
# Inputs:
# - input RA string
#
# Outputs: ($status, $ra)
# - status variable ""=success, string message otherwise
# (NB: True $status means an error occured.)
# - output scalar RA in degrees
#
##########################################################
sub convertRAStringToDegrees {
my $self = shift;
my $inRa = shift;
my $ra = undef;
my $status = "";
my $log = $self->log();
if ( $inRa =~ /^(\d{1,2})([: h]|h\s+)(\d{1,2})([: m]|m\s+)(\d{1,2}(\.\d*)?)s?$/ ) {
# matches sexigesimal regexes
my $h = $1 * 3600.;
my $m = $3 * 60.;
my $s = $5 * 1.;
$ra = ( $h + $m + $s ) / (60. * 4.);
# debug( "converted $inRa to $ra degrees\n" );
# } elsif ( $inRa =~ /^(\d+\.?\d*|\.\d+|\d+\.)$/ ) {
} elsif ( $inRa =~ /^[\+\-]?(\.\d+|\d+(\.\d*)?)([Ee][\+\-]?\d+)?$/ ) {
# decimal
$ra = $inRa * 1.0;
} else {
$status ="$inRa is invalid RA string in convertRAStringToDegrees\n".
"Use HH:MM:SS.SS, HHhMMmSS.SSs, HH MM SS.SS or [+-]DDD.DD\n";
}
# check that got a valid number. looks_like_number is from std package
# Scalar::Util.
if (not looks_like_number( $ra )) {
$status = "$inRa could not be converted to RA degrees in convertRAStringToDegrees:\n" .
"Use HH:MM:SS.SS, HHhMMmSS.SSs, HH MM SS.SS or [+-]DDD.DD\n";
}
if ($status) {
$log->error(1, $status);
}
return ( $status, $ra );
}
##########################################################
#
# convertDecStringToDegrees -
#
# converts Dec in [+-]DD:MM:SS.SSSS, [+-]DD MM SS.SSSS, [+-]DDdMMmSS.SSSSs
# or DDD.DDDD to degrees
#
# Inputs:
# - input Dec string
#
# Outputs: ($status, $dec)
# - status variable ""=success, string message otherwise
# (NB: True $status means an error occured.)
# - output scalar Dec in degrees
#
##########################################################
sub convertDecStringToDegrees {
my $self = shift;
my $inDec = shift;
my $dec = undef;
my $status = "";
my $log = $self->log();
if ( $inDec =~ /^([\+-]?\d{1,2})([: d]|d\s+)(\d{1,2})([: m]|m\s+)(\d{1,2}(\.\d*)?)s?$/ ) {
# matches sexigesimal regexes
my $d = $1;
my $m = $3 / 60.;
my $s = $5 / 3600.;
my $sign = ( $d < 0 || $d =~ /-00/ ) ? -1. : 1.;
$dec = $sign * ( $d * $sign + $m + $s );
# debug( "converted $inDec to $dec degrees\n" );
# } elsif ( $inDec =~ /^[\+-]?(\d+\.?\d*)|(\.\d+)|(\d+\.)$/ ) {
} elsif ( $inDec =~ /^[\+\-]?(\.\d+|\d+(\.\d*)?)([Ee][\+\-]?\d+)?$/ ) {
# decimal
$dec = $inDec * 1.0;
} else {
$status ="$inDec is invalid Dec string in convertDecStringToDegrees\n".
"Use [+-]DD:MM:SS.SS, [+-]DDdMMmSS.SSs, [+-]DD MM SS.SS or [+-]DDD.DD\n";
}
# check that got a valid number. looks_like_number is from std package
# Scalar::Util.
if (not looks_like_number( $dec )) {
$status = "$inDec could not be converted to Dec degrees in convertDecStringToDegrees:\n" .
"Use [+-]DD:MM:SS.SS, [+-]DDdMMmSS.SSs, [+-]DD MM SS.SS or [+-]DDD.DD\n";
}
if ($status) {
$log->error(1, $status);
}
return ( $status, $dec );
}
#####################################################################
#sdc:apsop$ crontab -l|grep grb -A6 -B 1
###### get GRB coordinates from heasarc web site every night 1AM ######
#0 1 * * * /aps/scripts/grb_coord.pl >/aps/db/grb_coord/grb.txt
#0 1 * * * /aps/tools/headas/current/i686-pc-linux-gnu-libc2.2.5/bin/xwebquery.pl url=/docs/swift/archive/grbsummary/grb_pages/swiftgrb.tdat host=heasarc.gsfc.nasa.gov >/aps/db/grb_coord/swiftgrb.tdat
#sdc:apsop$ uname -n
#sdc
#-sh-3.00$ crontab -l
#11 1 * * * cp -pf /Heasarc_dev/dba_dbase/work/swiftgrb/hdb/swiftgrb.tdat /www.prod/htdocs/docs/swift/archive/grbsummary/grb_pages/swiftgrb.tdat
#-sh-3.00$ uname -n
#heasarcdev
#######################GET LORELLA GRB COORD##########################
#
# Read GRB coords from Lorella's/Davide's catalog, retrieved from
# HEASARCDEV each morning. Name read from sw0.par parameter GrbCat is
# copied to the working directory always as "swiftgrb.tdat". Returns undef
# if not found or not a GRB. For each line in the file, first sees if its
# "name" field matches the GRB name taken from job.par's "object"
# parameter, if not compares the target_id field against the job.par "target"
# parameter.
#
sub get_swiftgrb_coord{
my $self = shift;
my $log = $self->log();
my $filename = $self->filename();
my $jobpar = $self->jobpar();
my $procpar = $self->procpar();
my $GRB = $jobpar->read('object');
$GRB = uc( $GRB );
my $target = undef;
if ($GRB !~ /^(GRB\s*\d{6}[A-Z]*)/) {
$target = $jobpar->read('target');
$target =~ s/^0*//;
} else {
$GRB = $1;
}
my $trigid = $jobpar->read('sequence');
$trigid =~ s/\d{3}$//; $trigid =~ s/^0*//;
$GRB =~ s/GRB//g;
$log->entry("get_swiftgrb_coord: GRB id= $GRB, trigger=$trigid");
my $refP = undef;
###########FIND GRB only
my $key1=0;
my $key2=0;
if (20000<=$trigid && $trigid<30000) {
$key1=1;
}
if ($trigid>=100000) {
$key2=1;
}
my $prog = (split/\./,(split/\//,(caller())[1])[-1])[0];
if ( ! ($key1 + $key2) ) {
if($prog ne 'XrtEvents' and $prog ne 'XrtProducts'){
$log->error(1, "This is not GRB, $prog not ran: exit 1");
}
return $refP;
}
############### COPY swiftgrb.tdat file from /aps/db/grb_coord to here
#
# Only copy if we don't already have it, since this sub gets called twice,
# and the catalog is also read by getTrigFromSWIFTCatalog. We'll always copy
# to "swiftgrb.tdat" for compatibility with the later steps, no matter
# what the name in sw0.par.
if (! -e "swiftgrb.tdat"){
my $swiftcat = $procpar->read('GrbCat');
if (! -e $swiftcat) {
$log->error(1, "get_swiftgrb_coord: Could not locate Lorella's catalog $swiftcat");
return;
}
system("\$LOCKIT $swiftcat;cp $swiftcat swiftgrb.tdat;\$UNLOCKIT $swiftcat");
if (! -e "swiftgrb.tdat") {
# If we still don't have it, there was a problem copying.
$log->error(1, "get_swiftgrb_coord: Could not copy Lorella's catalog $swiftcat");
return;
}
}
my $refItems = undef;
my @Items = qw/name target_id bat_ra bat_dec bat_pos_err xrt_ra xrt_dec xrt_pos_err uvot_ra uvot_dec uvot_pos_err ot_ra ot_dec ot_pos_err/;
my @rItems = qw/bat_ra bat_dec bat_pos_err xrt_ra xrt_dec xrt_pos_err uvot_ra uvot_dec uvot_pos_err ot_ra ot_dec ot_pos_err/;
foreach my $it (@Items){
$refItems->{$it} = -1;
}
my $strer = '';
my $flgR = 0;
if (open INF, "swiftgrb.tdat"){
while (my $line = <INF>){
chomp $line;
next if ($line =~ /^\#/);
# Look for the catalog line that begins with "line[1] =", which
# names all the fields in order. Record the index of each field
# we're interested in (listed in @Items) in the hash refItems,
# keyed by the field name.
if ($line =~ /^\s*line\[1\]\s*\=/){
my @tar = split /\s+/, (split/\s*\=\s*/, $line)[1];
for(my $i=0; $i<scalar(@tar); $i++){
if(exists $refItems->{$tar[$i]}){
my $j = $i;
$refItems->{$tar[$i]} = $j;
}
}
$flgR = 1;
} elsif ($line =~ /^\s*\<DATA\>/ and $flgR == 1){
# search for the DATA section
$flgR = 2;
} elsif ($flgR == 2){
# Look for the catalog line for this burst, and parse it.
# Replace the indices stored in refItems with the values
# (nutty!!). Note that split by default truncates trailing
# null elements but the -1 limit preserves them; we need that
# in case the GRB's entry is in the catalog but hasn't been
# filled in yet.
if (!defined $target and $line =~ /^\s*GRB\s*$GRB/) {
# $target isn't defined but it looks like the burst names
# match, so check this line in detail. If it's the right
# one, load up refItems.
my @art = split /\|/, $line, -1; #-1 keeps trailing null fields
my $tgrb = $art[0];
$tgrb =~ s/^\s*GRB\s*//;
$tgrb = uc($tgrb);
my $gf = 0;
if ($GRB =~ /\d{6}[A-Z]*/ and $GRB eq $tgrb) {
$gf = 1;
} else {
# Originally "if($GRB =~ /$tgrb.'[A]*'/) {". I think
# it's supposed to match $tgrb optionally followed by
# an A, which this seems to:
if ($GRB =~ /${tgrb}A*$/) {
$gf = 1;
}
}
if ($gf == 1) {
foreach my $key (keys %$refItems) {
my $idx = $refItems->{$key};
if ($idx != -1) {
if ($art[$idx] eq '' or $art[$idx] eq 'n/a') {
$art[$idx] = undef;
}
$refItems->{$key} = $art[$idx];
} else {
$strer .= "Unable to find value for $key. ";
}
}
$flgR = 3;
last;
}
} elsif (defined $target) {
# $target is defined, so check to see if target_id field
# matches it (numerically!), if so load up refItems.
# (looks_like_number() is from Scalar::Util.)
my @art = split /\|/, $line, -1; #-1 keeps trailing null fields
my $tidx = $refItems->{target_id};
if ( defined $tidx &&
looks_like_number($art[$tidx]) &&
$target == $art[$tidx] ) {
foreach my $key (keys %$refItems) {
my $idx = $refItems->{$key};
if ($idx != -1) {
if ($art[$idx] eq '' or $art[$idx] eq 'n/a') {
$art[$idx] = undef;
}
$refItems->{$key} = $art[$idx];
} else {
$strer .= "Unable to find value for $key. ";
}
}
$flgR = 4;
last;
}
}
}
} # end of while loop
close INF;
} # end of if (open INF, "swiftgrb.tdat"){
if ($strer ne ''){
$log->error(1, "$strer, exit 1");
$refP = undef;
return $refP;
} elsif ($flgR == 3) {
$log->entry("get_swiftgrb_coord: GRB $GRB found in Lorella's catalog");
} elsif ($flgR == 4) {
$log->entry("get_swiftgrb_coord: TargetID $target found in Lorella's catalog");
} else {
$log->entry( "get_swiftgrb_coord: "
. (defined($target) ? "TargetID $target" : "GRB $GRB")
. " not found in Lorella's catalog" );
$refP = undef;
return $refP;
}
# Transfer the fields we want to return (listed in rItems) from refItems
# to refP. Not sure why this is necessary (why not just return
# refItems?), but since they're all numeric it gives us a convenient
# place to add a sanity check that they're numbers.
foreach my $it (@rItems) {
if ( looks_like_number( $refItems->{$it} ) ) {
$refP->{$it} = $refItems->{$it};
} else {
$refP->{$it} = undef;
}
}
return $refP;;
} # sub get_swiftgrb_coord
#######################GET JD GRB COORD##########################
#
# Read GRB coords from JD Myer's catalog by requesting from the Web site
#
# Returns undef if not found or not a GRB. If the GRB name from the
# job.par "object" parameter has the standard "GRB YYMMDDL" form, use it to
# query the catalog; otherwise, use the trigger ID as derived from the
# "sequence" parameter. The catalog is queried by using wget to contact
# the program given by the URL in the sw0.par parameter "JDCatCoords",
# currently grb_lookupLC.php. (Unfortunately this sub requires ALL
# returned values to be numbers, either decimal or sexigesimal, so it can't
# use grb_lookupLC3.php. Ugh.)
#
sub get_grb_coord{
my $self = shift;
my $log = $self->log();
my $filename = $self->filename();
my $jobpar = $self->jobpar();
my $procpar = $self->procpar();
my $refP = undef;
my $GRB = $jobpar->read('object');
$GRB = uc( $GRB );
my $trigid = $jobpar->read('sequence');
$trigid =~ s/\d{3}$//; $trigid =~ s/^0*//;
my $TI = undef;
if($GRB !~ /^(GRB\s*\d{6}[A-Z]*)/i){
$TI = $trigid;
} else {
$GRB = $1;
}
my $grbOut = '/tmp/GRB_'.$GRB.'.txt';
if(defined $TI){
$grbOut = '/tmp/GRB_'.$TI.'.txt';
}
$GRB =~ s/GRB//g;
$log->entry("get_grb_coord: GRB id= $GRB, trigger=$trigid");
my $catErrors = ""; # errors found in catalog; email to $catWatchers
my $catWatchers = $procpar->read('watchers_JDcat');
###########FIND GRB only
my $key1=0;
my $key2=0;
if (20000<=$trigid && $trigid<30000) {
$key1=1;
}
if ($trigid>=100000) {
$key2=1;
}
my $prog = (split/\./,(split/\//,(caller())[1])[-1])[0];
if ( ! ($key1 + $key2) ) {
$log->error(1, "This is not GRB, $prog not ran: exit 1");
return $refP;
}
# Remove file if it exists
# if(-e $grbOut){
# unlink $grbOut;
# }
# Make new file by querying catalog with specific ID for the given GRB
my $ssh = 'ssh -nq sdc ';
my $hostname = `hostname`;
chomp $hostname;
if($hostname =~ /^sdc/ or $hostname =~ /sdcproc/){
$ssh = '';
}
my $catRmtProg = $procpar->read('JDCatCoords');
my $cmd = $ssh.' wget '.$catRmtProg.'?grb_name='.$GRB.' -O '.$grbOut.
" >& /dev/null";
if (defined $TI) {
$cmd = $ssh.' wget '.$catRmtProg.'?trig_id='.$TI.' -O '.$grbOut.
" >& /dev/null";
}
my @GRBvals = ();
my $retval = system($cmd);
if($retval != 0){
$log->error(1, "Unable to reach catalog ${catRmtProg}: exit 1");
return $refP;
} else{
if($ssh ne ''){
my $cmd2 = "ssh -nq sdc cat $grbOut; rm -f $grbOut";
@GRBvals = `$cmd2`;
} else {
@GRBvals = `cat $grbOut`;
unlink $grbOut;
}
}
# The catalog query returns a series of keyword = value lines (now in
# @GRBvals), giving (separately) RA, Dec, and position error from each
# instrument. Try to parse them, and load results into hash $refGRB:
my $refGRB = undef;
my $flgNF = -1; # Not Found flag: 0=OK, 1=GRB not found,
# -1=retrieval error or no valid coords
foreach my $line (@GRBvals){
chomp $line;
next if ($line =~ /^\s*$/);
if($line =~ /^\s*GRB\snot\sfound/){
$flgNF = 1;
last;
} elsif ($line =~ /No\s+such\s+file\s+or\s+directory/){
last;
}
if ($line =~ /\s*\=\s*/) {
my ($name, $value) = split/\s*\=\s*/, $line;
$refGRB->{$name} = undef;
# Filter out TBD, n/a, undefined, or empty.
# Anything else SHOULD be a number, either decimal or sexigesimal.
# (Other errors, like misspellings, "TDB", etc., will be caught
# by the looks_like_number check below, set to undef there,
# and reported.)
if ( $value =~ /tbd/i or $value =~ /n\/a/i or
!defined $value or $value eq '' ) {
$value = undef;
}
if (defined $value) {
# If value contains a :, h, d, or space surrounded by digits,
# try to convert as a sexigesimal value. Otherwise it should
# be a decimal number.
if ($value =~ /\d+\s*[: hd]\s*\d+/) { # digit,(sp),h/d/sp,(sp),digit
if ($name =~ /ra$/) {
my ($status, $ra) =
$self->Subs::UvotProduct::convertRAStringToDegrees($value);
if (not $status) {
$refGRB->{$name} = $ra;
} else {
$catErrors .= $status;
$log->error( 1, "RA conversion error in $line");
}
} elsif ($name =~ /dec$/) {
my ($status, $dec) =
$self->Subs::UvotProduct::convertDecStringToDegrees($value);
if (not $status) {
$refGRB->{$name} = $dec;
} else {
$catErrors .= $status;
$log->error( 1, "Dec conversion error in $line");
}
}
$flgNF = 0;
} else {
# Not sexigesimal, check for an ordinary decimal number
# looks_like_number() is in standard package Scalar::Util
if ( looks_like_number( $value ) ) {
$refGRB->{$name} = $value;
$flgNF = 0;
} else {
my $msg = "Bad value from JD catalog: $line\n";
$log->error( 1, $msg );
$catErrors .= $msg;
}
}
if ( defined( $refGRB->{$name} ) ) {
$log->entry("get_grb_coord: $line to " . $refGRB->{$name});
}
} # if (defined $value)
} # if ($line =~...)
} # foreach
# If there were any errors in the catalog, email them to $catWatchers.
# This isn't fatal, because other fields may be good. Don't log
# errors here because they were already all logged individually.
# (Note: non-null string evaluates true.)
if ( $catErrors ) {
my $subject = "Errors found in JD's catalog for GRB $GRB trigger $trigid";
my $msg = "$subject:\n\n$catErrors" ;
$self->Subs::XrtGrbLc::sendEmail($subject, $msg, $catWatchers);
$log->error( 1, "Errors in JD's catalog emailed to $catWatchers");
}
if ($flgNF == 1){
$log->entry( "get_grb_coord:"
. (defined($TI) ? "TriggerID $TI" : "GRB $GRB" )
. " not found in JD catalog; exit 1" );
return $refP;
} elsif ($flgNF == -1){
$log->error(1, "GRB $GRB not found: command $cmd must have failed; exit 1");
return $refP;
}
$log->entry("get_grb_coord: "
. (defined($TI) ? "TriggerID $TI" : "GRB $GRB")
." found in JD catalog");
my @items = qw/batra batdec baterr xrtra xrtdec xrterr uvotra uvotdec uvoterr/;
my @rItems = qw/bat_ra bat_dec bat_pos_err xrt_ra xrt_dec xrt_pos_err uvot_ra uvot_dec uvot_pos_err/;
#Some sanity checks while also writing out the data
my $erIt = '';
my $i = 0;
foreach my $it (@items) {
if (!exists $refGRB->{$it}) {
$refP->{$rItems[$i]} = undef;
} else {
$refP->{$rItems[$i]} = $refGRB->{$it};
}
$i++;
}
return $refP;
} #end of get_grb_coord
#######################GET LOCAL GRB COORD##########################
#
# Look up GRB coordinates in the local catalog. Returns -1 if this
# isn't a GRB. If the GRB name from job.par "object" parameter has
# the correct form, check it against each line's name field, otherwise
# compare the trigger_id field with the trigger ID read from the
# job.par "sequence" field.
#
sub get_grb_coord_local{
my $self = shift;
my $log = $self->log();
my $filename = $self->filename();
my $jobpar = $self->jobpar();
my $procpar = $self->procpar();
my $refP = undef;
my $catalog = $procpar->read('LGrbCat');
if(!-e $catalog){
$log->error(1, "Local GRB catalog $catalog does NOT exists.");
return $refP;
}
my @Cat = split/\//, $catalog;
my $Lcat = $Cat[-1];
my $GRB = $jobpar->read('object');
$GRB = uc( $GRB );
my $target = undef;
if($GRB !~ /^GRB\s*\d{6}[A-Z]*/){
$target = $jobpar->read('target');
$target =~ s/^0*//;
}
my $trigid = $jobpar->read('sequence');
$trigid =~ s/\d{3}$//; $trigid =~ s/^0*//;
$GRB =~ s/GRB//g;
$log->entry("get_grb_coord_local: GRB id= $GRB, trigger=$trigid");
###########FIND GRB only
my $key1=0;
my $key2=0;
if (20000<=$trigid && $trigid<30000) {
$key1=1;
}
if ($trigid>=100000) {
$key2=1;
}
my $prog = (split/\./,(split/\//,(caller())[1])[-1])[0];
if ( ! ($key1 + $key2) ) {
if($prog ne 'XrtEvents' and $prog ne 'XrtProducts'){
$log->error(1, "This is not GRB, $prog not ran: exit 1");
}
return -1;
}
########### COPY local catalog file to here, if don't already have it
if (! -e $Lcat) {
system("\$LOCKIT $catalog;cp $catalog .;\$UNLOCKIT $catalog");
}
my $refItems = undef;
# my @Items = qw/name sequence target_id bat_ra bat_dec bat_pos_err xrt_ra xrt_dec xrt_pos_err uvot_ra uvot_dec uvot_pos_err ot_ra ot_dec ot_pos_err/;
# my @rItems = qw/bat_ra bat_dec bat_pos_err xrt_ra xrt_dec xrt_pos_err uvot_ra uvot_dec uvot_pos_err ot_ra ot_dec ot_pos_err/;
# foreach my $it (@Items){
# $refItems->{$it} = -1;
# }
my $strer = '';
my $flgR = 0;
if (open INF, "<$Lcat"){
while (my $line = <INF>){
chomp $line;
next if ($line =~ /^\#/);
# Look for the catalog line that begins with "line[1] =", which
# names all the fields in order. Record the index of each field in
# the hash refItems, keyed by the field name. (Record all, unlike
# get_swiftgrb_coord which only records some. Local catalog has
# far fewer fields.)
if ($line =~ /^\s*line\[1\]\s*\=/){
my @tar = split /\s+/, (split/\s*\=\s*/, $line)[1];
for(my $i=0; $i<scalar(@tar); $i++){
$refItems->{$tar[$i]} = $i;
}
$flgR = 1;
} elsif ($line =~ /^\s*\<DATA\>/ and $flgR == 1){
# search for the DATA section
$flgR = 2;
} elsif ($flgR == 2){
# Look for the catalog line for this burst and parse it.
# Replace the indices stored in refItems with the values
# (nutty!!). Note that split by default truncates trailing
# null elements but the -1 limit preserves them; we need that
# in case the GRB's entry is in the catalog but hasn't been
# filled in yet.
if (!defined $target and $line =~ /^\s*GRB\s+$GRB/) {
# $target isn't defined but it looks like the burst names
# match, so check this line in detail. If it's the right
# one, load up refItems.
my @art = split /\|/, $line, -1; #-1 keeps trailing null fields
my $tgrb = $art[0];
$tgrb =~ s/^\s*GRB\s*//;
$tgrb = uc($tgrb);
my $gf = 0;
if($GRB =~ /\d{6}[A-Z]*/ and $GRB eq $tgrb){
$gf = 1;
} else {
# Originally "if($GRB =~ /$tgrb.'[A]*'/) {". I think
# it's supposed to match $tgrb optionally followed by
# an A, which this seems to:
if ($GRB =~ /${tgrb}A*$/) {
$gf = 1;
}
}
if ($gf == 1) {
foreach my $key (keys %$refItems) {
my $idx = $refItems->{$key};
my $it = $art[$idx];
if (!defined $it or $it eq '' or $it eq 'n/a') {
$it = undef;
}
$refItems->{$key} = $it;
}
$flgR = 3;
last;
}
} else {
# $target is defined, so check to see if target_id field
# matches $trigid (numerically!), if so load up refItems.
# (looks_like_number() is from Scalar::Util.)
my @art = split /\|/, $line, -1; #-1 keeps trailing null fields
my $sidx = $refItems->{target_id};
if ( looks_like_number($art[$sidx]) &&
$trigid == $art[$sidx] ) {
foreach my $key (keys %$refItems) {
my $idx = $refItems->{$key};
my $it = $art[$idx];
if(!defined $it or $it eq '' or $it eq 'n/a'){
$it = undef;
}
$refItems->{$key} = $it;
}
$flgR = 4;
last;
}
}
}
} # end of while loop
close INF;
} # end of if (open INF, "<$Lcat"){
if ($flgR == 3) {
$log->entry("get_grb_coord_local: GRB $GRB found in Local catalog.");
} elsif ($flgR == 4) {
$log->entry("get_grb_coord_local: TriggerID $trigid found in Local catalog.");
} else {
$log->entry("get_grb_coord_local: GRB $GRB, trigger $trigid not found in Local catalog.");
return $refP;
}
# Sanity check that values that should be numeric really are
foreach my $it ( qw/bat_ra bat_dec bat_pos_err xrt_ra xrt_dec xrt_pos_err
uvot_ra uvot_dec uvot_pos_err ot_ra ot_dec ot_pos_err/) {
if ( !looks_like_number($refItems->{$it}) ) {
$refItems->{$it} = undef;
}
}
return $refItems;
} # sub get_grb_coord_local
###################################################################
#
# Add trigger time, read from one of the catalogs, to the file.
#
# Order is:
# job.par burst_time parameter (passed in as $trigtime argument)
# TDRSS catalog
# Lorella's/Davide's catalog
# JD's catalog
# local catalog
#
sub AddTrigtime {
my $self=shift;
my ($refA, $trigtime, $trigid) = @_;
my $log = $self->log();
# Initial trigtime passed in was read from burst_time in job.par file.
my $trigtimeSrc = "burst_time Parameter";
if (!defined $trigtime or $trigtime == 0){
$trigtime = $self->getTrigFromDB();
$trigtimeSrc = "TDRSS Catalog";
if (!defined $trigtime){
$trigtime = $self->getTrigFromSWIFTCatalog();
$trigtimeSrc = "Lorella Catalog";
if (!defined $trigtime){
$trigtime = $self->getTrigFromJDCatalog();
$trigtimeSrc = "JD Catalog";
if (!defined $trigtime){
$trigtime = $self->getTrigFromLocalCatalog();
$trigtimeSrc = "Local Catalog";
}
}
}
}
my $rv = 0;
if (defined $trigtime){
$rv = -1;
$log->entry("AddTrigtime: Trigger time from $trigtimeSrc used: $trigtime");
foreach my $file (@$refA ) {
my $fits = Util::FITSfile->new($file);
my $nhdus = $fits->nhdus();
unless ($nhdus) {
next;
}
my $hdu;
for($hdu=0; $hdu<$nhdus; $hdu++) {
$fits->ext($hdu);
my $extname = $hdu==0 ? '' : $fits->keyword('EXTNAME');
################################
# write keywords to the file
################################
$fits->begin_many_keywords();
$fits->keyword('TRIGTIME', $trigtime,
'[s] MET TRIGger Time for Automatic Target');
$fits->keyword('TARG_ID', $trigid, 'Target ID');
$fits->end_many_keywords();
}
$rv = 1;
} # foreach
} else {
$log->error(1, "Could not find trigtime in any catalog");
}
return $rv;
}
###################################################################
#
# Get trigger time from swifttdrss.rdb
#
sub getTrigFromDB {
my $self =shift;
my $log =$self->log();
my $filename=$self->filename();
my $jobpar =$self->jobpar();
my $targetid =$jobpar->read('sequence');
$targetid =~ s/\d{3}$//;
$targetid =~ s/^0*//;
my $RDB_BIN = '/aps/tools/rdb';
if(defined $ENV{RDB_BIN}){
$RDB_BIN = $ENV{RDB_BIN};
}
my $RDB_TABLES_DIR = '/aps/db/rdb/tables';
if(defined $ENV{RDB_TABLES_DIR}){
$RDB_TABLES_DIR = $ENV{RDB_TABLES_DIR};
}
my $db = "$RDB_TABLES_DIR/sw/swifttdrss.rdb";
my $host = `/bin/hostname`;
chomp $host;
if($host =~ /^sdcdev/i){
$db = "/data/sdc/local/data/sdc1/apsop/db/rdb/tables/sw/swifttdrss.rdb";
}
my $cmdb = "$RDB_BIN/row < $db target_id eq $targetid | $RDB_BIN/column time_seconds1 ufcf_corr -a utime 23N | $RDB_BIN/compute utime = time_seconds1 - ufcf_corr | $RDB_BIN/column utime | $RDB_BIN/headchg -del | head -1";
my $btime = `$cmdb`;
chomp $btime;
if(defined $btime and $btime =~ /^\d{4}\-\d{2}\-\d{2}T\d{2}\:\d{2}\:\d{2}/){
$btime = $self->Subs::UvotProduct::convertTG($btime);
}
if($btime =~ /^\s*$/ or $btime == 0){
$btime = undef;
$log->entry("getTrigFromDB: While searching for TRIG_TIME, TargetID $targetid not found in $db");
}
return $btime;
}
##################################################################
#
# Get trigger time from Lorella's catalog. File name read from sw0.par
# parameter GrbCat is copied to the working directory always as
# "swiftgrb.tdat".
#
sub getTrigFromSWIFTCatalog {
my $self = shift;
my $log = $self->log();
my $filename = $self->filename();
my $jobpar = $self->jobpar();
my $procpar = $self->procpar();
my $GRB = $jobpar->read('object');
$GRB = uc( $GRB );
my $target = undef;
if ($GRB !~ /^GRB\s*\d{6}[A-Z]*/) {
$target = $jobpar->read('target');
$target =~ s/^0*//;
}
my $trigid = $jobpar->read('sequence');
$trigid =~ s/\d{3}$//; $trigid =~ s/^0*//;
$GRB =~ s/GRB//g;
my $refP = undef;
###########FIND GRB only
my $key1=0;
my $key2=0;
if (20000<=$trigid && $trigid<30000) {
$key1=1;
}
if ($trigid>=100000) {
$key2=1;
}
my $prog = (split/\./,(split/\//,(caller())[1])[-1])[0];
if ( ! ($key1 + $key2) ) {
$log->error(1, "This is not GRB, call from $prog not ran: exit 1");
return $refP;
}
################# COPY swiftgrb.tdat file from /aps/db/grb_coord to here
#
# Only copy if we don't already have it, since this sub gets called twice,
# and the catalog is also read by get_swiftgrb_coord. We'll always copy
# to "swiftgrb.tdat" for compatibility with the later steps, no matter
# what the name in sw0.par.
if (! -e "swiftgrb.tdat"){
my $swiftcat = $procpar->read('GrbCat');
if (! -e $swiftcat) {
$log->error(1, "getTrigFromSWIFTCatalog: Could not locate Lorella's catalog $swiftcat");
return;
}
system("\$LOCKIT $swiftcat;cp $swiftcat swiftgrb.tdat;\$UNLOCKIT $swiftcat");
if (! -e "swiftgrb.tdat") {
# If we still don't have it, there was a problem copying.
$log->error(1, "getTrigFromSWIFTCatalog: Could not copy Lorella's catalog $swiftcat");
return;
}
}
my $refItems = undef;
my @Items = qw/name target_id trigger_time/;
my @rItems = qw/trigger_time/;
foreach my $it (@Items) {
$refItems->{$it} = -1;
}
my $strer = '';
my $flgR = 0;
if (open INF, "swiftgrb.tdat") {
while (my $line = <INF>) {
chomp $line;
next if ($line =~ /^\#/);
# Look for the catalog line that begins with "line[1] =", which
# names all the fields in order. Record the index of each field
# we're interested in (listed in @Items) in the hash refItems,
# keyed by the field name.
if ($line =~ /^\s*line\[1\]\s*\=/) {
my @tar = split /\s+/, (split/\s*\=\s*/, $line)[1];
for (my $i=0; $i<scalar(@tar); $i++) {
if (exists $refItems->{$tar[$i]}) {
my $j = $i;
$refItems->{$tar[$i]} = $j;
}
}
$flgR = 1;
} elsif ($line =~ /^\s*\<DATA\>/ and $flgR == 1) {
# search for the DATA section
$flgR = 2;
next;
} elsif ($flgR == 2) {
# Look for the catalog line for this burst, and parse it.
# Replace the indices stored in refItems with the values
# (nutty!!). Note that split by default truncates trailing null
# elements but the -1 limit preserves them; we need that in case
# the GRB's entry is in the catalog but hasn't been filled in
# yet.
if (!defined $target and $line =~ /^\s*GRB\s*$GRB/) {
# $target isn't defined but it looks like the burst names
# match, so check this line in detail. If it's the right
# one, load up refItems.
my @art = split /\|/, $line, -1; # -1 keeps trailing null fields
my $tgrb = $art[0];
$tgrb =~ s/^\s*GRB\s*//;
$tgrb = uc($tgrb);
my $gf = 0;
if ($GRB =~ /\d{6}[A-Z]*/ and $GRB eq $tgrb) {
$gf = 1;
} else {
# Originally "if($GRB =~ /$tgrb.'[A]*'/) {". I think
# it's supposed to match $tgrb optionally followed by
# an A, which this seems to:
if ($GRB =~ /${tgrb}A*$/) {
$gf = 1;
}
}
if ($gf == 1) {
foreach my $key (keys %$refItems) {
my $idx = $refItems->{$key};
if ($idx != -1) {
if ($art[$idx] eq '' or $art[$idx] eq 'n/a') {
$art[$idx] = undef;
}
$refItems->{$key} = $art[$idx];
} else {
$strer .= "Unable to find value for $key. ";
}
}
$flgR = 3;
last;
}
} elsif (defined $target) {
# $target is defined, so check to see if target_id field
# matches it (numerically!), if so load up refItems.
# (looks_like_number() is from Scalar::Util.)
my @art = split /\|/, $line, -1; #-1 keeps trailing null fields
my $tidx = $refItems->{target_id};
if ( defined $tidx &&
looks_like_number($art[$tidx]) &&
$target == $art[$tidx]) {
foreach my $key (keys %$refItems) {
my $idx = $refItems->{$key};
if ($idx != -1) {
if ($art[$idx] eq '' or $art[$idx] eq 'n/a') {
$art[$idx] = undef;
}
$refItems->{$key} = $art[$idx];
} else {
$strer .= "Unable to find value for $key. ";
}
}
$flgR = 4;
last;
}
}
}
} # end of while loop
close INF;
} # end of if (open INF, "swiftgrb.tdat"){
if ($strer ne ''){
$log->error(1, "$strer, exit 1");
$refP = undef;
return $refP;
} elsif ($flgR == 3) {
$log->entry("getTrigFromSWIFTCatalog: GRB $GRB found in Lorella's catalog");
} elsif ($flgR == 4) {
$log->entry("getTrigFromSWIFTCatalog: TargetID $target found in Lorella's catalog");
} else {
$log->entry( "getTrigFromSWIFTCatalog: While searching for TRIG_TIME, "
. (defined($target) ? "TargetID $target" : "GRB $GRB")
. " not found in Lorella's catalog" );
$refP = undef;
return $refP;
}
foreach my $it (@rItems) {
$refP = $self->Subs::UvotProduct::convertTG($refItems->{$it});
}
return $refP;
}
###############################################################
#
# Query JD's catalog for trigger time.
#
# We parse the GRB name to get the trigger's date, but since our GRB name
# isn't necessarily in the standard form (eg, it may be "BURST (...)"), use
# the GRB name returned by the catalog query. The catalog is queried by
# contacting the program given by the URL in the sw0.par parameter
# "JDCatTrigs" (currently, grb_lookupLC3.php).
#
# The catalog is queried by GRB name (job.par parameter "object") if the
# name we have appears to be in standard "GRB YYMMDDL" form, or by target
# id (job.par "target") if it doesn't.
#
sub getTrigFromJDCatalog {
my $self = shift;
my $log = $self->log();
my $filename = $self->filename();
my $jobpar = $self->jobpar();
my $procpar = $self->procpar();
my $GRB = $jobpar->read('object');
$GRB = uc( $GRB );
my $target = undef;
if ($GRB !~ /^(GRB\s*\d{6}[A-Z]*)/) {
$target = $jobpar->read('target');
$target =~ s/^0*//;
} else {
$GRB = $1;
}
my $trigid = $jobpar->read('sequence');
$trigid =~ s/\d{3}$//; $trigid =~ s/^0*//;
my $refP = undef;
my $grbOut = '/tmp/GRB_'.$GRB.'.txt';
my $TI = undef;
if($GRB !~ /^GRB\s*\d{6}[A-Z]*/){
$TI = $trigid;
$grbOut = '/tmp/GRB_'.$TI.'.txt';
}
$GRB =~ s/GRB//g;
my $catErrors = ""; # errors found in catalog; email to $catWatchers
my $catWatchers = $procpar->read('watchers_JDcat');
# Remove file if it exists
if (-e $grbOut) {
unlink $grbOut;
}
# Make new file by querying catalog with specific ID for the given GRB
my $ssh = 'ssh -nq sdc ';
my $hostname = `/bin/hostname`;
chomp $hostname;
if($hostname =~ /^sdc/ or $hostname =~ /sdcproc/){
$ssh = '';
}
# my $catRmtProg = "http://heasarc.gsfc.nasa.gov/docs/swift/archive/grb_table/grb_lookupLC3.php";
my $catRmtProg = $procpar->read('JDCatTrigs');
my $cmd = $ssh.' wget '.$catRmtProg.'?grb_name='.$GRB.' -O '.$grbOut.
" >& /dev/null";
if (defined $TI) {
$cmd = $ssh.' wget '.$catRmtProg.'?trig_id='.$TI.' -O '.$grbOut.
" >& /dev/null";
}
my @GRBvals = ();
my $retval = system($cmd);
if ($retval != 0) {
$log->error(1, "Unable to reach catalog ${catRmtProg}: exit 1");
return $refP;
} else {
if ($ssh ne '') {
my $cmd2 = "ssh -nq sdc cat $grbOut; rm -f $grbOut";
@GRBvals = `$cmd2`;
} else {
@GRBvals = `cat $grbOut`;
unlink $grbOut;
}
}
# The catalog query returns a series of keyword = value lines (now in
# @GRBvals). Search these for trigger_time, and load results into hash
# $refGRB. (Why the heck does this program use a hash for a single
# value??) Also look for grb_name: if JD has added the burst to his
# catalog, it should already have a standard YYMMDDL burst name, even
# though we may not know what it is yet. So it's more reliable to use
# grb_name from JD. We use the GRB name to get the date to use to convert
# trigger time (in UTC) to mission time.
my $refGRB = undef;
my $grbName = undef;
my $flgNF = -1; # Not Found flag: 0=OK, 1=GRB not found,
# -1=retrieval error or no valid coords
foreach my $line (@GRBvals) {
chomp $line;
next if ($line =~ /^\s*$/);
if ($line =~ /^\s*GRB\snot\sfound/) {
$flgNF = 1;
last;
} elsif ($line =~ /No\s+such\s+file\s+or\s+directory/) {
last;
}
# Look for "trigger_time = ..." and "grb_name = ..."
if ($line =~ /\s*\=\s*/) {
my ($name, $value) = split/\s*\=\s*/, $line;
# Filter out TBD, n/a, undefined, or empty
if ( $value =~ /tbd/i or $value =~ /n\/a/i or
!defined $value or $value eq '' ) {
$value = undef;
}
if (defined $value and $name =~ /trigger_time/i ) {
$refGRB->{trigger_time} = $value;
$flgNF = 0;
}
if (defined $value and $name =~ /grb_name/i ) {
$grbName = $value;
}
}
} # foreach
if ($flgNF == 1) {
$log->entry( "getTrigFromJDCatalog: While searching for TRIG_TIME, "
. (defined($TI) ? "TriggerID $TI" : "GRB $GRB")
. " not found in JD's catalog; exit 1");
return $refP;
} elsif ($flgNF == -1) {
$log->error(1, "getTrigFromJDCatalog: While searching for TRIG_TIME, " .
"GRB $GRB not found in JD's catalog: command $cmd must " .
"have failed, or trigger_time not returned; exit 1");
return $refP;
}
$log->entry("getTrigFromJDCatalog: "
. (defined($TI) ? "TriggerID $TI" : "GRB $GRB")
. " found in JD's catalog");
# If $grbName isn't a proper GRB name in YYMMDDL format, we can't use it
# to derive the date, so give an error: (NB: case-insens match)
my $grbNameOK = (defined $grbName) && ( $grbName =~ /^\d{6}[A-Z]*/i );
if ( not $grbNameOK ) {
my $msg = "grb_name from JD's catalog not YYMMDDL, can't use for GRB date: "
. ((defined $grbName) ? $grbName : "(undefined)") . "\n\n";
$log->error( 1, "getTrigFromJDCatalog: $msg" );
$catErrors .= $msg;
}
# And make sure trigger_time is OK:
my $trigTimeOK = (exists $refGRB->{trigger_time}) &&
(defined $refGRB->{trigger_time}) &&
( $refGRB->{trigger_time} =~ /\d{2}\:\d{2}\:\d{2}/ ) ;
if ( not $trigTimeOK ) {
my $msg = "Could not read good trigger_time from JD's catalog,\n got: "
. $refGRB->{trigger_time} . "\n\n";
$log->error( 1, "getTrigFromJDCatalog: $msg" );
$catErrors .= $msg;
}
# Add date derived from GRB name to trigger_time, then convert to mission
# time:
if ($grbNameOK and $trigTimeOK) {
$log->entry( "getTrigFromJDCatalog: grbName=$grbName trigger_time="
. $refGRB->{trigger_time} );
my $y = substr($grbName, 0, 2);
$y += 2000;
my $m = substr($grbName, 2, 2);
my $d = substr($grbName, 4, 2);
my $t = "$y\-$m\-$d".'T'.$refGRB->{trigger_time};
$refP = $self->Subs::UvotProduct::convertTG($t);
if ( ! defined $refP ) {
$catErrors .= "convertTG error parsing trigger_time: "
. $refGRB->{trigger_time} . "\n\n";
}
}
# If there were errors in the catalog, email them to $catWatchers.
# Don't log errors here because they were already all logged
# individually. (Note: non-null string evaluates true.)
if ( $catErrors ) {
my $subject = "Errors found in JD's catalog for GRB $GRB trigger $trigid";
my $msg = "$subject:\n\n$catErrors";
$self->Subs::XrtGrbLc::sendEmail($subject, $msg, $catWatchers);
$log->error( 1, "Errors in JD's catalog emailed to $catWatchers");
}
return $refP;
}
#####################################################################
#
# Read local catalog for trigger time
#
sub getTrigFromLocalCatalog {
my $self=shift;
my $log =$self->log();
my $filename=$self->filename();
my $jobpar =$self->jobpar();
my $procpar = $self->procpar();
my $refP = undef;
my $catalog = $procpar->read('LGrbCat');
if (!-e $catalog) {
$log->error(1, "Local GRB catalog $catalog does NOT exist.");
return $refP;
}
my @Cat = split/\//, $catalog;
my $Lcat = $Cat[-1];
my $GRB = $jobpar->read('object');
$GRB = uc( $GRB );
my $target = undef;
if ($GRB !~ /^GRB\s*\d{6}[A-Z]*/) {
$target = $jobpar->read('target');
$target =~ s/^0*//;
}
my $trigid = $jobpar->read('sequence');
$trigid =~ s/\d{3}$//; $trigid =~ s/^0*//;
$GRB =~ s/GRB//g;
########### COPY local catalog file to here, if don't already have it
if (! -e $Lcat) {
system("\$LOCKIT $catalog;cp $catalog .;\$UNLOCKIT $catalog");
}
my $refItems = undef;
my $strer = '';
my $flgR = 0;
if (open INF, "<$Lcat") {
while (my $line = <INF>) {
chomp $line;
next if ($line =~ /^\#/);
# Look for the catalog line that begins with "line[1] =", which
# names all the fields in order. Record the index of each field in
# the hash refItems, keyed by the field name. (Record all, unlike
# get_swiftgrb_coord which only records some. Local catalog has
# far fewer fields.)
if ($line =~ /^\s*line\[1\]\s*\=/) {
my @tar = split /\s+/, (split/\s*\=\s*/, $line)[1];
for (my $i=0; $i<scalar(@tar); $i++) {
$refItems->{$tar[$i]} = $i;
}
$flgR = 1;
} elsif ($line =~ /^\s*\<DATA\>/ and $flgR == 1) {
# search for the DATA section
$flgR = 2;
} elsif ($flgR == 2) {
# Look for the catalog line for this burst, and parse it.
# Replace the indices stored in refItems with the values
# (nutty!!). Note that split by default truncates trailing null
# elements but the -1 limit preserves them; we need that in case
# the GRB's entry is in the catalog but hasn't been filled in
# yet.
if (!defined $target and $line =~ /^\s*GRB\s+$GRB/) {
# $target isn't defined but it looks like the burst names
# match, so check this line in detail. If it's the right
# one, load up refItems.
my @art = split /\|/, $line, -1; #-1 keeps trailing null fields
my $tgrb = $art[0];
$tgrb =~ s/^\s*GRB\s*//;
$tgrb = uc($tgrb);
my $gf = 0;
if ($GRB =~ /\d{6}[A-Z]*/ and $GRB eq $tgrb) {
$gf = 1;
} else {
# Originally "if($GRB =~ /$tgrb.'[A]*'/) {". I think
# it's supposed to match $tgrb optionally followed by
# an A, which this seems to:
if ($GRB =~ /${tgrb}A*$/) {
$gf = 1;
}
}
if ($gf == 1) {
foreach my $key (keys %$refItems) {
my $idx = $refItems->{$key};
my $it = $art[$idx];
if (!defined $it or $it eq '' or $it eq 'n/a') {
$it = undef;
}
$refItems->{$key} = $it;
}
$flgR = 3;
last;
}
} else {
# $target is defined, so check to see if target_id field
# matches $trigid (numerically!), if so load up refItems.
# (looks_like_number() is from Scalar::Util.)
my @art = split /\|/, $line, -1; #-1 keeps trailing null fields
my $sidx = $refItems->{target_id};
if ( looks_like_number($art[$sidx]) &&
$trigid == $art[$sidx] ) {
foreach my $key (keys %$refItems) {
my $idx = $refItems->{$key};
my $it = $art[$idx];
if (!defined $it or $it eq '' or $it eq 'n/a') {
$it = undef;
}
$refItems->{$key} = $it;
}
$flgR = 4;
last;
}
}
}
} # end of while loop
close INF;
} # end of if (open INF, "<$Lcat"){
if ($flgR == 3) {
$log->entry("getTrigFromLocalCatalog: GRB $GRB found in Local catalog.");
} elsif ($flgR == 4) {
$log->entry("getTrigFromLocalCatalog: TriggerID $trigid found in Local catalog.");
} else {
$log->entry("getTrigFromLocalCatalog: While searching for TRIG_TIME, GRB $GRB, trigger $trigid not found in Local catalog.");
return undef;
}
my $trigtime = undef;
if(exists $refItems->{trigger_time} and
($refItems->{trigger_time} =~ /\d{4}\-\d{2}\-\d{2}T\d{2}\:\d{2}\:\d{2}/ or
$refItems->{trigger_time} =~ /\d+\.*\d*/)){
$trigtime = $self->Subs::UvotProduct::convertTG($refItems->{trigger_time});
}
return $trigtime;
}
###################################################################
#
# Convert trigger time. Calls swifttime to convert from calendar
# time to MET seconds. Now returns undef and gives error if couldn't
# convert instead of returning input arg.
#
sub convertTG {
my $self = shift;
my $trigtime = shift;
my $rettime = undef; # returned time
my $log = $self->log();
my @Mon = qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/;
# Match trigtime date/time string that may have fractional seconds or not,
# and may be separated by T or by 1 or more spaces (the GRB cats have both).
if ($trigtime =~ /^\d{4}\-\d{2}\-\d{2}(T| +)\d{2}\:\d{2}\:\d{2}(\.\d*)?$/) {
my ($ymd, $hms) = split/[T ]+/, $trigtime; # split on T or space(s)
my ($y, $m, $d) = split/\-/, $ymd;
$m = $m - 1;
if($m < 0){
$m = 11;
}
my $ymdhms = $y.$Mon[$m].$d.' at '.$hms;
my $swiftT = Util::HEAdas->new("swifttime")->is_script( 1 );
$swiftT->seriousness( 1 );
$swiftT->params({
intime => $ymdhms,
insystem => 'UTC',
informat => 'c',
outsystem => 'MET',
outformat => 's',
swcofile => 'CALDB'
})->run();
my $stdo = $swiftT->stdout();
my @tar = split/\n/, $stdo;
foreach my $l (@tar){
if ($l =~ /Converted\s+time\:/) {
my $tg = (split/\s*\:\s*/, $l)[-1];
$tg = $tg * 1;
if ($tg =~ /^\d+\.*\d*/) {
$rettime = $tg;
}
last;
}
}
$log->entry("convertTG: trigtime=" . $trigtime .
" ymdhms=" . $ymdhms . " MET=" . $rettime . "\n");
}
if ( ! defined $rettime ) {
$log->error( 1, "Could not convert trigger time: $trigtime\n");
}
return $rettime;
}
##########cat /aps/scripts/grb_coord.pl #################
#crontab -l|grep grb
#0 * * * * /aps/scripts/grb_coord.pl >/aps/db/grb_coord/grb.txt
#
# this script is run by cronjob every hour
#
##!/usr1/local/bin/perl -w
#use LWP::Simple;
#
############URL FOR ROOT GRB TABLE :
#
#$URL="http://heasarc.gsfc.nasa.gov/docs/swift/archive/grb_table/grb_table.php?obs_swift=1&obs_ipn=1&obs_integral=1&obs_hete=1&obs_agile=1&obs_fermi=1&restrict=none&grb_time=1&grb_trigger=1&burst_advocate=1&other_obs=1&redshift=1&host=1&comments=1&references=1&bat_location=1&bat_err_radius=1&bat_t90=1&bat_fluence=1&bat_err_fluence=1&bat_1s_peak_flux=1&bat_err_1s_peak_flux=1&bat_photon_index=1&bat_err_photon_index=1&xrt_location=1&xrt_err_radius=1&xrt_first_obs=1&xrt_early_flux=1&xrt_24hr_flux=1&xrt_lc_index=1&xrt_gamma=1&xrt_nh=1&uvot_location=1&uvot_err_radius=1&uvot_first_obs=1&uvot_vmag=1&uvot_filters=1";
#
# $t=get($URL);
#
# $t1=join(" ",split(/">/,"$t"));
# $t=join(" ",split(/="/,"$t1"));
# @table=split(/ /,"$t");
#
#############URL FOR GRB TABLE EXTENSION grb_table.txt:
#
# $y=0;
# foreach $x (@table){
# if($x=~m/.txt/) { $y=$x; last; }
# }
#
#$t=get("http://heasarc.gsfc.nasa.gov/docs/swift/archive/grb_table/$y");
#
## open(F,">/aps/db/grb_coord/grb.txt");
## print F $t;
## close(F);
# print $t;
#