Index: /trunk/Ohana/src/perl/src/cfht.names =================================================================== --- /trunk/Ohana/src/perl/src/cfht.names (revision 17) +++ /trunk/Ohana/src/perl/src/cfht.names (revision 17) @@ -0,0 +1,49 @@ +#!/usr/local/bin/perl + +if (@ARGV != 1) { + print STDERR "USAGE: cfht.names (file)\n"; + exit 2; +} + +# given (filename) : return (path) (name) (mef) + +if (! -e $ARGV[0]) { + print STDERR "file $ARGV[0] not found\n"; + exit 1; +} + +$fullname = $ARGV[0]; + +# if we get a relative path, add cwd: +@words = split ("/", $ARGV[0]); +if ($words[0] ne "") { + $cwd=`pwd`; + chop ($cwd); + $fullname = "$cwd/$ARGV[0]"; +} +# we are now guaranteed to have a /complete/path/filename + +# if file is a directory, we assume it is split: +if (-d $fullname) { + $mef = "off"; +} else { + $mef = "on"; +} + +# split path and filename: +$path = "/"; +@words = split ("/", $fullname); +$N = @words; +for ($i = 1; $i < $N - 1; $i++) { + $path = $path . $words[$i] . "/"; +} +chop ($path); # strip off last / + +$file = $words[$N-1]; + +if ($mef eq "on") { + $file =~ s/.fits$//; +} + +print STDOUT "$path $file $mef\n"; +exit 0; Index: /trunk/Ohana/src/perl/src/checkconfig =================================================================== --- /trunk/Ohana/src/perl/src/checkconfig (revision 17) +++ /trunk/Ohana/src/perl/src/checkconfig (revision 17) @@ -0,0 +1,465 @@ +#!/usr/local/bin/perl + +@ARGV = &elixir_config (@ARGV); +if (@ARGV == 0) { &usage; } + +&pnotice; +&pnotice ("current run ID: $run"); +&pnotice ("current camera: $camera"); +&pnotice; + +{ # check for valid camera + if ($camera eq "cfh12k") { last; } + if ($camera eq "cfhtir") { last; } + if ($camera eq "megacam") { last; } + &escape ("camera $camera not supported, skipping"); +} + +if ($ARGV[0] eq "init") { + &ck_dirs; + &ck_flocks; + &ck_fifos; + + if ($camera eq "cfh12k") { + &ck_detrend; + } + &goodbye; +} +# if ($ARGV[0] eq "unlock") { &ck_dirs; &ck_flocks; &cl_locks; &goodbye; } + +&escape ("checkconfig command $ARGV[0] not valid"); + +### main user functions + +# check state of directories +sub ck_detrend { + + $answer = `mkdetrend state -camera $camera -run $run`; + if ($VERBOSE) { + &pnotice ("checking mkdetrend system"); + push @notices, $answer; + } + if ($?) { + &pnotice ("define mkdetrend $camera $run"); + $answer = `mkdetrend create run $run`; + if ($?) { + &pwarning ("can't define mkdetrend $camera $run"); + push @warnings, $answer; + } + } + + $answer = `mkfringe state -camera $camera -run $run`; + if ($VERBOSE) { + &pnotice ("checking mkfringe system"); + push @notices, $answer; + } + if ($?) { + &pnotice ("define mkfringe $camera $run"); + $answer = `mkfringe create run $run`; + if ($?) { + &pwarning ("can't define mkfringe $camera $run"); + push @warnings, $answer; + } + } +} + +sub ck_dirs { + my ($i, @dirs, @need); + + @dirs = ('RAWDIR', 'TMPDIR', 'HDXDIR', 'CATDIR', 'DATDIR', 'FIFOS'); + @need = ( 20, 5, 1, 0.2, 2, 0); + + if ($VERBOSE) { + foreach $dir (@dirs) { + $filename = `gconfig $dir`; chop ($filename); + &pnotice ("check $dir : $filename"); + } + &pnotice; + } + + for ($i = 0; $i < @dirs; $i++) { + checkdir ($dirs[$i], 0777, $need[$i]); + } + if ($VERBOSE) { &pnotice; } + return 0; +} + +# check state of files with locks +sub ck_flocks { + + @files = ('REGISTRATION_DATABASE'); + foreach $file (@files) { + &checklocks ($file, 0666); + } + if ($VERBOSE) { &pnotice; } +} + +# check elixir fifo files +sub ck_fifos { + @elixirs = ('imstats', 'ptolemy'); + @fifos = ('global.source', 'global.msg', 'global.end'); + + foreach $elixir (@elixirs) { + if ($VERBOSE) { &pnotice ("check fifos for elixir $elixir"); } + foreach $fifo (@fifos) { + $filename = `gconfig -D mode $elixir $fifo`; chop ($filename); + setmode ($filename, 0666); + } + } + if ($VERBOSE) { &pnotice; } +} + +sub cl_locks { + + @files = ('REGISTRATION_DATABASE'); + foreach $file (@files) { + + $filename = `gconfig $file`; chop ($filename); + $lock = lockname ($filename); + + if (!cklock ($lock) && $unlock) { setlock ($lock); } + } +} + +sub ckelixir { + my($elixir) = $_[0]; + + if ($VERBOSE) { &pnotice ("Checking on Elixir $elixir"); } + + $answer = `elixir -status -D mode $elixir`; + if ($?) { } + if ($VERBOSE) { push @notices, $answer; } + + return (1); +} + +# check that directory exists, create it if not, set permissions +sub checkdir { + # in: dir-key, mode, bytes + # out: status + + my ($dir) = $_[0]; + my ($mode) = $_[1]; + my ($bytes) = $_[2]; + my ($status); + + # set camera, runid from .current + $filename = `gconfig $dir`; chop ($filename); + + # this will make a dir if the parent doesn't exist. + if (! -e $filename) { + $status = mkdirhier ($filename, $mode); + if (!$status) { + &pwarning ("can't create directory $filename ($dir)"); + return 0; + } + } + + # set mode to desired value + if (!ckmode ($filename, $mode)) { + if (!chmod $mode, $filename) { + &pwarning ("can't set permissions on $filename ($dir)"); + return 0; + } + } + + # check available space + if ($bytes) { + @answer = `df $filename`; + @words = split (" ", $answer[1]); + $left = $words[3]; + $left = sprintf "%5.1f", ($left / 1024 / 1024); + if ($VERBOSE) { &pnotice ("$dir : $left GB free : $filename"); } + if ($left < $bytes) { + &pwarning ("$filename ($dir) is getting full"); + return 0; + } + } + return 1; +} + +# check existence & permissions on file & corresponding lockfile +sub checklocks { + + my ($file) = $_[0]; + my ($mode) = $_[1]; + + $filename = `gconfig $file`; chop ($filename); + $lock = lockname ($filename); + + if ($VERBOSE) { &pnotice ("check $file ($filename)"); } + + # create file if it does not exist + setmode ($filename, $mode); + + # create file if it does not exist + setmode ($lock, $mode); + + return 1; +} + +# basic utilities + +sub lockname { + # in: path/file + # out: path/.file.lck + + my($lock, $N, $i); + + @words = split ("/", $_[0]); + + $lock = ""; + $N = @words - 1; + for ($i = 0; $i < $N; $i++) { + $lock = $lock . $words[$i] . "/"; + } + $lock = $lock . "." . "$words[$N]" . ".lck"; + + return ($lock); +} + +sub ckmode { + # in: file mode + # out: yes/no + + $filename = $_[0]; + $mode = $_[1]; + $setmode = $mode; + + unless (@fstat = stat ($filename)) { + if ($VERBOSE) { &pwarning ("$filename not found"); } + return 0; + } + + $fmode = 07777 & $fstat[2]; + $status = !($setmode ^ $fmode); + + if (!$status && $VERBOSE) { + $line = sprintf "$filename has wrong mode: %o vs %o\n", $fmode, $setmode; + &pnotice ($line); + } + + return ($status); +} + +sub cklock { + # in: file + # out: yes/no + + $filename = $_[0]; + + if (! -e $filename) { return (1); } + + open (FILE, $filename); + $word = ; + close (FILE); + + unless ($word =~ /^IDLE/) { + &pwarning ("$filename is locked"); + return 0; + } + + return 1; +} + +# create file & set mode +sub setmode { + # in: file mode + # out: yes/no + + $filename = $_[0]; + $mode = $_[1]; + + if (! -e $filename) { + if (!open (FILE, ">$filename")) { + &pwarning ("can't create file $filename"); + return 0; + } + close (FILE); + } + + if (!ckmode ($filename, $mode)) { + if (!chmod $mode, $filename) { + &pwarning ("can't set mode on $filename"); + return 0; + } + } + + return 1; +} + +sub setlock { + # in: file + # out: yes/no + + $filename = $_[0]; + + unless (open (FILE, ">$filename")) { + &pwarning ("can't set lock $filename"); + return 0; + } + print FILE "IDLE"; + close (FILE); + return 1; +} + +sub mkdirhier { + # in: directory mode + # out: status + + my ($dir) = $_[0]; + my ($mode) = $_[1]; + my (@words, $first, $last, $i, $part); + + @words = split ("/", $dir); + + foreach $level (@words) { + if ($level eq "") { $part = "/"; next; } + $part = $part . $level; + + if (-e $part && !-d $part) { return 0; } + if (! -e $part && !mkdir ($part, $mode)) { return 0; } + chmod $mode, $part; + + $part = $part . "/"; + } + return 1; +} + +sub usage { + print STDERR "USAGE: checkconfig [command]\n"; + print STDERR " check elixir configuration & files\n"; + exit 2; +} + +sub escape { + &dump_output; + if ($_[0]) { print "$_[0]\n"; } + unlink $tmpenv; + exit 1; +} + +sub goodbye { + &dump_output; + if ($_[0]) { print "$_[0]\n"; } + unlink $tmpenv; + exit 0; +} + +sub pwarning { + push @warnings, $_[0]; +} + +sub pnotice { + push @notices, $_[0]; +} + +sub dump_output { + # output to screen + if (@warnings) { + print STDERR "\n--- problem with elixir system checkconfig --\n\n"; + foreach $line (@warnings) { print STDERR "$line\n"; } + print STDERR "\n--- checkconfig output ---\n"; + } + foreach $line (@notices) { print STDERR "$line\n"; } + + if ($notify && @warnings) { + $answer = `mkrun sys notify`; + @list = split (",", $answer); + open (MAIL, "|mail -s 'elixir checkconfig error' @list"); + print MAIL "problem with elixir system checkconfig:\n"; + foreach $line (@warnings) { print MAIL "$line\n"; } + print MAIL "\n--- checkconfig output ---\n"; + foreach $line (@notices) { print MAIL "$line\n"; } + close (MAIL); + } +} + +# grab complete configuration info from the elixir config system, +# applying appropriate command-line arguments +sub elixir_config { + my (@argv) = @_; + my ($opt, $config, @tmparg, $status); + $config = ""; + if ($ENV{'PTOLEMY'}) { $config = "-c $ENV{'PTOLEMY'}"; } + umask (0); + $notify = 0; + $VERBOSE = 0; + + # look for optional command-line arguments + @tmparg = @argv; + foreach (@tmparg) { + $value = shift @argv; + + if ($value eq "-h") { &usage; } + if ($value eq "--help") { &usage; } + + if ($value eq "-c") { + $value = shift @argv; + $config = "-c $value"; + next; + } + + if ($value eq "-C") { + push @opt, $value; + $value = shift @argv; + push @opt, $value; + $elconf = $value; + next; + } + + if ($value eq "-C") { + push @opt, $value; + $value = shift @argv; + push @opt, $value; + $value = shift @argv; + push @opt, $value; + next; + } + + if ($value eq "-run") { + $run = shift @argv; + push @opt, "-D RUNID.CURRENT $run -D RUNID $run"; + next; + } + if ($value eq "-camera") { + $camera = shift @argv; + push @opt, "-D CAMERA.CURRENT $camera -D CAMERA $camera"; + next; + } + if ($value eq "-notify") { + $notify = 1; + next; + } + if ($value eq "-v") { + $VERBOSE = 1; + next; + } + push @argv, $value; + } + + # load RUNID from state.data (unless set on command line) + if ($run eq "") { + $run = `gconfig RUNID.CURRENT`; chop $run; + if ($?) { &escape ("run is not defined: use 'mkrun sys'\n"); } + if ($run eq "") { &escape ("run is not defined: use 'mkrun sys'\n"); } + push @opt, "-D RUNID.CURRENT $run -D RUNID $run"; + } + + # load CAMERA from state.data (unless set on command line) + if ($camera eq "") { + $camera = `gconfig CAMERA.CURRENT`; chop $camera; + if ($?) { &escape ("camera is not defined: use 'mkrun sys' to set\n"); } + if ($camera eq "") { &escape ("camera is not defined: use 'mkrun sys'\n"); } + push @opt, "-D CAMERA.CURRENT $camera -D CAMERA $camera"; + } + + # set env PTOLEMY using values from command line + $config = join (" ", $config, @opt); + $tmpenv = `mktemp /tmp/elixir.XXXXXX`; chop ($tmpenv); + $status = system ("gconfig -raw $config > $tmpenv"); + if ($status) { &escape ("error in elixir configuration: gconfig fails"); } + $ENV{'PTOLEMY'} = "$tmpenv"; + + return (@argv); +} Index: /trunk/Ohana/src/perl/src/ckastrom =================================================================== --- /trunk/Ohana/src/perl/src/ckastrom (revision 17) +++ /trunk/Ohana/src/perl/src/ckastrom (revision 17) @@ -0,0 +1,58 @@ +#!/usr/bin/env perl + +# we need a mechanism to define the appropriate ext value + +if (@ARGV != 3) { die "USAGE: ckastrom (run) (root) (Nccd)\n" ;} + +$runid = $ARGV[0]; +$root = $ARGV[1]; +$Nccd = $ARGV[2]; + +$tmpdir = `gconfig -q -D RUNID $runid HDXDIR`; chop ($tmpdir); +if ($?) { + print STDERR "can't find config entry HDXDIR\n"; + exit 1; +} +chop ($runid); + +$Nbad = 0; +$Nmiss = 0; +for ($ccd = 0; $ccd < $Nccd; $ccd++) { + + $found = 0; + + $name = sprintf "%s/%s/%s%02d.hdx", $tmpdir, $root, $root, $ccd; + if (-e $name) { + $found = 1; + $answer = `echo $name | fields NASTRO`; + @words = split (" ", $answer); + if ($words[1] > 0) { next; } + } + + if (! $found) { $Nmiss ++; } + $Nbad ++; +} + +if (!$Nbad) { + print STDOUT "pass\n"; + exit 0; +} +if ($Nbad < 5) { + print STDOUT "pass $Nbad bad\n"; + exit 0; +} +print STDOUT "$Nbad bad\n"; +exit 1; + +# utilities ############################ + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + Index: /trunk/Ohana/src/perl/src/ckdetrend =================================================================== --- /trunk/Ohana/src/perl/src/ckdetrend (revision 17) +++ /trunk/Ohana/src/perl/src/ckdetrend (revision 17) @@ -0,0 +1,55 @@ +#!/usr/bin/env perl + +# the specific CCD is specified on the command line + +if ((@ARGV != 3) && (@ARGV != 4)) { die "USAGE: ckdetrend (name) (ccd) (mode) [-fringe]\n" ;} + +$fringe = 0; +if (@ARGV == 4) { $fringe = 1; } + +$name = $ARGV[0]; +$ccd = $ARGV[1]; +$mode = "\U$ARGV[2]\E"; + +if (($mode ne "SPLIT") && ($mode ne "MEF")) { + print STDERR "mode must be SPLIT or MEF\n"; + exit (2); +} + +if ($fringe) { + @type = ("fringe"); +} else { + @type = ("mask", "bias", "dark", "flat"); +} + +@missing = (); + +foreach $type (@type) { + if (vsystem ("detsearch -image $name $ccd $mode -type $type")) { + print STDERR "can't find $type\n"; + @missing = (@missing, $type); + } +} + +if (@missing) { + print STDOUT "$name fails, missing: @missing\n"; + exit 1; +} else { + print STDOUT "$name: pass\n"; + exit 0; +} + +# utilities ############################ + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +### this is no needed anymore - superceeded by detsearch -mosaic filename.fits -recipe + Index: /trunk/Ohana/src/perl/src/ckimregdb =================================================================== --- /trunk/Ohana/src/perl/src/ckimregdb (revision 17) +++ /trunk/Ohana/src/perl/src/ckimregdb (revision 17) @@ -0,0 +1,107 @@ +#!/usr/bin/env perl + +# this script deals with: +# - archived images which have not been reported to elixir, +# - images which need to be reprocessed, +# - images which can be send to CADC + +if (@ARGV != 2) { die "USAGE: ckimregdb (start) (range)\n" ;} + +# imsearch and ardrange12k have different default hr:mn:sc values +# this script converts to the ardrange12k defaults: 12:00:00 + +# test for current camera? + +$start = $ARGV[0]; +$range = $ARGV[1]; + +# force explicit starting hours: +@words = split (/\D/, $start); +if (@words == 3) { $start = "$start,12:00:00"; } +@words = split (/\D/, $range); +if (@words == 3) { $range = "$range,12:00:00"; } + +# get list of images in the archive & imreg.db: +if ($range =~ m|^-\d+[dhms]|) { + $answer = `/h/archive/sw/tools/ardrange12k $start$range`; +} else { + $answer = `/h/archive/sw/tools/ardrange12k $start+$range`; +} + +@archive = split (" ", $answer); +$N = @archive; +print "archive: $N files\n"; + +@imregdb = `imsearch -ccd 0 -trange $start $range -tz 10.0`; +$N = @imregdb; +print "imregdb: $N files\n"; + +# search for missing images in archive + ARCH: foreach $arch (@archive) { + + # is $arch in @imregdb? + foreach $imreg (@imregdb) { + @words = split (" ", $imreg); + if ($arch eq $words[5]) { next ARCH; } + } + + push @missing, $arch; + } + +$Nmiss = @missing; +print "$Nmiss files missing\n"; + +# link each missing image in /data/kapu/elixir/cfh12k: +$linkdir = `gconfig $opts ARCLINK_DIR`; chop $linkdir; +if ($?) { die "error in config system: missing ARCLINK_DIR\n"; } + +$archive = `gconfig $opts ARCHIVE_DIR`; chop $archive; +if ($?) { die "error in config system: missing ARCHIVE_DIR\n"; } + +# add missing links, elixir.link will add them to db +foreach $file (@missing) { + + $arcfile = sprintf "%s/%s", $archive, $file; + $linkfile = sprintf "%s/%s", $linkdir, $file; + + if (-l $linkfile) { + print STDERR "$linkfile exists, skipping\n"; + next; + } + symlink ($linkfile, $arcfile); +} + +# at this point, imstats from the last night is still running +# the unprocessed images and the newly linked images will be +# added to the imstats fifo (not ptolemy, don't bother!) + +# find images which need to be re-processed (entire run) +$runid = `gconfig RUNID.CURRENT`; chop $runid; +$answer = `mkrun run $runid`; +($tmp, $start, $stop) = split (" ", $answer); + +$fifo = `gconfig imstats`; chop $fifo; + +# the db lookup may take a long time or fail, the cat probably won't +system ("imsearch -trange $start $stop -proc f > $fifo.tmp"); +if (! -s "$fifo.tmp") { + system ("glockfile $fifo.source xcld 5 &"); + system ("cat $fifo.tmp >> $fifo.source"); +} + +# generate table of images which can be sent to CADC, mark as distributed: +system ("imsearch -ccd 3 -trange $start $stop -proc t -dist f -cadctable cadc.fits"); +system ("imsearch -ccd 3 -trange $start $stop -proc t -dist f -modify dist t"); + +# utilities ############################ + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + Index: /trunk/Ohana/src/perl/src/ckphotom =================================================================== --- /trunk/Ohana/src/perl/src/ckphotom (revision 17) +++ /trunk/Ohana/src/perl/src/ckphotom (revision 17) @@ -0,0 +1,35 @@ +#!/usr/bin/env perl + +# the specific ccd is passed in from outside + +if (@ARGV != 3) { die "USAGE: ckphotom (name) (ccd) (mode)\n" ;} + +$name = $ARGV[0]; +$ccd = $ARGV[1]; +$mode = "\U$ARGV[2]\E"; + +if (($mode ne "SPLIT") && ($mode ne "MEF")) { + print STDERR "mode must be SPLIT or MEF\n"; + exit (2); +} + +if (vsystem ("transearch -image $name $ccd $mode -equiv")) { + print STDOUT "$name fails, no photom data\n"; + exit 1; +} else { + print STDOUT "$name: pass\n"; + exit 0; +} + +# utilities ############################ + +sub vsystem { +# print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + Index: /trunk/Ohana/src/perl/src/ckrunid =================================================================== --- /trunk/Ohana/src/perl/src/ckrunid (revision 17) +++ /trunk/Ohana/src/perl/src/ckrunid (revision 17) @@ -0,0 +1,226 @@ +#!/usr/bin/env perl + +# USAGE: ckrunid (name) +# (name) may be a MEF or SINGLE CCD file or a SPLIT directory +# does not depend on the number of CCDs in the image + +if (@ARGV != 1) { die "USAGE: ckrunid (name)\n" ;} + +$name = $ARGV[0]; +$imtype = ckimtype ($name); +if (!$imtype) { exit 1; } + +if ($imtype eq SPLIT) { + $root = gt_names ($name, "root", $imtype); + $tmpname = "$name/$root" . "00.fits"; +} else { + $tmpname = $name; +} + +# need to abstract MJD-OBS keywrod +$answer = `echo $tmpname | fields MJD-OBS`; chop ($answer); +($fullname, $mjd_obs) = split (" ", $answer); +if ($mjd_obs eq "") { + print STDOUT "MJD-OBS not found in header for $tmpname\n"; + exit 1; +} + +$date = mjd_to_date ($mjd_obs); +$runinfo = `mkrun date $date`; +if ($?) { die "no run defined $date $mjd\n"; } + +($crunid, $start, $stop, $camera, $qrunid) = split (" ", $runinfo); +print STDOUT "$crunid\n"; +exit 0; + +################################################################################### + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +sub get_jd { + + my($year) = $_[0]; + my($month) = $_[1]; + my($day) = $_[2]; + + my($jd) = $day - 32075 + int (1461*($year + 4800 + int (($month - 14)/12))/4) + + int(367*($month - 2 - int(($month - 14)/12)*12)/12) + - int(3*int(($year + 4900 + int(($month - 14)/12))/100)/4) - 0.5; + + + return ($jd); + +} + +sub get_mjd { + + my($year) = $_[0]; + my($month) = $_[1]; + my($day) = $_[2]; + + my($jd) = $day - 32075 + int (1461*($year + 4800 + int (($month - 14)/12))/4) + + int(367*($month - 2 - int(($month - 14)/12)*12)/12) + - int(3*int(($year + 4900 + int(($month - 14)/12))/100)/4) - 0.5 - 2400000.5; + + + return ($jd); + +} + +sub mjd_to_date { + my ($mjd) = $_[0]; + my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday); + my ($date, $time); + + $time = 86400 * ($mjd - 40587.0); + ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = gmtime ($time); + $year += 1900; + $mon ++; + + $date = sprintf "%04d/%02d/%02d,%02d:%02d:%04.1f", $year, $mon, $mday, $hour, $min, $sec; + + return $date; +} + +sub gt_names { + # in: filename mode type + # out: word + + my ($value); + + $value = ""; + if ($_[2] eq "MEF") { $value = mefnames ($_[0], $_[1]); } + if ($_[2] eq "SPLIT") { $value = splitnames ($_[0], $_[1]); } + + return $value; +} + +sub mefnames { + # in: (/path/file.fits) (mode) + # out: word + + my($fullname) = $_[0]; + my($mode) = $_[1]; + my($answer); + + # split rootdir and filename: + my (@words) = split ("/", $fullname); + $N = @words; + + if ($mode eq "path") { + $answer = ""; + for ($i = 0; $i < $N - 1; $i++) { + $answer = $answer . $words[$i] . "/"; + } + chop ($answer); # strip off last / + if ($answer eq "") { $answer = "."; } + return ($answer); + } + + if ($mode eq "root") { + $answer = "$words[$N-1]"; + $answer =~ s/.fits$//; + return ($answer); + } + + if ($mode eq "Nccd") { + if (! -e $fullname) { + return (0); + } + $answer = `echo $fullname | fields NEXTEND`; + @words = split (" ", $answer); + if ($words[1] eq "") { + return (0); + } + return ($words[1]); + } + + return (0); +} + +sub splitnames { + # in: (/path/file) (mode) + # out: word + # /path/file is directory containing Nccd fits images + + my($fullname) = $_[0]; + my($mode) = $_[1]; + my($answer, $N, $tmpname, @imlist, @words); + + # split rootdir and filename: + @words = split ("/", $fullname); + $N = @words; + + if ($mode eq "path") { + $answer = ""; + for ($i = 0; $i < $N - 1; $i++) { + $answer = $answer . $words[$i] . "/"; + } + chop ($answer); # strip off last / + if ($answer eq "") { $answer = "."; } + return ($answer); + } + + if ($mode eq "root") { + $answer = "$words[$N-1]"; + return ($answer); + } + + if ($mode eq "Nccd") { + + $tmpname = "$fullname/$words[$N-1]"; + @imlist = <$tmpname??.fits>; + + $Nccd = @imlist; + return $Nccd; + } + + return (0); +} + +sub ckimtype { + # in: (/path/file) + # out: MEF | SPLIT | SINGLE | (NULL) + + my ($answer, $name, $value); + my ($file) = $_[0]; + + if (! -e $file) { + print STDOUT "can't open file\n"; + return ""; + } + + # if /path/file is a directory, it is split: + if (-d $file) { return "SPLIT"; } + + # check that the file is a FITS image + $answer = `file -L $file`; + if ($?) { + print STDOUT "can't open file\n"; + return ""; + } + ($name, $value) = split (" ", $answer); + if ($value ne "FITS") { + print STDOUT "not a valid image\n"; + return ""; + } + + # check for NAXIS = 0 (MEF) + $answer = `echo $file | fields NAXIS`; + # if ($?) { return ""; } + ($name, $value) = split (" ", $answer); + if ($value eq 0) { return "MEF"; } + + if ($value == 2) { return "SINGLE"; } + + print STDOUT "not a valid image\n"; + return ""; +} Index: /trunk/Ohana/src/perl/src/ckvalid =================================================================== --- /trunk/Ohana/src/perl/src/ckvalid (revision 17) +++ /trunk/Ohana/src/perl/src/ckvalid (revision 17) @@ -0,0 +1,298 @@ +#!/usr/bin/env perl + +$PASS = 0; +$FAIL = 1; +$SUBVALID = 2; +$DATA_ERR = 3; +$VERBOSE = 0; + +$eval{DATA} = 0; # image exists and is full-raster object MEF or SPLIT type +$eval{DETREND} = 0; # all needed detrend files exist for this image +$eval{FRINGES} = 0; # fringe frames exists if needed +$eval{ASTROM} = 0; # astrometry measured for at least N / 12 chips +$eval{PHOTOM} = 0; # photometry terms available for this image + +# USAGE: ckvalid (filename) +# (filename) may be a MEF file or a SPLIT directory +# [see end for notes] + +@tARGV = (); +while (@ARGV) { + if ($ARGV[0] eq "-v") { + $VERBOSE = 1; + shift @ARGV; + next; + } + @tARGV = (@tARGV, $ARGV[0]); + shift @ARGV; +} +@ARGV = @tARGV; + +if (@ARGV != 1) { die "USAGE: ckvalid (filename)\n" ;} +$name = $ARGV[0]; +$mode = "unknown"; +$type = "unknown"; +$runid = "none"; + +# determine image mode (SPLIT / MEF / SINGLE) +$mode = ckimmode ($name); +if ($mode eq "unknown") { + if ($VERBOSE) { print "can't identify image mode\n"; } + &print_status; + exit $DATA_ERR; +} +if ($mode eq "SINGLE") { + if ($VERBOSE) { print STDERR "mode = SINGLE, validation undefined\n"; } + &print_status; + exit $DATA_ERR; +} + +# get filename components +$path = gt_names ($name, "path", $mode); +$root = gt_names ($name, "root", $mode); +$Nccd = gt_names ($name, "Nccd", $mode); + +# create the name of a real file: +if ($mode eq SPLIT) { + $tmpname = "$name/$root" . "00.fits"; +} else { + $tmpname = $name; +} + +# find the run id for this image (needed to get astrometry) +$runid = `ckrunid $tmpname`; chop ($runid); +if ($?) { + if ($VERBOSE) { print STDOUT "$name: no run ID\n"; } + $runid = "none"; +} + +# check the IMAGETYP: +$answer = `echo $tmpname | fields OBSTYPE`; +($tmp, $type) = split (" ", $answer); +if ($type ne "OBJECT") { + if ($VERBOSE) { print STDOUT "$name: wrong image type $type\n"; } + &print_status; + exit $SUBVALID; +} + +# check the GEOMETRY: +$answer = `echo $tmpname | fields CCDBIN1 CCDBIN2 RASTER`; +@words = split (" ", $answer); +if (($words[1] != 1) || ($words[2] != 1)) { + if ($VERBOSE) { print STDOUT "$name: binned image\n"; } + &print_status; + exit $SUBVALID; +} +if ($words[3] ne "FULL") { + if ($VERBOSE) { print STDOUT "$name: sub-rastered image\n"; } + &print_status; + exit $SUBVALID; +} + +# image is OK +$eval{DATA} = 1; + +# check the ASTROMETRY: +unless ($runid eq "none") { + $answer = `ckastrom $runid $root $Nccd`; chop ($answer); + if ($?) { + if ($VERBOSE) { print "astrometry: $answer\n"; } + } else { + $eval{ASTROM} = 1; + } +} + +# check the DETREND data: +if ($mode eq "SPLIT") { + # we only need the name of an single representative file on disk + $tmpname = sprintf "%s/%s%02d.fits", $name, $root, 0; +} else { + $tmpname = $name; +} +$answer = `detsearch -quiet -mosaic $tmpname -recipe`; +if ($?) { + if ($VERBOSE) { print "missing detrend: $answer\n"; } +} else { + $eval{DETREND} = 1; +} + +# check on PHOTOMETRY +$answer = `ckphotom $tmpname 00 $mode`; +if ($?) { + if ($VEROSE) { print STDERR "photom failed: $answer\n"; } +} else { + $eval{PHOTOM} = 1; +} + +&print_status; +if ($eval{DATA} && $eval{DETREND} && $eval{PHOTOM} && $eval{ASTROM}) { exit $PASS; } +exit $FAIL; + +# utilities ############################################## + +sub print_status { + printf STDOUT "%s %8s %8s %8s %d %d %d %d\n", $name, $mode, $type, + $runid, $eval{DATA}, $eval{DETREND}, $eval{PHOTOM}, $eval{ASTROM}; +} + +sub gt_names { + # in: filename mode type + # out: word + + my ($value); + + $value = ""; + if ($_[2] eq "MEF") { $value = mefnames ($_[0], $_[1]); } + if ($_[2] eq "SPLIT") { $value = splitnames ($_[0], $_[1]); } + + return $value; +} + +sub mefnames { + # in: (/path/file.fits) (mode) + # out: word + + my($fullname) = $_[0]; + my($mode) = $_[1]; + my($answer); + + # split rootdir and filename: + my (@words) = split ("/", $fullname); + $N = @words; + + if ($mode eq "path") { + $answer = ""; + for ($i = 0; $i < $N - 1; $i++) { + $answer = $answer . $words[$i] . "/"; + } + chop ($answer); # strip off last / + if ($answer eq "") { $answer = "."; } + return ($answer); + } + + if ($mode eq "root") { + $answer = "$words[$N-1]"; + $answer =~ s/.fits$//; + return ($answer); + } + + if ($mode eq "Nccd") { + if (! -e $fullname) { + return (0); + } + $answer = `echo $fullname | fields NEXTEND`; + @words = split (" ", $answer); + if ($words[1] eq "") { + return (0); + } + return ($words[1]); + } + + return (0); +} + +sub splitnames { + # in: (/path/file) (mode) + # out: word + # /path/file is directory containing Nccd fits images + + my($fullname) = $_[0]; + my($mode) = $_[1]; + my($answer, $N, $tmpname, @imlist, @words); + + # split rootdir and filename: + @words = split ("/", $fullname); + $N = @words; + + if ($mode eq "path") { + $answer = ""; + for ($i = 0; $i < $N - 1; $i++) { + $answer = $answer . $words[$i] . "/"; + } + chop ($answer); # strip off last / + if ($answer eq "") { $answer = "."; } + return ($answer); + } + + if ($mode eq "root") { + $answer = "$words[$N-1]"; + return ($answer); + } + + if ($mode eq "Nccd") { + + $tmpname = "$fullname/$words[$N-1]"; + @imlist = <$tmpname??.fits>; + + $Nccd = @imlist; + return $Nccd; + } + + return (0); +} + +sub ckimmode { + # in: (/path/file) + # out: MEF | SPLIT | SINGLE | (NULL) + + my ($answer, $name, $value); + my ($file) = $_[0]; + + if (! -e $file) { + if ($VERBOSE) { print STDOUT "$file: can't open file\n"; } + return "unknown"; + } + + # if /path/file is a directory, it is split: + if (-d $file) { return "SPLIT"; } + + # check that the file is a FITS image + $answer = `file -L $file`; + if ($?) { + if ($VERBOSE) { print STDOUT "can't open file\n"; } + return "unknown"; + } + ($name, $value) = split (" ", $answer); + if ($value ne "FITS") { + if ($VERBOSE) { print STDOUT "not a valid image\n"; } + return "unknown"; + } + + # check for NAXIS = 0 (MEF) + $answer = `echo $file | fields NAXIS`; + # if ($?) { return ""; } + ($name, $value) = split (" ", $answer); + if ($value eq 0) { return "MEF"; } + + if ($value == 2) { return "SINGLE"; } + + if ($VERBOSE) { print STDOUT "not a valid image\n"; } + return "unknown"; +} + +sub vsystem { + # print STDERR "@_\n"; + my($status) = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + + +# This program calls several other perl scripts to get information +# about the image. +# ckrunid - determine the appropriate Camera Run ID for this image +# ckastrom - check for the appropriate astrometry information +# ckdetrend - check for the appropriate detrend images +# ckphotom - check for the appropriate photometry data + +# at the moment, there are different calling conventions for each of +# these functions. Some take a single name (MEF / SPLIT), some take a +# reference to the specific CCD (filename CCD MODE). + +# none of the called functions need to find the number of CCDs +# ckvalid determines the number of CCDs from the header (MEF) or the +# number of appropriately named FITS files in the directory (SPLIT). + Index: /trunk/Ohana/src/perl/src/cmp.header =================================================================== --- /trunk/Ohana/src/perl/src/cmp.header (revision 17) +++ /trunk/Ohana/src/perl/src/cmp.header (revision 17) @@ -0,0 +1,94 @@ +#!/usr/bin/env perl + +$version = 1.0; +if (@ARGV != 2) { die "USAGE: cmp.header (cmpfile) (hdrfile)\n" ; } + +$cmpfile = $ARGV[0]; +$hdrfile = $ARGV[1]; + +&ckpathname ("$hdrfile"); + +if (! -e $cmpfile) { die "ERROR: source cmpfile $cmpfile not found\n"; } + +# grab astrometry keywords from $cmpfile: +@header = &load_header ($cmpfile); + +# convert stripped header to valid FITS file: NAXIS -> 0 +$found = 0; +for ($i = 0; ($i < 16) && ($i < @header); $i++) { + if ($header[$i] =~ /^NAXIS =/) { + $header[$i] = sprintf "NAXIS = %20d / %-47s", 0, "Header without Pixels"; + $found = 1; + last; + } +} +if (!$found) { print STDERR "header is missing NAXIS\n"; } + +# write output to file +open (FILE, ">$hdrfile"); +foreach $line (@header) { + print FILE "$line"; +} +for ($i = 0; $i < $Nextra; $i++) { + for ($j = 0; $j < 80; $j++) { + print FILE " "; + } +} +close (FILE); + +print "SUCCESS: done with cmp.header\n"; +exit 0; + +################################################################################### + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +sub load_header { + + my ($file) = $_[0]; + my ($buffer, $done, @buffer, $line); + + open (FILE, "$file"); + + $done = 0; + @buffer = (); + + while (! $done) { + read FILE, $buffer, 2880; + for ($i = 0; $i < 2880; $i+=80) { + $line = substr ($buffer, $i, 80); + @buffer = (@buffer, $line); + if ($line =~ /^END /) { $done = 1; } + } + } + close (FILE); + return (@buffer); +} + +# given a filename, check that its path exists, create it if not +sub ckpathname { + my ($file) = $_[0]; + my (@words, $dir); + + @words = split ("/", $file); + pop (@words); + $dir = join ("/", @words); + + if ($dir eq "") { $dir = "."; } + + if (! -d $dir) { + system ("mkdir -p $dir"); + if ($?) { + print STDERR "ERROR: can't make directory component for $file\n"; + exit 1; + } + } +} Index: /trunk/Ohana/src/perl/src/create.subset =================================================================== --- /trunk/Ohana/src/perl/src/create.subset (revision 17) +++ /trunk/Ohana/src/perl/src/create.subset (revision 17) @@ -0,0 +1,28 @@ +#!/usr/bin/env perl + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +if (@ARGV != 2) { die "ERROR: USAGE: create.subset (master) (subset)\n" } + +# load in stats lines +open (IN, $ARGV[0]); +open (OUT, ">$ARGV[1]"); +while ($line = ) { + chop ($line); + @words = split (" ", $line); + if ($words[1]) { + print OUT "$words[0]\n"; + } +} +close (IN); +close (OUT); + +print STDERR "SUCCESS\n"; Index: /trunk/Ohana/src/perl/src/dads.detrend =================================================================== --- /trunk/Ohana/src/perl/src/dads.detrend (revision 17) +++ /trunk/Ohana/src/perl/src/dads.detrend (revision 17) @@ -0,0 +1,242 @@ +#!/usr/bin/env perl +# calls flatten.flips & defringe, but no flips components directly + +$CLEANUP = 1; +$DO_DEFRINGE = 0; +$DO_DEMODE = 0; + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +if (@ARGV != 3) { die "USAGE: dads.detrend (inbase) (outbase) (level)\n" } + +# level may be: 'perfect', 'best', 'raw' +$level = "\U$ARGV[2]\E"; +if (($level ne "PERFECT") && ($level ne "BEST") && ($level ne "RAW")) { + die "ERROR: invalid entry for (level)\n"; +} +$close = ""; +if ($level eq "BEST") { $close = "-close"; } + +if (! -d $ARGV[1]) { mkdir ($ARGV[1], 0777); } + +# get input list: +@rawlist = <$ARGV[0]/*.raw>; +if (@rawlist == 0) { die "ERROR: no files found\n"; } + +# get total image size: +$Nbyte = 0; +foreach $file (@rawlist) { + @words = stat ($file); + $Nbyte += $words[7]; +} + +# check space on /tmp: +@answer = `df -k /tmp`; +@words = split (" ", $answer[1]); +$Nfree = $words[3]*1024; + +# choose a work directory (/tmp vs $ARGV[1]): +$workdir = $ARGV[1]; +if ($Nfree > 3*$Nbyte) { + $workdir = "/tmp"; +} + +# create output lists: +@fitlist = (); +@detlist = (); +@demlist = (); +foreach $in (@rawlist) { + ($middle) = $in =~ /$ARGV[0](\S+)raw$/; + + # create output name + $name = $ARGV[1] . $middle . "fits"; + @fitlist = (@fitlist, $name); + + # create tmp detrended name + $name = $workdir . $middle . "det"; + @detlist = (@detlist, $name); + + # create tmp demoded name + $name = $workdir . $middle . "dem"; + @demlist = (@demlist, $name); + + # create tmp defringed name + $name = $workdir . $middle . "def"; + @deflist = (@delist, $name); +} + +# for raw distribution, we don't check image charatersitics +if ($level eq "RAW") { + for ($i = 0; $i < @rawlist; $i++) { + $status = system ("mv $rawlist[$i] $fitlist[$i]"); + if ($status) { die "ERROR: failed to remame raw file $rawlist[$i]\n"; } + } + print STDOUT "SUCCESS: finished with dads.detrend\n"; + exit 0; +} + +# use first image to test image characteristics +$name = $rawlist[0]; + +$typekwd = `gconfig IMAGETYPE-KEYWORD`; chop $typekwd; +$filtkwd = `gconfig FILTER-KEYWORD`; chop $filtkwd; +$exptkwd = `gconfig EXPTIME-KEYWORD`; chop $exptkwd; +$answer = `cameraconfig -ccds`; +@ccds = split (" ", $answer); + +# check the IMAGETYP: +$answer = `echo $name | fields $typekwd`; +($tmp, $type) = split (" ", $answer); +if ($type ne "OBJECT") { die "ERROR: $name: wrong image type\n"; } + +# this should be abstracted to the filter or recipe file... +# check the FILTER and EXPTIME, include fringe correction?: +$answer = `echo $name | fields $exptkwd $filtkwd`; +($junk, $exptime, $filtvalue) = split (" ", $answer); +$filtvalue = "\U$filtvalue\E"; +$filter = `filtnames $filtvalue`; chop $filter; +# check valid answer here + +# set defringe and/or demode based on filter & exptime +if ($filter eq "R") { + $DO_DEMODE = ($exptime > 60); +} +if ($filter eq "I") { + $DO_DEFRINGE = ($exptime > 60); + $DO_DEMODE = ($exptime > 60); +} +if ($filter eq "Z") { + $DO_DEFRINGE = ($exptime > 60); + $DO_DEMODE = ($exptime > 60); +} +if ($filter eq "NB920") { + $DO_DEFRINGE = ($exptime > 60); + $DO_DEMODE = ($exptime > 60); +} + +# check the GEOMETRY: +$answer = `echo $name | fields CCDBIN1 CCDBIN2 RASTER`; +@words = split (" ", $answer); +if (($words[1] != 1) || ($words[2] != 1)) { die "ERROR: $name: binned image\n"; } +if ($words[3] ne "FULL") { die "ERROR: $name: sub-rastered image\n"; } + +# check for valid detrend frames of needed types (this needs to be implemented with the -recipe function) + +# check for mode frame: +if ($DO_DEMODE) { + $name = $rawlist[0]; + $status = system ("detsearch -quiet -image $name $ccds[0] split -type modes $close"); + if ($status) { die "ERROR: can't get valid mode file\n"; } +} + +# check for fringe frame: +if ($DO_DEFRINGE) { + foreach $name (@rawlist) { + $status = system ("detsearch -quiet -image $name $ccds[0] split -type fringe $close"); + if ($status) { die "ERROR: can't get valid fringe frame for this image\n"; } + } +} + +# check for detrend frame: +foreach $name (@rawlist) { + $status = system ("detsearch -quiet -image $name $ccds[0] split -type bias $close"); + $status = system ("detsearch -quiet -image $name $ccds[0] split -type dark $close"); + $status = system ("detsearch -quiet -image $name $ccds[0] split -type mask $close"); + $status = system ("detsearch -quiet -image $name $ccds[0] split -type flat $close"); + if ($status) { die "ERROR: can't get valid fringe frame for this image\n"; } +} + +# final output is @fitlist +# detrend @rawlist @detlist +# demode @detlist @demlist +# defringe @demlist @deflist +# if we skip a step, re-assign list as needed: +if ( $DO_DEFRINGE && $DO_DEMODE) { @deflist = @fitlist; } +if ( $DO_DEFRINGE && !$DO_DEMODE) { @deflist = @fitlist; @demlist = @detlist; } +if (!$DO_DEFRINGE && $DO_DEMODE) { @demlist = @fitlist; } +if (!$DO_DEFRINGE && !$DO_DEMODE) { @detlist = @fitlist; } + +# run the detrend system +for ($i = 0; $i < @rawlist; $i++) { + + $status = vsystem ("flatten.flips $close -quiet $rawlist[$i] $detlist[$i] $ccds[$i] split"); + if ($status) { &escape ("ERROR: problem running flatten on $rawlist[$i]"); } +} + +# we need files containing detlist, demlist, deflist: +if ($DO_DEMODE || $DO_DEFRINGE) { + $detlist = "$ARGV[1].detlist"; + open (FILE, ">$detlist"); + foreach $name (@detlist) { + print FILE "$name\n"; + } + close (FILE); +} +if ($DO_DEMODE) { + $demlist = "$ARGV[1].demlist"; + open (FILE, ">$demlist"); + foreach $name (@demlist) { + print FILE "$name\n"; + } + close (FILE); +} +if ($DO_DEFRINGE) { + $deflist = "$ARGV[1].deflist"; + open (FILE, ">$deflist"); + foreach $name (@deflist) { + print FILE "$name\n"; + } + close (FILE); +} + +if ($DO_DEMODE) { + $status = vsystem ("demodemap $detlist $demlist $close"); + if ($status) { &escape ("ERROR: problem running demodemap on $ARGV[1]"); } +} + +if ($DO_DEFRINGE) { + $status = vsystem ("defringe $demlist $deflist $close"); + if ($status) { &escape ("ERROR: problem running defringe on $ARGV[1]"); } +} + +&cleanup; +print STDOUT "SUCCESS: finished with dads.detrend\n"; +exit 0; + +sub escape { + # cleanup temporary files: + + &cleanup; + die "$_[0]\n"; + exit 1; +} + +sub cleanup { + + if (!$CLEANUP) { return; } + + # detlist, demlist, deflist + foreach $name (@detlist) { + if (-e $name && ($name =~ m|^/tmp/|)) { unlink ($name); } + } + foreach $name (@demlist) { + if (-e $name && ($name =~ m|^/tmp/|)) { unlink ($name); } + } + foreach $name (@deflist) { + if (-e $name && ($name =~ m|^/tmp/|)) { unlink ($name); } + } + + if (-e $detlist) { unlink ($detlist); } + if (-e $demlist) { unlink ($detlist); } + if (-e $deflist) { unlink ($detlist); } + + return; +} Index: /trunk/Ohana/src/perl/src/dads.jpeg =================================================================== --- /trunk/Ohana/src/perl/src/dads.jpeg (revision 17) +++ /trunk/Ohana/src/perl/src/dads.jpeg (revision 17) @@ -0,0 +1,59 @@ +#!/usr/bin/env perl + +if (@ARGV != 3) { die "USAGE: dads.jpeg (inbase) (outbase) (level)\n" } + +# test named Xserver, or start vnc on specified machine +$xhost = `gconfig XHOST`; chop $xhost; +$xdisp = `gconfig XDISP`; chop $xdisp; +if (vsystem ("/usr/bin/X11/xdpyinfo -display $xdisp")) { + print STDERR "X server is not running. start it now on $xhost\n"; + exit 1; +} +$ENV{'DISPLAY'} = $xdisp; + +# find mana script +$confdir = `gconfig CONFDIR`; chop $confdir; +$script = "$confdir/mana/dads.pro"; + +# get image list +@ilist = <$ARGV[0]/*.fits>; + +# level may be: 'perfect', 'best', 'raw' +$level = "\U$ARGV[2]\E"; +if (($level ne "PERFECT") && ($level ne "BEST") && ($level ne "RAW")) { + die "ERROR: invalid entry for (level)\n"; +} + +$out1 = "$ARGV[1].b10.jpg"; +$out2 = "$ARGV[1].b50.jpg"; + +open (MANA, "|mana --norc"); +print MANA "input $script\n"; +print MANA "init.mosaic\n"; +print MANA "macro go\n"; +foreach $in (@ilist) { + print MANA "load.image $in\n"; +} +print MANA "do.jpeg $out1 $out2 $level\n"; +print MANA "exit 0\n"; +print MANA "end\n"; +print MANA "go\n"; +print MANA "exit 1\n"; +close (MANA); +if ($?) { + die "ERROR: problem running dads.jpeg\n"; +} + +print STDOUT "SUCCESS: finished running dads.jpeg\n"; +exit 0; + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + Index: /trunk/Ohana/src/perl/src/dads.keywords =================================================================== --- /trunk/Ohana/src/perl/src/dads.keywords (revision 17) +++ /trunk/Ohana/src/perl/src/dads.keywords (revision 17) @@ -0,0 +1,90 @@ +#!/usr/bin/env perl + +if (@ARGV != 1) { die "USAGE: dads.keywords (outdir)\n" ;} + +# get list of image files: +@ilist = <$ARGV[0]/*.fits>; +$name = $ilist[0]; + +# get appropriate run ID +$runid = `ckrunid $name`; chop ($runid); +if ($?) { + print STDERR "ERROR: can't find run ID\n"; + exit 1; +} + +# get the appropriate reduced data directory +$tmpdir=`gconfig -D RUNID $runid TMPDIR`; chop ($tmpdir); +if ($?) { + print STDERR "ERROR: can't find tmpdir\n"; + exit 1; +} + +if (! -d $tmpdir) { + print STDERR "ERROR: can't open $tmpdir\n"; + exit 1; +} + +foreach $name (@ilist) { + + # files have names like /path/654321p/654321p00.fits + + # split rootdir and filename: + @words = split ("/", $name); + $N = @words; + + # extract root (654321p) convert to original form (654321o) + ($root, $ccd) = $words[$N-1] =~ /(\d\d\d\d\d\d)\S(\d\d)/; + $base = sprintf "%so/%so%02d", $root, $root, $ccd; + + # generate name of output header file + $hdxfile = $name; + $hdxfile =~ s/.fits$/.hdx/; + if ($hdxfile eq $name) { + print STDERR "ERROR in format of filename $name\n"; + exit 1; + } + + # grab.keywords tests both smp & cmp + $cmproot = "$tmpdir/$base"; + if (vsystem ("grab.keywords $name $cmproot $hdxfile")) { + print STDERR "ERROR: can't get keywords for $name\n"; + exit 1; + } + + if (vsystem ("fits_insert $name $hdxfile -comment 5 'Fully Characterized and Analysed by Elixir @ CFHT'" )) { + print STDERR "ERROR inserting keywords in $name\n"; + exit 1; + } +} + +print STDERR "SUCCESS: applied new keywords\n"; +exit 0; + +# utilities ############################################## + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + + + +sub junk { + + # create the basic entries for a header + $line = sprintf "SIMPLE = T / Standard FITS \n"; @output = (@output, $line); + $line = sprintf "BITPIX = 8 / no actual data in this file\n"; @output = (@output, $line); + $line = sprintf "NAXIS = 0 / Number of axes \n"; @output = (@output, $line); + + + + # fill in the bottom of the header + $line = sprintf "END"; @output = (@output, $line); +} + Index: /trunk/Ohana/src/perl/src/darktime.cfh12k =================================================================== --- /trunk/Ohana/src/perl/src/darktime.cfh12k (revision 17) +++ /trunk/Ohana/src/perl/src/darktime.cfh12k (revision 17) @@ -0,0 +1,33 @@ +#!/usr/bin/env perl + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +if (@ARGV != 2) { die "USAGE: darktime.cfht (image.exptime) (dark.exptime)\n" } + +$t1 = $ARGV[0]; +$t2 = $ARGV[1]; + +$a = 0.000781480; +$b = 5.45879e-06; +$c = -1.21674e-09; + +$d1 = $a*$t1 + $b*$t1**2 + $c*$t1**3; + +$d2 = $a*$t2 + $b*$t2**2 + $c*$t2**3; + +$f = $d1 / $d2; + +# no dark correction for exptime < 15 sec +if ($t1 < 15) { $f = 0.001; } + +print STDOUT "$f\n"; + +exit 0; Index: /trunk/Ohana/src/perl/src/darktime.linear =================================================================== --- /trunk/Ohana/src/perl/src/darktime.linear (revision 17) +++ /trunk/Ohana/src/perl/src/darktime.linear (revision 17) @@ -0,0 +1,17 @@ +#!/usr/bin/env perl + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +if (@ARGV != 2) { die "USAGE: darktime.linear (image.exptime) (dark.exptime)\n" } + +print STDOUT "1.0\n"; + +exit 0; Index: /trunk/Ohana/src/perl/src/demodemap =================================================================== --- /trunk/Ohana/src/perl/src/demodemap (revision 17) +++ /trunk/Ohana/src/perl/src/demodemap (revision 17) @@ -0,0 +1,71 @@ +#!/usr/bin/env perl + +if ((@ARGV != 2) && (@ARGV != 3)) { die "USAGE: demodemap (inlist) (outlist) [-close]\n" } + +$inlist = $ARGV[0]; +$outlist = $ARGV[1]; + +$close = ""; +if ((@ARGV == 3) && ($ARGV[2] eq "-close")) { + $close = "-close"; +} + +open (FILE, "$inlist"); +@list = ; +$first = $list[$i]; chop ($first); +close (FILE); + +# find the appropriate script file +$confdir = `gconfig -q CONFDIR`; chop ($confdir); +$script = "$confdir/mana/modes.pro"; +$answer = `cameraconfig -ccds`; +@ccds = split (" ", $answer); + +$scale = 256; +$modefits = `detsearch $close -quiet -image $first $ccds[0] split -type modes`; chop ($modefits); +if ($?) { + print "ERROR: can't get mode image\n"; + exit 1; +} +@words = split ("/", $modefits); +$basename = $words[-1]; + +open (MANA, "|mana --norc"); +print MANA "input $script\n"; +print MANA "demodemap $inlist $outlist $modefits $basename $scale\n"; +print MANA "exit 1\n"; +close (MANA); +if ($?) { + print STDERR "ERROR problem with demodemap\n"; + exit 1; +} + +# print STDOUT "SUCCESS: finished with demodemap\n"; + +exit 0; + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + + +sub old { + print MANA "macro go\n"; + print MANA " medianmosaic $inlist 256\n"; # load images, create mosaic + print MANA " rd U $modefits\n"; # load mode images + print MANA " getmodes\n"; # extract modes from mode image + print MANA " setmodes2\n"; # determine mode contributions + print MANA " mkmodel\n"; # create modal map + + print MANA " applymodalmap $inlist $outlist 256\n"; # subtract modal map from inlist images + print MANA " exit 0\n"; + print MANA "end\n"; + + print MANA "go\n"; +} Index: /trunk/Ohana/src/perl/src/dt.select =================================================================== --- /trunk/Ohana/src/perl/src/dt.select (revision 17) +++ /trunk/Ohana/src/perl/src/dt.select (revision 17) @@ -0,0 +1,178 @@ +#!/usr/bin/env perl +$SKIPDOME = 0; + +if (@ARGV != 6) { die "ERROR: USAGE: imselect (type) (filter) (tstart) (tend) (output) (-split | -mef)\n" } + +$type = "\U$ARGV[0]\E"; +$filter = "\U$ARGV[1]\E"; +$start = $ARGV[2]; +$stop = $ARGV[3]; +$output = $ARGV[4]; +$mode = $ARGV[5]; + +unless ($output =~ /CCDNUM/) { die "ERROR: output file needs CCDNUM component\n"; } + +if (($mode ne "MEF") && ($mode ne "SPLIT")) { die "ERROR: mode must be either -split or -mef\n"; } + +if ($type eq "DARK") { } + +if ($type eq "FLAT") { + # define some of the relevant parameters + $min = 2000; + $max = 60000; + $minrate = 100; + $ratescale = 70; + if ($filter eq "B") { $minrate = 0.5 * $ratescale; } + if ($filter eq "V") { $minrate = 1.0 * $ratescale; } + if ($filter eq "R") { $minrate = 3.5 * $ratescale; } + if ($filter eq "I") { $minrate = 14.2 * $ratescale; } + if ($filter eq "Z") { $minrate = 10.5 * $ratescale; } + if ($filter eq "HA") { $min = 1000; } + if ($filter eq "HAOFF") { $min = 1000; } + # probably need to set these in a more intelligent fashion. +} + +# relevant camera parameters +$Nccd = `cameraconfig -Nccd`; chop ($Nccd); +$line = `cameraconfig -axes`; chop ($line); +($Naxis1, $Naxis2) = split (" ", $line); + +@good = (); +@marginal = (); + +# define filter lines for imsearch. for flats, there may be alternate filter names to test +@filtline = (); +if ($type eq "FLAT") { + # convert given filter name to list of possible names: + print STDERR "filtnames $filter -all\n"; + @filtlist = `filtnames $filter -all`; + foreach $name (@filtlist) { + chop $name; + $line = "-type flat -filter $name -mode $mode -trange $start $stop"; + push @filtline, $line; + } +} +if ($type eq "BIAS") { + push @filtline, "-type bias -mode $mode -trange $start $stop"; +} +if ($type eq "DARK") { + push @filtline, "-type dark -etime $ARGV[1] -mode $mode -trange $start $stop"; +} + +# run selection on each possible $filtline +@list = (); +foreach $line (@filtline) { + @tlist = `imsearch -ccd 0 $line`; + @list = (@list, @tlist); +} +$Nlist = @list; +print STDERR "found $Nlist images\n"; + +FRAME: +foreach $frame (@list) { + @words = split (" ",$frame); + print "$words[5]\n"; + + # skip domeflat images + if ($SKIPDOME && ($type eq "FLAT")) { + # a fairly lame and non-robust way to detect dome flats + @answer = `echo $words[4]/$words[5] | fields OBJECT | grep -i dome`; + if ($answer[0] ne "") { print STDERR "$words[5] rejected: dome flat\n"; next FRAME; } + + # test for acceptable time (or is probably a dome flat) + $answer = `dusktime $words[8]`; + ($tmp, $tmp, $dt) = split (" ", $answer); + if ($dt < 0) { print STDERR "$words[5] rejected: not twilight\n"; next FRAME; } + } + + # image(s) must exist on disk: + if ($mode eq "SPLIT") { + # all $Nccd images must exist on disk, split files are assumed to be + # in a subdirectory of their own, .fits extension assumed + @answer = <$words[4]/*.fits>; + if (@answer != $Nccd) { print STDERR "$words[5] rejected: missing images\n"; next FRAME; } + } + + # images have to have the correct dimensions + if ($mode eq "SPLIT") { + $answer = `echo $words[4]/$words[5] | fields NAXIS1 NAXIS2`; + } else { + $answer = `echo $words[4]/$words[5] | fields -x 0 NAXIS1 NAXIS2`; + } + ($tmp, $Nx, $Ny) = split (" ", $answer); + if (($Nx != $Naxis1) || ($Ny != $Naxis2)) { print STDERR "$words[5] rejected: wrong dimensions\n"; next FRAME; } + + # search for Nccd images with same name + if ($mode eq "split") { + @answer = split ("/", $words[4]); + $match = $answer[-1]; + } else { + $match = $words[5]; + } + @list2 = `imsearch -seq -name $match`; + if (@list2 != $Nccd) { print STDERR "$words[5] rejected: missing entries in image database\n"; next FRAME; } + + # test flux levels for FLATS + if ($type eq "FLAT") { + CHIP: # check for counts or flux out of range or any chip + foreach $chip (@list2) { + @words2 = split (" ", $chip); + + # test for acceptable flux range + if ($words2[11] < $min) { $range = 0; print STDERR "$words[5] rejected: signal too low: $words2[11] vs $min\n"; next FRAME; } + if ($words2[11] > $max) { $range = 0; print STDERR "$words[5] rejected: signal too high: $words2[11] vs $max\n"; next FRAME; } + + # test for acceptable rate + if (($words2[11] / $words2[7]) < $minrate) { + $rate = 0; + $F = $words2[11] / $words2[7]; + print STDERR "$words[5] rejected: flux too low: $F vs $minrate\n"; next FRAME; } + } + } + + # add good images to the output lists + foreach $line (@list2) { + @words2 = split (" ", $line); + $tmp = sprintf "chip%02d", $words2[3]; + @$tmp = (@$tmp, "$words2[4]/$words2[5]"); + } + if (($type eq "BIAS") && (@$tmp > 30)) { last FRAME; } + if (($type eq "DARK") && (@$tmp > 30)) { last FRAME; } + if (($type eq "FLAT") && (@$tmp > 50)) { last FRAME; } +} + +# write output to Nccd files +for ($i = 0; $i < $Nccd; $i++) { + $name = $output; + $ccd = sprintf "%02d", $i; + $name =~ s/CCDNUM/$ccd/; + $tmp = sprintf "chip%02d", $i; + + open (LIST, ">$name"); + foreach $line (@$tmp) { + print LIST "$line\n"; + } + close (LIST); +} +print "\n"; +print STDERR "SUCCESS\n"; +exit 0; + +# we need to select the list of images which satisfy a few criteria: +# 1) all 12 CCDs must exist +# 2) stats must be measured for each +# 3) stats for all 12 must be within range (2000 - 40000) +# 4) NAXIS1 == 2080 && NAXIS2 == 4128 + + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + print STDERR "ending execution\n"; + die "@_"; +} + Index: /trunk/Ohana/src/perl/src/elixir.link =================================================================== --- /trunk/Ohana/src/perl/src/elixir.link (revision 17) +++ /trunk/Ohana/src/perl/src/elixir.link (revision 17) @@ -0,0 +1,146 @@ +#!/usr/bin/env perl + +# this script searches for new links in the archive elixir directory, +# creates links for the new images in the elixir TMPDIR tree, +# registers the images in the elixir database, and +# sends the images to imstats for processing. + +use English; + +# check usage +if (@ARGV != 0) { die "USAGE: elixir.link\n"; } + +# what do we do about config file? demand account be set up correctly? +$camera = `gconfig CAMERA.CURRENT`; chop $camera; +$runid = `gconfig RUNID.CURRENT`; chop $runid; +$opts = "-D CAMERA $camera -D RUNID $runid"; + +{ # check camera validity + if ($camera eq "cfh12k") { last; } + if ($camera eq "megacam") { last; } + if ($camera eq "cfhtir") { last; } + die "invalid camera $camera"; +} + +$fifos = `gconfig $opts FIFOS`; chop $fifos; +if ($?) { die "error in config system: missing FIFOS\n"; } + +$rawdir = `gconfig $opts RAWDIR`; chop $rawdir; +if ($?) { die "error in config system: missing RAWDIR\n"; } + +$linkdir = `gconfig $opts ARCLINK_DIR`; chop $linkdir; +if ($?) { die "error in config system: missing ARCLINK_DIR\n"; } + +$archive = `gconfig $opts ARCHIVE_DIR`; chop $archive; +if ($?) { die "error in config system: missing ARCHIVE_DIR\n"; } + +@links = glob ("$linkdir/*"); +# @links = ("/data/kapu/elixir/cfhtir/661966o.fits", "/data/kapu/elixir/cfhtir/663910o.fits", "/data/kapu/elixir/cfhtir/663913o.fits", "/data/kapu/elixir/cfhtir/663916o.fits", "/data/kapu/elixir/cfhtir/663919o.fits"); + +if (! @links) { exit 0; } + +$Ngood = 0; +$Nskip = 0; +$Nfail = 0; + +foreach $name (@links) { + if (! -l $name) { $Nskip ++; next; } + + # find real path + $rootname = filename ($name); + $arcfile = sprintf "%s/%s", $archive, $rootname; + + # set new path (skip if it exists) + $rawfile = sprintf "%s/%s", $rawdir, $rootname; + if ((-e $rawfile) || (-l $rawfile)) { + $Nskip ++; + unlink ($name); + next; + } + + # link file into rawdir: + $status = symlink ($arcfile, $rawfile); + if (! $status) { + $Nfail ++; + next; + } + + # these files always come in as MEF or CUBE + vsystem ("imsort $opts $rawfile"); + if ($?) { + # allow for retry on failure + $Nfail ++; + unlink ($rawfile); + next; + } + + $Ngood ++; + unlink $name; +} + +print STDERR "elixir.link: $Ngood good, $Nskip skip, $Nfail fail\n"; +exit 0; + +# utilities ############################################## + +sub vsystem { + print STDERR "@_\n"; + my ($status) = system ("@_"); + $status; +} + +sub filename { + + my ($path) = $_[0]; + my (@tmp); + + @tmp = split ("/", $path); + return $tmp[-1]; +} + +sub convertlink { + my ($link) = $_[0]; + my ($file); + + while (-l $link) { + $file = readlink ($link); + $path1 = path ($link); + $path2 = path ($file); + + unless ($path2 =~ m|^/|) { + $file = "$path1/$file"; + } + $link = $file; + } + return ($link); +} + +sub usage { + + if (@ARGV == 1) { + print STDERR "\n --- user modes ---\n"; + print STDERR "create (run) (start) (stop)\n"; + print STDERR "addqso (runid) (qsoid)\n"; + print STDERR "delqso (qsoid)\n"; + print STDERR "sched (runid)\n"; + print STDERR "status\n"; + &goodbye; + } + + if (@ARGV > 2) { print STDERR "USAGE: prepare.run (help) [mode]\n"; &goodbye; } + + &goodbye; +} + +sub path { + + my ($file) = $_[0]; + + @words = split ("/", $file); + + pop (@words); + + $path = join ("/", @words); + + return ($path); +} Index: /trunk/Ohana/src/perl/src/elixir.photreport =================================================================== --- /trunk/Ohana/src/perl/src/elixir.photreport (revision 17) +++ /trunk/Ohana/src/perl/src/elixir.photreport (revision 17) @@ -0,0 +1,46 @@ +#!/usr/bin/env perl + +if (@ARGV != 2) { die "USAGE : elixir.photreport (name) (catdir)\n"; } + +$name = $ARGV[0]; +$catdir = $ARGV[1]; + +# test named Xserver, or start vnc on specified machine +$xhost = `gconfig XHOST`; chop $xhost; +$xdisp = `gconfig XDISP`; chop $xdisp; +if (system ("/usr/bin/X11/xdpyinfo -display $xdisp")) { + print STDERR "X server is not running. start it now on $xhost\n"; + exit 1; +} +$ENV{'DISPLAY'} = $xdisp; + +@filter = ("B", "V", "R", "I"); +# @filter = ("B"); + +# this should come fron the config system +$logdir = `gconfig LOGDIR`; chop $logdir; +$confdir = `gconfig CONFDIR`; chop $confdir; +$script = "$confdir/mana/standards"; + +# run mana, call script +open (STAT, "|status -D CATDIR $catdir --norc"); +print STAT "input $script\n"; + +# place commands in a macro +print STAT "macro go\n"; +foreach $filter (@filter) { + print STAT "echo $filter\n"; + print STAT "photreport $filter $name\n"; +} +print STAT "exit 0\n"; +print STAT "end\n"; + +print STAT "go\n"; +print STAT "exit 1\n"; +close (STAT); +if ($?) { + print STDERR "ERROR problem with photreport\n"; + exit 1; +} +print STDOUT "SUCCESS: finished with photreport\n"; +exit 0; Index: /trunk/Ohana/src/perl/src/elixir.postrun =================================================================== --- /trunk/Ohana/src/perl/src/elixir.postrun (revision 17) +++ /trunk/Ohana/src/perl/src/elixir.postrun (revision 17) @@ -0,0 +1,610 @@ +#!/usr/bin/env perl + +# check usage +if (@ARGV == 0) { &usage; } +if ($ARGV[0] eq "help") { &usage; } + +@ARGV = elixir_config (@ARGV); + +if ($ARGV[0] eq "config") { &set_config; } +if ($ARGV[0] eq "set") { &set_entry; } +if ($ARGV[0] eq "state") { &state; } +if ($ARGV[0] eq "update") { &update; } + +&escape ("unknown command $ARGV[0]"); + +############# change current run ############## +sub set_config { + if (@ARGV != 3) { &escape ("USAGE: elixir.postrun config (camera) (run)"); } + + $camera = $ARGV[1]; + $run = $ARGV[2]; + + # set current run id: + system ("mkrun sys camera.postrun $camera"); + if ($?) { &escape ("can't define camera: error in mkrun"); } + + # set current run id: + system ("mkrun sys runid.postrun $run"); + if ($?) { &escape ("can't define run: error in mkrun"); } + + &goodbye; +} + +############## +sub state { + print STDOUT "CAMERA: $camera\n"; + print STDOUT "RUNID: $runid\n"; + print STDOUT "RUNDIR: $rundir\n"; + + &load_state; + foreach $entry (@entry) { + printf STDERR "%-15s %-10s\n", $entry, $state{$entry}; + } + &goodbye; +} + +############## +sub load_state { + # db contains: (entry) (state) + open (FILE, $dbfile); + @list = ; + close (FILE); + + # there should be one line for each possible entry in @entry + # if a line is missing, set it to init + # if a line is extra, kill it. + + # look for invalid entries + foreach $line (@list) { + ($entry, $state) = split (" ", $line); + if (! $def_state{$entry}) { next; } + $state{$entry} = $state; + } + + # look for missing entries + foreach $entry (@entry) { + if (! $state{$entry}) { $state{$entry} = $def_state{$entry}; } + } +} + +############## +sub save_state { + open (FILE, ">$dbfile"); + foreach $entry (@entry) { + print FILE "$entry $state{$entry}\n"; + } + close (FILE); +} + +############## +sub set_entry { + + if (@ARGV != 3) { &escape ("USAGE: elixir.postrun set (entry) (value)"); } + + $reset = $ARGV[1]; + $value = $ARGV[2]; + + &load_state; + + if (! $state{$reset}) { &escape ("invalid entry $reset"); } + + $state{$reset} = $value; + &save_state; + &goodbye; +} + +############## +sub update { + + &load_state; + + foreach $entry (@entry) { + update_state ($entry); + printf STDERR "%-15s %-10s\n", $entry, $state{$entry}; + } + + &save_state; + &goodbye; +} + +############## +sub update_state { + + my ($entry) = $_[0]; + + if ($entry eq "camera") { &camera_state ($entry); } + if ($entry eq "mkdetrend") { &detrend_state ($entry); } + if ($entry eq "mkfringe") { &detrend_state ($entry); } + if ($entry eq "ptolemy") { &ptolemy_state ($entry); } + if ($entry eq "standards") { &standards_state ($entry); } + if ($entry eq "validate") { &validate_state ($entry); } +} + +############## +sub ptolemy_state { + + my ($entry) = "ptolemy"; + + $current = $state{$entry}; + if (! $current) { &escape ("error: ptolemy state not set?"); } + + $fifos = `gconfig FIFOS`; chop $fifos; + $ptlist = "$datdir/$runid/$runid.ptlist"; + $ptlog = "$datdir/$runid/$runid.log"; + + # if we can, run 'elixir complete' + if (($current eq "init") && ($state{"mkdetrend"} eq "done") && ($state{"mkfringe"} eq "done")) { + $state{$entry} = "running"; + &save_state; + + if (-e "$fifos/complete.pid") { + $state{$entry} = "fail"; + &save_state; + print STDERR "elixir (sex)complete already running? check pid file $fifos/complete.pid"; + &escape ("failed to start ptolemy"); + } + + if (! -d "$datdir/$runid") { mkdir ("$datdir/$runid", 0777); } + vsystem ("mk.ptlist -run $runid > $ptlist"); + vsystem ("elixir -D mode sexcomplete $ptlist >& $ptlog &"); + + # wait for up to 10 seconds for $fifos/complete.pid to exist + for ($Nwait = 0; ($Nwait < 30) && (! -e "$fifos/complete.pid"); $Nwait ++) { sleep 2; } + if (! -e "$fifos/complete.pid") { + $state{$entry} = "fail"; + &save_state; + &escape ("failed to start elixir (sex)complete"); + } + } + + # has 'elixir complete' finished? successfully? + if ($current eq "running") { + if (-e "$fifos/complete.end") { + $answer = `wc -l $fifos/complete.success`; + ($Nsuccess) = split (" ", $answer); + $answer = `wc -l $fifos/complete.failure`; + ($Nfailure) = split (" ", $answer); + $answer = `wc -l $ptlist`; + ($Ntotal) = split (" ", $answer); + + $state{$entry} = "fail"; + if ($Nsuccess > 0.8*$Ntotal) { + $state{$entry} = "done"; + } else { + print STDERR "too many failures: $Nsuccess of $Ntotal\n"; + } + if ($Nsuccess + $Nfailure > $Ntotal) { + print STDERR "output list is inconsistent\n"; + $state{$entry} = "fail"; + } + } + if ((! -e "$fifos/complete.end") && (! -e "$fifos/complete.pid")) { + print STDERR "elixir complete killed?\n"; + $state{$entry} = "fail"; + } + } +} + +############## +sub standards_state { + + my ($entry) = "standards"; + $current = $state{$entry}; + if (! $current) { &escape ("error: standards state not set?"); } + + # if elixir complete is done, add standards, run photometry routines + if (($current eq "init") && ($state{"ptolemy"} eq "done")) { + $state{$entry} = "running"; + &save_state; + + $refs = `gconfig REFSDIR`; chop $refs; + $stds = "$refs/landolt/new"; + + # insert standards in photometry database + foreach $filter (@filter) { + vsystem ("addrefs -replace -v $stds/Landolt92$filter.fix $filter\_L92"); + vsystem ("addrefs -replace -v $stds/Landolt92$filter.hq $filter\_L92_HQ"); + } + + # cd to $rundir so photreport plots land there? + chdir $rundir; + + # run elixir.photreport to generate plots (eg 02Ak03.B.time.png) and phot.reg files + vsystem ("elixir.photreport $runid $catdir"); + if ($?) { goto standards_fail; } + + # load lines from phot.reg files and execute: + @reglist = (); + foreach $filter (@filter) { + $regfile = "$runid.$filter.phot.reg"; + open (FILE, $regfile); + @list = ; + close (FILE); + @reglist = (@reglist, @list); + } + foreach $line (@reglist) { + vsystem ($line); + } + + # get date range for this run + $answer = `mkrun run $runid`; + ($tmp, $start, $stop) = split (" ", $answer); + if ($start eq "") { &escape ("error with date range: $line"); } + if ($stop eq "") { &escape ("error with date range: $line"); } + + # create transparency list, execute + vsystem ("mktrans $start $stop > $runid.trans.reg"); + open (FILE, "$runid.trans.reg"); + @list = ; + close (FILE); + foreach $line (@list) { + vsystem ($line); + } + + # create transparency report, execute + vsystem ("mktreport $start $stop > $runid.trans.txt"); + + $state{$entry} = "done"; + &save_state; + } + return; + + standards_fail: + $state{$entry} = "fail"; + return; +} + +############## +sub camera_state { + + # camera : 'pending' (date < start) + # camera : 'on' (date in range start - stop) + # camera : 'off' (date > stop) + + # transition on -> off : trigger message about mkdetrend + + # get date range for this run + $answer = `mkrun run $runid`; + ($tmp, $start, $stop) = split (" ", $answer); + if ($start eq "") { &escape ("error with date range: $line"); } + if ($stop eq "") { &escape ("error with date range: $line"); } + $mjd_start = &date_to_mjd ($start); + $mjd_stop = &date_to_mjd ($stop); + + # get current value of mjd + ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime (); + $year += 1900; + $mon += 1; + $mjd_now = &get_mjd ($year, $mon, $mday); + + # check appropriate state + $state = "on"; + if ($mjd_now < $mjd_start) { $state = "pending"; } + if ($mjd_now > $mjd_stop) { $state = "off"; } + + # if we are at end of run, check that mkdetrend has been started + if (($state{"camera"} eq "on") && ($state eq "off")) { + if ($state{"mkdetrend"} eq "init") { + ¬ify ("start mkdetrend"); + } + } + $state{"camera"} = $state; +} + +############## +sub notify { + print STDERR "$_[0]\n"; +} + +############## +sub validate_state { + + my ($entry) = "validate"; + $current = $state{$entry}; + if (! $current) { &escape ("error: validate state not set?"); } + + chdir $rundir; + + # if elixir complete is done, add standards, run photometry routines + if (($current eq "init") && ($state{"standards"} eq "done")) { + $state{$entry} = "running"; + &save_state; + + # find the first unused val file (run.val.N) + $ver = 1; + $outfile = "$rundir/$runid.val.$ver"; + while (-e $outfile) { + $ver ++; + $outfile = "$rundir/$runid.val.$ver"; + } + + # run first pass + vsystem ("validate $runid > $outfile"); + if ($?) { goto validate_fail; } + + # check output results + print STDERR "validate $runid -stats -infile $outfile\n"; + @result = `validate $runid -stats -infile $outfile`; + if ($?) { goto validate_fail; } + + system ("validate $runid -infile $outfile -update"); + + # order should be: run, valid, invalid, subvalid, dataerr + ($value, $Nvalid) = split (" ", $result[1]); + if ($value ne "valid") { goto validate_fail; } + ($value, $Ninvalid) = split (" ", $result[2]); + if ($value ne "invalid") { goto validate_fail; } + ($value, $Nsubvalid) = split (" ", $result[3]); + if ($value ne "subvalid") { goto validate_fail; } + ($value, $Ndataerr) = split (" ", $result[4]); + if ($value ne "dataerr") { goto validate_fail; } + + if ($invalid > 0) { goto validate_fail; } + if ($dataerr > 0) { goto validate_fail; } + + # if we pass validation, run validate -update: + + $state{$entry} = "done"; + } + + if ($current eq "fail") { + + # recheck the last validation file (run.val.N) + $outfile = ""; + $ver = 1; + $try = "$rundir/$runid.val.$ver"; + while (-e $try) { + $outfile = $try; + $ver ++; + $try = "$rundir/$runid.val.$ver"; + } + if ($outfile eq "") { goto validate_fail; } + + # check output results + print STDERR "validate $runid -stats -infile $outfile\n"; + @result = `validate $runid -stats -infile $outfile`; + if ($?) { goto validate_fail; } + + system ("validate $runid -infile $outfile -update"); + + # order should be: run, valid, invalid, subvalid, dataerr + $Nvalid = $Ninvalid = $Nsubvalid = $Ndataerr = -1; + foreach $line (@result) { + ($value, $Nvalue) = split (" ", $line); + if ($value eq "valid") { $Nvalid = $Nvalue; } + if ($value eq "invalid") { $Ninvalid = $Nvalue; } + if ($value eq "subvalid") { $Nsubvalid = $Nvalue; } + if ($value eq "dataerr") { $Ndataerr = $Nvalue; } + } + if ($Nvalid == -1) { goto validate_fail; } + if ($Nsubvalid == -1) { goto validate_fail; } + if (($Ninvalid == -1) || ($Ninvalid > 0)) { goto validate_fail; } + if (($Ndataerr == -1) || ($Ndataerr > 0)) { goto validate_fail; } + + # if we pass validation, run validate -update: + $state{$entry} = "done"; + } + return ; + + validate_fail: + $state{$entry} = "fail"; + return; +} + +############## +sub detrend_state { + + # force sequencing (mkdetrend -> mkfringe): + if (($entry eq "mkfringe") && ($state{"mkdetrend"} ne "done")) { + $state{$entry} = "init"; + return; + } + + # mkdetrend & mkfringe determine run from their own references, + # which can be overridden with the '-run RUNID' flag + + # determine state from mkdetrend / mkfringe response + $entry = $_[0]; + print STDERR "$entry state\n"; + @list = `$entry state`; + print STDERR "@list\n"; + + # skip first 4 lines + shift @list; shift @list; shift @list; shift @list; shift @list; + + $Ninit = $Nfail = $Ndone = $Nrun = $Nmiss = 0; + foreach $line (@list) { + # interesting values for state: + # init, not.available, running.xxx, done, fail.xxx + @words = split (" ", $line); + if ($words[7] eq "not.available") { $Nmiss ++; } + if ($words[7] eq "init") { $Ninit ++; } + if ($words[7] eq "done") { $Ndone ++; } + if ($words[7] eq "clean") { $Ndone ++; } + if ($words[7] =~ /^fail./) { $Nfail ++; } + if ($words[7] =~ /^running./) { $Nrun ++; } + } + + $state = "running"; + if ($Ninit > 0) { $state = "init"; } + if ($Nfail > 0) { $state = "fail"; } + if ($Nrun > 0) { $state = "running"; } + if ($Ndone + $Nmiss == @list) { $state = "done"; } + + # check for mkdetrend transition -> "done" + if (($entry eq "mkdetrend") && ($state{$entry} ne "done") && ($state eq "done")) { + ¬ify ("start mkfringe"); + } + + $state{$entry} = $state; +} + +####################################### + +sub vsystem { + print STDERR "@_\n"; + my($status) = system ("@_"); + $status; +} + +sub goodbye { + unlink $tmpenv; + if ($_[0]) { + print STDERR "@_\n"; + } + exit 0; +} + +sub escape { + unlink $tmpenv; + print "$_[0]\n"; + exit 1; +} + +sub elixir_config { + my (@arg) = @_; + my ($opt, $config, @tmparg, $status); + $config = ""; + if ($ENV{'PTOLEMY'}) { $config = "-c $ENV{'PTOLEMY'}"; } + + # default values, override on command line + $runid = `gconfig RUNID.POSTRUN`; chop $runid; + $camera = `gconfig CAMERA.POSTRUN`; chop $camera; + + # extract command line options + @tmparg = (); + while (@arg > 0) { + + # grab elixir/ptolemy config option -c + if ($arg[0] eq "-c") { + shift @arg; + $config = "-c $arg[0]"; + shift @arg; + next; + } + + # grab elixir/ptolemy config option -C + if ($arg[0] eq "-C") { + @opt = (@opt, $arg[0]); + shift @arg; + @opt = (@opt, $arg[0]); + $elconf = $arg[0]; + shift @arg; + next; + } + + # grab elixir/ptolemy config option -D + if ($arg[0] eq "-D") { + @opt = (@opt, $arg[0]); + shift @arg; + @opt = (@opt, $arg[0]); + shift @arg; + @opt = (@opt, $arg[0]); + shift @arg; + next; + } + + # by default, $run is loaded from state.data file + if ($arg[0] eq "-run") { + shift @arg; + $runid = $arg[0]; + shift @arg; + next; + } + + # by default, $camera is loaded from state.data file + if ($arg[0] eq "-camera") { + shift @arg; + $camera = $arg[0]; + shift @arg; + next; + } + @tmparg = (@tmparg, $arg[0]); + shift @arg; + } + + # create temporary ptolemy.rc file: + $catdir = `gconfig DB_STDS -D RUNID $runid -D CAMERA $camera`; chop $catdir; + @opt = (@opt, "-D CATDIR $catdir"); + @opt = (@opt, "-D RUNID $runid"); + @opt = (@opt, "-D CAMERA $camera"); + @opt = (@opt, "-D RUNID.MKDETREND $runid"); + @opt = (@opt, "-D CAMERA.MKDETREND $camera"); + @opt = (@opt, "-D RUNID.MKFRINGE $runid"); + @opt = (@opt, "-D CAMERA.MKFRINGE $camera"); + + $config = join (" ", $config, @opt); + $tmpenv = `mktemp /tmp/elixir.XXXXXX`; chop ($tmpenv); + $status = system ("gconfig -raw $config > $tmpenv"); + if ($status) { &escape ("error in elixir configuration: gconfig fails"); } + + $ENV{'PTOLEMY'} = "$tmpenv"; + + # global variables + # add this from the filter configuration system, eventually + @filter = ("B", "V", "R", "I"); + + @def_state = ("camera", "off", + "mkdetrend", "init", + "mkfringe", "init", + "ptolemy", "init", + "standards", "init", + "validate", "init"); + %def_state = @def_state; + + # generate list of keys + @entry = (); + foreach $name (@def_state) { + push @entry, $name; + shift @def_state; + } + + # global configuration variables + $datdir = `gconfig DATDIR`; chop $datdir; + $rundir = "$datdir/$runid"; + $dbfile = "$rundir/postrun.db"; + + if (! -d $rundir) { mkdir ($rundir, 0777); } + + return (@tmparg); +} + +sub set_globals { +} + +sub date_to_mjd { + my ($date) = $_[0]; + my ($year, $month, $day, $mjd); + + ($year, $month, $day) = $date =~ /(\d+)\/(\d+)\/(\d+)/; + $mjd = get_mjd ($year, $month, $day); + + return ($mjd); +} + +sub get_mjd { + + my($year) = $_[0]; + my($month) = $_[1]; + my($day) = $_[2]; + + my($jd) = $day - 32075 + int (1461*($year + 4800 + int (($month - 14)/12))/4) + + int(367*($month - 2 - int(($month - 14)/12)*12)/12) + - int(3*int(($year + 4900 + int(($month - 14)/12))/100)/4) - 0.5 - 2400000.5; + + + return ($jd); + +} + +sub usage { + + print STDERR "elixir.postrun (mode)\n"; + print STDERR " state - show current states\n"; + print STDERR " update - update system states\n"; + print STDERR " set (entry) (value) - manually set a state\n"; + &goodbye; +} + + Index: /trunk/Ohana/src/perl/src/elixir.reload =================================================================== --- /trunk/Ohana/src/perl/src/elixir.reload (revision 17) +++ /trunk/Ohana/src/perl/src/elixir.reload (revision 17) @@ -0,0 +1,57 @@ +#!/usr/bin/env perl + +if (@ARGV != 1) { die "USAGE: elixir.reload (elixir)\n"; } + +$elixir = $ARGV[0]; + +# if an elixir is not running, start it, send output to $logdir/$elixir.log +$logdir = `gconfig LOGDIR`; chop $logdir; +if ($?) { die "error getting LOGDIR from configuration system\n"; } +chdir $logdir; + +$pidfile = `gconfig -D mode $elixir global.pid`; chop ($pidfile); +if ($?) { die "error getting PID from configuration system - is elixir $elixir defined?\n"; } + +# check that elixir is running +if (! -f $pidfile) { &launch ($elixir, $logdir); } + +# load pid information +open (FILE, "$pidfile"); +@list = ; +close (FILE); + +($name, $pid) = split (" ", $list[0]); +($name, $user) = split (" ", $list[1]); +($name, $machine) = split (" ", $list[2]); + +# check that this process exists? +@list = `rsh $machine /bin/ps -A -o pid,cmd`; +$dead = 1; +foreach $line (@list) { + ($rpid, $cmd) = split (" ", $line); + if (($rpid == $pid) && ($cmd =~ /elixir/)) { + $dead = 0; + print STDERR "elixir $elixir is running as $pid on $machine\n"; + last; + } +} +if ($dead) { + unlink ($pidfile); + &launch ($elixir, $logdir); +} + +# send USR1 signal to process: +print STDERR "restarting process $pid\n"; +system ("rsh $machine kill -USR1 $pid"); +exit 0; + +sub launch { + + my ($elixir) = $_[0]; + my ($logdir) = $_[1]; + + # if elixir is not running, start it + print STDERR "starting elixir $elixir\n"; + system ("elixir -D mode $elixir >& $logdir/$elixir.log &"); + exit 0; +} Index: /trunk/Ohana/src/perl/src/fixscat =================================================================== --- /trunk/Ohana/src/perl/src/fixscat (revision 17) +++ /trunk/Ohana/src/perl/src/fixscat (revision 17) @@ -0,0 +1,75 @@ +#!/usr/bin/env perl + +# warning: this function currently uses a fixed temporary name 'fix.NN.fits' +# for the intermediate product. If we add this to elixir, convert to mktemp + +# check the usage +if ($ARGV[0] eq "-h") { &usage (); } +if ($ARGV[0] eq "-help") { &usage (); } +if (@ARGV != 3) { &usage (); } + +# assign the command line arguments +$inlist = $ARGV[0]; +$version = $ARGV[1]; +$ID = $ARGV[2]; + +# find the appropriate script file +$confdir = `gconfig -q CONFDIR`; chop ($confdir); +$script = "$confdir/mana/scatter.pro"; + +# run mana script: +open (MANA, "|mana --norc"); +print MANA "input $script\n"; +print MANA "applyscat $inlist $version $ID\n"; +print MANA "exit 1\n"; +close (MANA); +print STDERR "exit statue: $?\n"; +if ($? == 2 * 256) { + print STDERR "no scattered light term available\n"; + exit 2; +} +if ($?) { die "ERROR problem with fixscat\n"; } + +print STDOUT "SUCCESS: finished with fixscat\n"; +exit 0; + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +sub usage { + print "USAGE: fixscat (inlist) (version) (ID)\n"; + exit 1; +} + +# mana within perl: we embed the mana functions within a macro to trap the +# exit status. If mana has an error with one of the steps, it will exit the macros and +# the second exit will be called. Otherwise, the "go" macro will perform the exit 0 +# and mana will exit with status 0 + +# there are two possible flat-field photometric corrections: additive +# and multiplicative: +# The correction images constructed by examining +# the *difference* between dome-flats with and without the petals +# covered is additive: FLAT_new = (FLAT_old - SCAT) * A +# (A is set to maintain the original normalization of chip 04) +# +# The correction images constructed by examining stellar magnitude +# difference is multiplicative: FLAT_new = (FLAT_old * SCAT) * A +# (A is set to maintain the original normalization of chip 04) + +# there is a different scattered light image for each filter. +# (these images are the same file for the additive version) + +# there should be no arbitrary normalization in the scattered frames +# in the database. (we used to multiply the scattered light image by a +# value of 10.0). + +# images of the first class will be identified with the label scatter-A.0 +# images of the second class will be identified with the label scatter-B.0 Index: /trunk/Ohana/src/perl/src/flatten.mana =================================================================== --- /trunk/Ohana/src/perl/src/flatten.mana (revision 17) +++ /trunk/Ohana/src/perl/src/flatten.mana (revision 17) @@ -0,0 +1,269 @@ +#!/usr/bin/env perl + +# grab the command line options +$use_fringe = 0; +$use_mask = 1; +$fast = 0; +$quiet = 0; +$close = ""; +@tARGV = (); +for (; @ARGV > 0; ) { + if ($ARGV[0] eq "-fast") { + $fast = 1; + shift; next; + } + if ($ARGV[0] eq "-quiet") { + $quiet = 1; + shift; next; + } + if ($ARGV[0] eq "-close") { + $close = "-close"; + shift; next; + } + if ($ARGV[0] eq "-defringe") { + $use_fringe = 1; + shift; next; + } + if ($ARGV[0] eq "-nomask") { + $use_mask = 0; + shift; next; + } + @tARGV = (@tARGV, $ARGV[0]); + shift; +} +@ARGV = @tARGV; + +if (@ARGV != 4) { &usage; } + +# command line arguments +$input = $ARGV[0]; +$output = $ARGV[1]; +$ccd = $ARGV[2]; +$mode = uppercase ($ARGV[3]); + +ckpathname ($output); + +if ($fast) { &fast; } else { &complete; } +exit 1; + +sub complete { + # find the appropriate flat-field image + $flat=`detsearch -quiet -image $input $ccd $mode -type flat $close`; chop ($flat); + if ($?) { + print STDERR "ERROR: can't get flat for image\n"; + exit 1; + } + # find the appropriate bias image + $bias=`detsearch -quiet -image $input $ccd $mode -type bias $close`; chop ($bias); + if ($?) { + print STDERR "ERROR: can't get bias for image\n"; + exit 1; + } + # find the appropriate dark image + $dark=`detsearch -quiet -image $input $ccd $mode -type dark $close`; chop ($dark); + if ($?) { + print STDERR "ERROR: can't get dark for image\n"; + exit 1; + } + + # find the appropriate mask image + $mask = "none"; + if ($use_mask) { + $mask=`detsearch -quiet -image $input $ccd $mode -type mask $close`; chop ($mask); + if ($?) { + print STDERR "ERROR: can't get mask for image\n"; + exit 1; + } + } + + # abstracted keywords + $ccdkeyword = `gconfig -q CCDNUM-KEYWORD`; chop ($ccdkeyword); + $darkword = `gconfig -q DARKTIME-FUNCTION`; chop ($darkword); + + # find the appropriate fringe frame & coords file + $fringe = "none"; + $coordfile = "none"; + if ($use_fringe) { + $exptimeword = `gconfig -q EXPTIME-KEYWORD`; chop ($exptimeword); + $filterword = `gconfig -q FILTER-KEYWORD`; chop ($filterword); + $cameraword = `gconfig -q CAMERA-KEYWORD`; chop ($cameraword); + $coordpath = `gconfig -q FRINGE_COORD_PATH`; chop ($coordpath); + + $ccdnum = `cameraconfig -N $ccd`; + + # check the FILTER and EXPTIME, include fringe correction?: + $answer = `echo $input | fields $exptimeword $filterword $cameraword`; + ($junk, $exptime, $filter, $camera) = split (" ", $answer); + # i need to do a look-up on the valid filter filternames (filtname) + $filter = uppercase ($filter); + + $use_fringe = 0; + # abstract this a bit: recipe gives guidance + # set defringe based on filter & exptime + if (($filter eq "I") && ($exptime > 60)) { $use_fringe = 1; } + if (($filter eq "Z") && ($exptime > 60)) { $use_fringe = 1; } + if (($filter eq "NB920") && ($exptime > 60)) { $use_fringe = 1; } + + if ($use_fringe) { + $fringe = `detsearch -quiet -image $input $ccd $mode -type fringe $close`; chop ($fringe); + if ($?) { + print STDERR "ERROR: can't get fringe for image\n"; + exit 1; + } + $coordfile = sprintf "%s/%s-%s-CCD%02d-FringeCoord.reg", $coordpath, $camera, $filter, $ccd; + } + } + + # determine scale factor for dark image + $answer = `echo $input | fields $exptimeword`; + ($name, $t1) = split (" ", $answer); + $answer = `echo $dark | fields $exptimeword`; + ($name, $t2) = split (" ", $answer); + $darkfactor = `darktime.$darkword $t1 $t2`; chop ($darkfactor); + + # find the appropriate script file + $confdir = `gconfig -q CONFDIR`; chop ($confdir); + $script = "$confdir/mana/flatten.pro"; + + # run mana, call script + open (MANA, "|mana --norc"); + print MANA "input $script\n"; + print MANA "\$CCDKEYWORD = $ccdkeyword\n"; + print MANA "\$bias = $bias\n"; + print MANA "\$dark = $dark\n"; + print MANA "\$flat = $flat\n"; + print MANA "\$mask = $mask\n"; + print MANA "\$fringe = $fringe\n"; + print MANA "\$use:mask = $use_mask\n"; + print MANA "\$use:fringe = $use_fringe\n"; + print MANA "\$darkfactor = $darkfactor\n"; + print MANA "\$coordfile = $coordfile\n"; + print MANA "flatten.complete $input $output $ccd $mode\n"; + print MANA "exit 1\n"; + close (MANA); + if ($?) { + print STDERR "ERROR problem with imstats\n"; + exit 1; + } + print STDOUT "SUCCESS: finished with imstats\n"; + exit 0; +} + +sub fast { + # find the appropriate flat-field image + $flat=`detsearch -quiet -image $input $ccd $mode -type flat -close`; chop ($flat); + if ($?) { + print STDERR "ERROR: can't get flat for image\n"; + exit 1; + } + + # find the appropriate mask image + $mask = "none"; + if ($use_mask) { + $mask=`detsearch -quiet -image $input $ccd $mode -type mask -close`; chop ($mask); + if ($?) { + print STDERR "ERROR: can't get mask for image\n"; + exit 1; + } + } + + # abstracted keywords + $ccdkeyword = `gconfig -q CCDNUM-KEYWORD`; chop ($ccdkeyword); + + # find the appropriate fringe frame & coords file + $fringe = "none"; + $coordfile = "none"; + if ($use_fringe) { + $exptimeword = `gconfig -q EXPTIME-KEYWORD`; chop ($exptimeword); + $filterword = `gconfig -q FILTER-KEYWORD`; chop ($filterword); + $cameraword = `gconfig -q CAMERA-KEYWORD`; chop ($cameraword); + $coordpath = `gconfig -q FRINGE_COORD_PATH`; chop ($coordpath); + + $ccdnum = `cameraconfig -N $ccd`; + + # check the FILTER and EXPTIME, include fringe correction?: + $answer = `echo $input | fields $exptimeword $filterword $cameraword`; + ($junk, $exptime, $filter, $camera) = split (" ", $answer); + # i need to do a look-up on the valid filter filternames (filtname) + $filter = uppercase ($filter); + + $use_fringe = 0; + # set defringe based on filter & exptime + if (($filter eq "I") && ($exptime > 60)) { $use_fringe = 1; } + if (($filter eq "Z") && ($exptime > 60)) { $use_fringe = 1; } + if (($filter eq "NB920") && ($exptime > 60)) { $use_fringe = 1; } + + if ($use_fringe) { + $fringe = `detsearch -quiet -image $input $ccd $mode -type fringe -close`; chop ($fringe); + if ($?) { + print STDERR "ERROR: can't get fringe for image\n"; + exit 1; + } + $coordfile = sprintf "%s/%s-%s-CCD%02d-FringeCoord.reg", $coordpath, $camera, $filter, $ccd; + } + } + + # find the appropriate script file + $confdir = `gconfig -q CONFDIR`; chop ($confdir); + $script = "$confdir/mana/flatten.pro"; + + # run mana, call script + open (MANA, "|mana --norc"); + print MANA "input $script\n"; + print MANA "\$CCDKEYWORD = $ccdkeyword\n"; + print MANA "\$flat = $flat\n"; + print MANA "\$mask = $mask\n"; + print MANA "\$fringe = $fringe\n"; + print MANA "\$use:mask = $use_mask\n"; + print MANA "\$use:fringe = $use_fringe\n"; + print MANA "\$coordfile = $coordfile\n"; + print MANA "flatten.fast $input $output $ccd $mode\n"; + print MANA "exit 1\n"; + close (MANA); + if ($?) { + print STDERR "ERROR problem with imstats\n"; + exit 1; + } + print STDOUT "SUCCESS: finished with imstats\n"; + exit 0; +} + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +sub usage { + print STDERR "USAGE: flatten.mana (input) (output) CCD MODE [-fast] [-close] [-quiet]\n"; + exit 2; +} + +sub uppercase { + return "\U$_[0]\E"; +} + +# given a filename, check that its path exists, create it if not +sub ckpathname { + my ($file) = $_[0]; + my (@words, $dir); + + @words = split ("/", $file); + pop (@words); + $dir = join ("/", @words); + + if ($dir eq "") { $dir = "."; } + + if (! -d $dir) { + system ("mkdir -p $dir"); + if ($?) { + print STDERR "ERROR: can't make directory component for $file\n"; + exit 1; + } + } +} + Index: /trunk/Ohana/src/perl/src/fr.ckfile =================================================================== --- /trunk/Ohana/src/perl/src/fr.ckfile (revision 17) +++ /trunk/Ohana/src/perl/src/fr.ckfile (revision 17) @@ -0,0 +1,30 @@ +#!/usr/bin/env perl + +# check the usage +if ($ARGV[0] eq "-h") { &usage (); } +if ($ARGV[0] eq "-help") { &usage (); } +if (@ARGV != 1) { &usage (); } + +# assign the command line arguments +$list = $ARGV[0]; + +# check for files to be processed +open (FILE, "$list"); +@list = ; +close (FILE); + +foreach $file (@list) { + chop ($file); + if (-e $file) { next; } + print STDERR "ERROR: missing file $file\n"; + exit 1; +} + +print STDOUT "SUCCESS: found all files from $list\n"; +exit 0; + +sub usage { + print "USAGE: fr.ckfile (list)\n"; + print " checks for the existence of each file in the list\n"; + exit 1; +} Index: /trunk/Ohana/src/perl/src/fr.detrend =================================================================== --- /trunk/Ohana/src/perl/src/fr.detrend (revision 17) +++ /trunk/Ohana/src/perl/src/fr.detrend (revision 17) @@ -0,0 +1,77 @@ +#!/usr/bin/env perl +# calls flatten.flips, but no direct flips functions + +# check the usage +if ($ARGV[0] eq "-h") { usage (); } +if ($ARGV[0] eq "-help") { usage (); } +if (@ARGV != 4) { die "USAGE: fr.detrend (path) (root) (mode) (outlist)\n" } + +# assign the command line arguments +$path = $ARGV[0]; +$root = $ARGV[1]; +$mode = "\U$ARGV[2]\E"; +if (($mode ne "MEF") && ($mode ne "SPLIT")) { die "ERROR: mode must be either -split or -mef\n";} + +# load output list (must be created in ccd order) +$outlist = $ARGV[3]; +open (FILE, "$outlist"); +@outlist = ; +close (FILE); +foreach $line (@outlist) { chop ($line); } + +# double checks: should be Nccd +$Nccd = `cameraconfig -Nccd`; chop ($Nccd); +if ($Nccd != @outlist) { die "ERROR: mis-matched number of images\n"; } +$answer = `cameraconfig -ccds`; +@ccds = split (" ", $answer); + +# run flatten.flips for each input and output image: +for ($ccd = 0; $ccd < $Nccd; $ccd++) { + + $infile = mk_filename ($path, $root, $mode, $ccds[$ccd]); + $outfile = $outlist[$ccd]; + + $status = vsystem ("flatten.flips -quiet $infile $outfile $ccds[$ccd] $mode"); + if ($status) { die "ERROR: problem running flatten on $infile\n"; } +} +print STDOUT "SUCCESS: finished with fr.detrend\n"; +exit 0; + +## utilities + +sub mk_filename { + my ($path) = $_[0]; + my ($root) = $_[1]; + my ($mode) = $_[2]; + my ($ccd) = $_[3]; + + if ($mode eq "MEF") { + $name = sprintf "%s/%s.fits", $path, $root; + return $name; + } + if ($mode eq "SPLIT") { + $name = sprintf "%s/%s/%s%s.fits", $path, $root, $root, $ccd; + return $name; + } + return ""; +} + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +sub usage { + print "\n"; + print "USAGE: fr.detrend (path) (root) (mode) (outlist)\n"; + print " path: path to MEF image or SPLIT dir\n"; + print " root: root name of image (MEF = root.fits, SPLIT = root/rootNN.fits)\n"; + print " mode: MEF or SPLIT\n"; + print " outlist: list of output files\n"; + exit 1; +} Index: /trunk/Ohana/src/perl/src/fr.frstats =================================================================== --- /trunk/Ohana/src/perl/src/fr.frstats (revision 17) +++ /trunk/Ohana/src/perl/src/fr.frstats (revision 17) @@ -0,0 +1,152 @@ +#!/usr/bin/env perl + +if (@ARGV < 1) { &escape ("USAGE: fr.frstats -mode [args]"); } +if ($ARGV[0] eq "help") { &usage; } + +# find the appropriate script file +$confdir = `gconfig -q CONFDIR`; chop ($confdir); +$script = "$confdir/mana/fringe.pro"; + +# test named Xserver, or start vnc on specified machine +$xhost=`gconfig -q XHOST`; chop ($xhost); +$xdisp=`gconfig -q XDISP`; chop ($xdisp); +if (vsystem ("xdpyinfo -display $xdisp > /dev/null")) { + print STDERR "X server is not running. start it now on $xhost\n"; + exit 1; +} +$ENV{'DISPLAY'} = $xdisp; + +# determine fit parameters for list of raw fringe measurements +if ($ARGV[0] eq "-fitpars") { + + $list = $ARGV[1]; + $pars = $ARGV[2]; + + # run mana script: + open (MANA, "|mana --norc"); + print MANA "input $script\n"; + print MANA "getfitpars $list $pars\n"; + print MANA "exit 1\n"; + close (MANA); + if ($?) { &escape ("problem with fr.frstats -fitpars"); } + + &goodbye; +} + +# determine fit parameters for list of raw fringe measurements +if ($ARGV[0] eq "-plotstats") { + + $list = $ARGV[1]; + $pars = $ARGV[2]; + $output = $ARGV[3]; + + # run mana script: + open (MANA, "|mana --norc"); + print MANA "input $script\n"; + print MANA "showfits $list $pars $output\n"; + print MANA "exit 1\n"; + close (MANA); + if ($?) { &escape ("problem with fr.frstats -fitpars"); } + + &goodbye; +} + +# create frstats file for list of raw fringe measurements using measure fringe parameters +if ($ARGV[0] eq "-frstats") { + + $list = $ARGV[1]; + $pars = $ARGV[2]; + $frstats = $ARGV[3]; + + # check if none of list exist, then skip + # otherwise, report error + + open (FILE, "$list"); + @list = ; + close (FILE); + + $Nfound = 0; + foreach $line (@list) { + chop $line; + if (-e $line) { $Nfound ++; } + } + if ($Nfound == 0) { + print STDERR "NOTE: no files from $list: assuming initial state\n"; + &goodbye; + } + if ($Nfound != @list) { &escape ("missing some files from $list"); } + + # run mana script: + open (MANA, "|mana --norc"); + print MANA "input $script\n"; + print MANA "getfrstats $pars $list $frstats\n"; + print MANA "exit 1\n"; + close (MANA); + if ($?) { &escape ("problem with fr.frstats -frstats"); } + + &goodbye; +} + +# create dfstats file for list of fringe residual measurements +if ($ARGV[0] eq "-dfstats") { + + $list = $ARGV[1]; + $pars = $ARGV[2]; + $frstats = $ARGV[3]; + + # check if none of list exist, then skip + # otherwise, report error + + open (FILE, "$list"); + @list = ; + close (FILE); + + $Nfound = 0; + foreach $line (@list) { + chop $line; + if (-e $line) { $Nfound ++; } + } + if ($Nfound == 0) { + print STDERR "NOTE: no files from $list: assuming initial state\n"; + &goodbye; + } + if ($Nfound != @list) { &escape ("missing some files from $list"); } + + # run mana script: + open (MANA, "|mana --norc"); + print MANA "input $script\n"; + print MANA "getdfstats $pars $list $frstats\n"; + print MANA "exit 1\n"; + close (MANA); + if ($?) { &escape ("problem with fr.frstats -frstats"); } + + &goodbye; +} + +&escape ("unknown fr.frstats command $ARGV[0]"); + +## utilities + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + print STDOUT "SUCCESS: finished with fr.stats\n"; + exit 0; +} + +sub escape { + print STDOUT "ERROR: $_[0]\n"; + exit 1; +} + +sub usage { + + print STDOUT "fr.mklists -fitpars CONFIG.med.sublist CONFIG.fitpars\n"; + print STDOUT "fr.frstats -frstats CONFIG.med.statlist CONFIG.fitpars CONFIG.med.imstats\n"; + + exit 2; +} Index: /trunk/Ohana/src/perl/src/fr.getfringe =================================================================== --- /trunk/Ohana/src/perl/src/fr.getfringe (revision 17) +++ /trunk/Ohana/src/perl/src/fr.getfringe (revision 17) @@ -0,0 +1,82 @@ +#!/usr/bin/env perl + +# check the usage +if ($ARGV[0] eq "-h") { usage (); } +if ($ARGV[0] eq "-help") { usage (); } +if (@ARGV != 3) { die "USAGE: fr.getfringe (inlist) (binning) (output)\n" } + +# define the path to include FLIPS: +$flipsconf=`gconfig -q FLIPSCONF`; chop ($flipsconf); +$flipspath=`gconfig -q FLIPSPATH`; chop ($flipspath); +$ENV{'PATH'} = "$ENV{'PATH'}:$flipspath"; +$ENV{'FLIPSDIR'} = $flipsconf; + +# assign the command line arguments +$inlist = $ARGV[0]; +$bin = $ARGV[1]; +$output = $ARGV[2]; + +# load input list: +open (FILE, "$inlist"); +@inlist = ; +close (FILE); +foreach $line (@inlist) { chop $line; } + +# gtfringe is appending to the output file: +unlink ($output); + +# we construct the Fringe Coord File from: FRINGE_COORD_PATH/CAMERA-FILTER-CCDNN-FringeCoord.reg +$fkey = `gconfig -q FILTER-KEYWORD`; chop ($fkey); +$ckey = `gconfig -q CAMERA-KEYWORD`; chop ($ckey); +$coordpath = `gconfig -q FRINGE_COORD_PATH`; chop ($coordpath); +$Nccd = `cameraconfig -Nccd`; chop ($Nccd); +$answer = `cameraconfig -ccds`; +@ccds = split (" ", $answer); + +# double check lists size: +if ($Nccd != @inlist) { die "ERROR: mis-matched image list sizes\n"; } + +# find filter and camera from image +$answer = `echo $inlist[0] | fields $fkey $ckey`; +($name, $filtvalue, $camera) = split (" ", $answer); +$filter = `filtnames $filtvalue`; chop $filter; +if ($?) { die "can't find filter for $filtvalue\n"; } +print STDERR "camera: $camera\n"; +if ($camera eq "") { $camera = "WFI"; } +#### a temporary hack to for this to work... + +for ($ccd = 0; $ccd < $Nccd; $ccd++) { + + $infile = $inlist[$ccd]; + $coordfile = sprintf "%s/%s-%s-CCD%s-FringeCoord.reg", $coordpath, $camera, $filter, $ccds[$ccd]; + + # each call to gtfringe adds a line to $output + vsystem ("getfringe $infile $coordfile $bin $output"); + if ($?) { + print STDERR "ERROR running getfringe\n"; + exit 1; + } +} + +print STDOUT "SUCCESS: finished with fr.getfringe\n"; +exit 0; + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +sub usage { + print "\n"; + print "USAGE: fr.getfringe (inlist) (binning) (output)\n"; + print " calculate fringe pattern strengths for images in (inlist)\n"; + print " inlist : list of input CCDs in CCD order\n"; + print " binning : binning factor of images\n"; + print " outdir : output file\n"; + exit 1; +} Index: /trunk/Ohana/src/perl/src/fr.imdata =================================================================== --- /trunk/Ohana/src/perl/src/fr.imdata (revision 17) +++ /trunk/Ohana/src/perl/src/fr.imdata (revision 17) @@ -0,0 +1,60 @@ +#!/usr/bin/env perl + +# check the usage +if ($ARGV[0] eq "-h") { &usage (); } +if ($ARGV[0] eq "-help") { &usage (); } +if (@ARGV != 2) { &usage (); } + +# assign the command line arguments +$list = $ARGV[0]; +$imdata = $ARGV[1]; + +# load input list: +open (FILE, "$list"); +@list = ; +close (FILE); +foreach $line (@list) {chop $line;} + +# check for file +if (! -e $list[0]) { die "ERROR: image file $list[0] is missing\n"; } + +print STDOUT "$list[0]\n"; + +# abstract header keywords +$datekwd = `gconfig -q DATE-KEYWORD`; chop ($datekwd); +$timekwd = `gconfig -q UT-KEYWORD`; chop ($timekwd); +$obsidkwd = `gconfig -q ID-KEYWORD`; chop ($obsidkwd); +$exptimekwd = `gconfig -q EXPTIME-KEYWORD`; chop ($exptimekwd); + +$answer = `echo $list[0] | fields $datekwd $timekwd $obsidkwd $exptimekwd`; +# need to eventually fix return value of 'fields' +# if ($?) { die "ERROR problem with fr.imdata\n"; } + +# grab interesting data +($file, $date, $utc, $obsid, $exptime) = split (" ", $answer); +if ($exptime eq "") { die "ERROR problem with fr.imdata\n"; } + +open (FILE, ">$imdata"); +print FILE "$obsid $date $utc $exptime\n"; +close (FILE); + +print STDOUT "SUCCESS: finished with fr.stats\n"; +exit 0; + +## utilities + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +sub usage { + print "USAGE: fr.imdata (list) (imdata)\n"; + print " extract basic image data from header for later reference\n"; + exit 1; +} Index: /trunk/Ohana/src/perl/src/fr.jpegs =================================================================== --- /trunk/Ohana/src/perl/src/fr.jpegs (revision 17) +++ /trunk/Ohana/src/perl/src/fr.jpegs (revision 17) @@ -0,0 +1,65 @@ +#!/usr/bin/env perl + +# check the usage +if ($ARGV[0] eq "-h") { &usage (); } +if ($ARGV[0] eq "-help") { &usage (); } +if (@ARGV != 4) { &usage (); } + +# assign the command line arguments +$list = $ARGV[0]; +$tenbin = $ARGV[1]; +$medbin = $ARGV[2]; +$range = $ARGV[3]; + +# check for files to be processed +@status = stat ($list); +if ($status[7] == 0) { + print STDERR "no files in source list, skipping\n"; + exit 1; +} + +# find the appropriate script file +$confdir = `gconfig -q CONFDIR`; chop ($confdir); +$script = "$confdir/mana/fringe.pro"; + +# test named Xserver, or start vnc on specified machine +$xhost=`gconfig -q XHOST`; chop ($xhost); +$xdisp=`gconfig -q XDISP`; chop ($xdisp); +if (vsystem ("xdpyinfo -display $xdisp")) { + print STDERR "X server is not running. start it now on $xhost\n"; + exit 1; +} +$ENV{'DISPLAY'} = $xdisp; + +# run mana script: +open (MANA, "|mana --norc"); +print MANA "input $script\n"; +print MANA "\$RANGE = $range\n"; +print MANA "mkjpegs $list $tenbin $medbin $stats\n"; +print MANA "exit 1\n"; +close (MANA); +if ($?) { die "ERROR problem with fr.jpegs\n"; } + +print STDOUT "SUCCESS: finished with fr.jpegs\n"; +exit 0; + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +sub usage { + print "USAGE: fr.jpegs (list) (tenbin) (medbin) (range)\n"; + print " create big and small jpeg images from the input list\n"; + exit 1; +} + +# mana within perl: we embed the mana functions within a macro to trap the +# exit status. If mana has an error with one of the steps, it will exit the macros and +# the second exit will be called. Otherwise, the "go" macro will perform the exit 0 +# and mana will exit with status 0 Index: /trunk/Ohana/src/perl/src/fr.medbin.spline =================================================================== --- /trunk/Ohana/src/perl/src/fr.medbin.spline (revision 17) +++ /trunk/Ohana/src/perl/src/fr.medbin.spline (revision 17) @@ -0,0 +1,94 @@ +#!/usr/bin/env perl + +# check the usage +if ($ARGV[0] eq "-h") { usage (); } +if ($ARGV[0] eq "-help") { usage (); } +if (@ARGV != 5) { die "USAGE: fr.medbin (path) (root) (factor) (meddir) (mapdir)\n" } + +# assign the command line arguments +$path = $ARGV[0]; +$root = $ARGV[1]; +$factor = $ARGV[2]; +$meddir = $ARGV[3]; +$mapdir = $ARGV[4]; + +$Nccd = `cameraconfig -Nccd`; chop ($Nccd); +$answer = `cameraconfig -ccds`; +@ccds = split (" ", $answer); + +if (! -d $meddir) { vsystem ("mkdir -p $meddir"); } +if (! -d $mapdir) { vsystem ("mkdir -p $mapdir"); } + +open (MANA, "|mana --norc"); +# open (MANA, ">test.pro"); + +print MANA "macro mkmap\n"; +# load detrended image +print MANA " rd a \$1\n"; +print MANA " keyword a NAXIS1 nx\n"; +print MANA " keyword a NAXIS2 ny\n"; +print MANA " medianmap a b {\$nx/$factor} {\$ny/$factor} -range 0.25 0.75\n"; + +# create 8x16 sky spline map +print MANA " keyword b NAXIS1 nx\n"; +print MANA " keyword b NAXIS2 ny\n"; +print MANA " stats -q b - - - -\n"; + +# sky from first ccd saved for reference +print MANA " if (\$setsky)\n"; +print MANA " \$sky = \$MEDIAN\n"; +print MANA " \$setsky = 0\n"; +print MANA " end\n"; + +# we use the sky value of the first chip to make the image globally flat +print MANA " medianmap b m 8 16 -ignore 0.0 -range 0.25 0.75\n"; +print MANA " set m = m - \$sky\n"; +print MANA " spline.construct m M x\n"; +print MANA " spline.apply m M sky x \$nx \$ny\n"; + +# multiplying by (abs(b) > 0.001) maintains the mask +print MANA " set c = (b - sky) * (abs(b) > 0.001)\n"; +print MANA " wd c \$2\n"; +print MANA " wd m \$3 -bitpix -32 -bzero 0.0 -bscale 1.0\n"; +print MANA "end\n"; + +print MANA "macro go\n"; +print MANA " \$setsky = 1\n"; +for ($ccd = 0; $ccd < $Nccd; $ccd++) { + $infile = sprintf "%s/%s%s.fits", $path, $root, $ccds[$ccd]; + $outmed = sprintf "%s/%s%s.fits", $meddir, $root, $ccds[$ccd]; + $outmap = sprintf "%s/%s%s.fits", $mapdir, $root, $ccds[$ccd]; + print MANA " mkmap $infile $outmed $outmap\n"; +} +print MANA " exit 0\n"; +print MANA "end\n"; +print MANA "go\n"; +print MANA "exit 1\n"; +close (MANA); +if ($?) { + print STDERR "ERROR running mana\n"; + exit 1; +} + +print STDOUT "SUCCESS: finished with fr.medbin.spline\n"; +exit 0; + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +sub usage { + print "\n"; + print "USAGE: fr.medbin.spline (path) (root) (factor) (outpath)\n"; + print " path: path to MEF image or SPLIT dir\n"; + print " root: root name of image (MEF = root.fits, SPLIT = root/rootNN.fits)\n"; + print " mode: MEF or SPLIT\n"; + print " outdir: directory for output results (all split)\n"; + exit 1; +} Index: /trunk/Ohana/src/perl/src/fr.mkhtml =================================================================== --- /trunk/Ohana/src/perl/src/fr.mkhtml (revision 17) +++ /trunk/Ohana/src/perl/src/fr.mkhtml (revision 17) @@ -0,0 +1,97 @@ +#!/usr/bin/env perl + +if (@ARGV < 1) { &escape ("USAGE: fr.mkhtml -mode [args]"); } +if ($ARGV[0] eq "help") { &usage; } + +# copy CONFIG.imstats to html dir +if ($ARGV[0] eq "-imstats") { + + $input = $ARGV[1]; + $outdir = $ARGV[2]; + + if (! -d $outdir) { + vsystem ("mkdir -p $outdir"); + if ($?) { &escape ("can't make directory component for output $outdir"); } + } + + vsystem ("cp $input $outdir"); + if ($?) { &escape ("problem copying $input to $outdir"); } + + &goodbye; +} + +# create frstats file for list of raw fringe measurements using measure fringe parameters +if ($ARGV[0] eq "-jpglist") { + + $list = $ARGV[1]; + $outdir = $ARGV[2]; + $root = $ARGV[3]; + $outlist = sprintf "%s/%s.list", $outdir, $root; + print STDERR "outlist: $outlist\n"; + + if (! -d $outdir) { + vsystem ("mkdir -p $outdir"); + if ($?) { &escape ("can't make directory component for output $outdir"); } + } + + open (FILE, "$list"); + @list = ; + close (FILE); + foreach $line (@list) { chop $line; } + + # list contains MOSAIC.med.medbin.jpg + # copy to html/CONFIG.med.medbin.NNN.jpg + + $Nfound = 0; + foreach $line (@list) { + if (-e $line) { $Nfound ++; } + } + if ($Nfound == 0) { + print STDERR "NOTE: no files from $list: assuming initial state\n"; + open (FILE, ">$outlist"); + close (FILE); + &goodbye; + } + if ($Nfound != @list) { &escape ("missing some files from $list"); } + + open (FILE, ">$outlist"); + for ($i = 0; $i < @list; $i++) { + + $inname = $list[$i]; + $outname = sprintf "%s/%s.%03d.jpg", $outdir, $root, $i; + vsystem ("cp -f $inname $outname"); + if ($?) { &escape ("problem copying $inname to $outname"); } + + print FILE "$outname\n"; + } + close (FILE); + &goodbye; +} + +&escape ("unknown fr.frstats command $ARGV[0]"); + +## utilities + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + print STDOUT "SUCCESS: finished with fr.stats\n"; + exit 0; +} + +sub escape { + print STDOUT "ERROR: $_[0]\n"; + exit 1; +} + +sub usage { + + print STDOUT "fr.mklists -fitpars CONFIG.med.sublist CONFIG.fitpars\n"; + print STDOUT "fr.frstats -frstats CONFIG.med.statlist CONFIG.fitpars CONFIG.med.imstats\n"; + + exit 2; +} Index: /trunk/Ohana/src/perl/src/fr.mklists =================================================================== --- /trunk/Ohana/src/perl/src/fr.mklists (revision 17) +++ /trunk/Ohana/src/perl/src/fr.mklists (revision 17) @@ -0,0 +1,520 @@ +#!/usr/bin/env perl + +if (@ARGV < 1) { + print STDERR "USAGE: fr.mklists -mode [args]\n"; + &escape; +} + +if ($ARGV[0] eq "help") { + + print STDERR "fr.mklists -initial CONFIG.split CONFIG.mef CONFIG.master\n"; + print STDERR "fr.mklists -detrend CONFIG.master CONFIG.detrend\n"; + print STDERR "fr.mklists -defringe CONFIG.master CONFIG.defringe\n"; + print STDERR "fr.mklists -imlist TEMPLATE CONFIG.statlist [Nccd?]\n"; + print STDERR "fr.mklists -mosaic CONFIG.master proc name\n"; + print STDERR "fr.mklists -master CONFIG.detrend CONFIG.master\n"; + print STDERR "fr.mklists -inlist CONFIG.master 00 proc CONF-CCD.inlist\n"; + print STDERR "fr.mklists -imstats CONFIG.master 00 proc CONF-CCD.imstats\n"; + print STDERR "fr.mklists -frstats CONFIG.master proc CONF-CCD.imstats\n"; + &escape; +} + +$answer = `cameraconfig $elixir -ccds`; +@ccds = split (" ", $answer); + +$STAT_XCLD = 0; +$STAT_KEEP = 1; +$STAT_XDET = 2; +$STAT_DETR = 3; + +# merge CONFIG.mef & CONFIG.split to CONFIG.master [starting status = 3] +if ($ARGV[0] eq "-initial") { + + if (@ARGV != 4) { + print STDERR "fr.mklists -initial CONFIG.split CONFIG.mef CONFIG.master\n"; + &escape; + } + + open (FILE, "$ARGV[1]"); + @list1 = ; + close (FILE); + + open (FILE, "$ARGV[2]"); + @list2 = ; + close (FILE); + + open (FILE, ">$ARGV[3]"); + foreach $line (@list1) { + chop $line; + print FILE "$line $STAT_DETR\n"; + } + foreach $line (@list2) { + chop $line; + print FILE "$line $STAT_DETR\n"; + } + close (FILE); + + if ((@list1 == 0) && (@list2 == 0)) { + print STDERR "no images available\n"; + &escape; + } + + &goodbye; +} + +# convert CONFIG.master to CONFIG.detrend (status == XDET || DETR, strip status) +if ($ARGV[0] eq "-detrend") { + + if (@ARGV != 3) { + print STDERR "fr.mklists -detrend CONFIG.master CONFIG.detrend\n"; + &escape; + } + + open (FILE, "$ARGV[1]"); + @list = ; + close (FILE); + + open (FILE, ">$ARGV[2]"); + foreach $line (@list) { + @words = split (" ", $line); + if (($words[3] == $STAT_XDET) || ($words[3] == $STAT_DETR)) { + print FILE "$words[0] $words[1] $words[2]\n"; + } + } + close (FILE); + &goodbye; +} + +# convert CONFIG.master to CONFIG.defringe, used to generate input list to mode.fringe3 +if ($ARGV[0] eq "-defringe") { + + if (@ARGV != 5) { + print STDERR "@ARGV\n"; + print STDERR "fr.mklists -detrend CONFIG.master CONFIG TMPPATH CONFIG.defringe\n"; + &escape; + } + + $infile = $ARGV[1]; + $confline = $ARGV[2]; + $tmppath = $ARGV[3]; + $outfile = $ARGV[4]; + + open (FILE, "$infile"); + @list = ; + close (FILE); + + open (FILE, ">$outfile"); + foreach $line (@list) { + ($path, $root, $mode, $status) = split (" ", $line); + print FILE "$tmppath/$root $confline\n"; + } + close (FILE); + &goodbye; +} + +# use TEMPLATE to create a list with NCCD entries replacing CCDNUM +if ($ARGV[0] eq "-imlist") { + + if (@ARGV != 3) { + print STDERR "fr.mklists -detrend TEMPLATE CONFIG.defringe\n"; + &escape; + } + + open (FILE, ">$ARGV[2]"); + for ($i = 0; $i < @ccds; $i++) { + $name = $ARGV[1]; + $name =~ s/CCDNUM/$ccds[$i]/; + print FILE "$name\n"; + } + close (FILE); + &goodbye; +} + +# use CONFIG.master to create Nimage lists, each called OUTDIR/root.WORDlist with +# NCCD entries OUTDIR/root.WORD/rootNN.fits +if ($ARGV[0] eq "-mosaic") { + + if (@ARGV != 4) { + print STDERR "fr.mklists -mosaic CONFIG.master OUTDIR WORD\n"; + &escape; + } + + $infile = $ARGV[1]; + $outpath = $ARGV[2]; + $word = $ARGV[3]; + + open (FILE, $infile); + @inlist = ; + close (FILE); + + foreach $name (@inlist) { + ($path, $root, $mode) = split (" ", $name); + + $outfile = sprintf "%s/%s.%slist", $outpath, $root, $word; + + open (FILE, ">$outfile"); + foreach $ccd (@ccds) { + printf FILE "$outpath/$root.$word/$root$ccd.fits\n"; + } + close (FILE); + } + &goodbye; +} + +# use CONFIG.master to create OUTPUT list with Nimage lines: OUTDIR/root.WORD +if ($ARGV[0] eq "-mlist") { + + if (@ARGV != 5) { &escape ("USAGE: fr.mklists -mlist CONFIG.master OUTDIR WORD OUTPUT"); } + + $infile = $ARGV[1]; + $outpath = $ARGV[2]; + $word = $ARGV[3]; + $outfile = $ARGV[4]; + + open (FILE, $infile); + @inlist = ; + close (FILE); + + open (FILE, ">$outfile"); + foreach $name (@inlist) { + ($path, $root, $mode) = split (" ", $name); + $file = sprintf "%s/%s.%s", $outpath, $root, $word; + printf FILE "$file\n"; + } + close (FILE); + + &goodbye; +} + +# merge data from master, med.imstats, def.imstats, datlist into a single file for the html scripts +if ($ARGV[0] eq "-imstats") { + + if (@ARGV != 6) { + print STDERR "fr.mklists -imstats CONFIG.master CONFIG.med.imstats CONFIG.def.imstats CONFIG.datlist CONFIG.imstats\n"; + &escape; + } + + $master = $ARGV[1]; + $medstat = $ARGV[2]; + $defstat = $ARGV[3]; + $datlist = $ARGV[4]; + $output = $ARGV[5]; + + open (FILE, "$master"); + @master = ; + close (FILE); + + open (FILE, "$medstat"); + @medstat = ; + close (FILE); + if (@master != @medstat) { &escape ("mismatch in master & medstat lists"); } + + open (FILE, "$defstat"); + @defstat = ; + close (FILE); + if (@master != @defstat) { print STDERR "NOTE: no data in $defstat\n"; } + + open (FILE, "$datlist"); + @datlist = ; + close (FILE); + if (@master != @datlist) { &escape ("mismatch in master & datlist lists"); } + + open (FILE, ">$output"); + for ($i = 0; $i < @master; $i++) { + ($path, $root, $mode, $status) = split (" ", $master[$i]); + + open (LIST, "$datlist[$i]"); + $line = ; + close (LIST); + ($obsid, $date, $time, $exptime) = split (" ", $line); + + ($S1, $F1, $dF1) = split (" ", $medstat[$i]); + if (@defstat) { + ($S2, $F2, $dF2) = split (" ", $defstat[$i]); + } + $flux = $S1 / $exptime; + + if (@defstat) { + printf FILE "%8s %11s %12s %7.1f %6.2f %6.1f %6.1f %6.1f %6.1f %2d %2d\n", $obsid, $date, $time, $S1, $flux, $F1, $dF1, $F2, $dF2, $status, $status; + } else { + printf FILE "%8s %11s %12s %7.1f %6.2f %6.1f %6.1f N/A N/A %2d %2d\n", $obsid, $date, $time, $S1, $flux, $F1, $dF1, $status, $status; + } + } + close (FILE); + &goodbye; +} + +# use CONFIG.master to create a subset of INPUT in OUTPUT +if ($ARGV[0] eq "-subset") { + + if (@ARGV != 4) { &escape ("USAGE: fr.mklists -subset CONFIG.master INPUT OUTPUT"); } + + $master = $ARGV[1]; + $input = $ARGV[2]; + $output = $ARGV[3]; + + open (FILE, $master); + @master = ; + close (FILE); + + open (FILE, $input); + @input = ; + close (FILE); + + if (@master != @input) { &escape ("mismatch in input & master file lengths"); } + + open (FILE, ">$output"); + + for ($i = 0; $i < @master; $i++) { + $line = $master[$i]; chop $line; + ($path, $root, $mode, $status) = split (" ", $line); + if ($status != $STAT_KEEP) { next; } + + $file = $input[$i]; chop $file; + printf FILE "$file\n"; + } + close (FILE); + + &goodbye; +} + +# use master, med.imstats, and statlist to create input list for fr.mkrough (file sky fringe 0 0) +if ($ARGV[0] eq "-ccdstats") { + + if (@ARGV != 6) { &escape ("USAGE: fr.mklists -ccdstats CONFIG.master CONFIG.med.imstats CONFIG.med.statlist CCD CONFIG.CCD.ccdstats"); } + + $master = $ARGV[1]; + $imstats = $ARGV[2]; + $statlist = $ARGV[3]; + $ccdid = $ARGV[4]; + $output = $ARGV[5]; + + $ccd = -1; + for ($i = 0; $i < @ccds; $i++) { + if ($ccdid eq $ccds[$i]) { + $ccd = $i; + last; + } + } + if ($ccd == -1) { &escape ("error in CCD ID"); } + + open (FILE, $master); + @master = ; + close (FILE); + + open (FILE, $imstats); + @imstats = ; + close (FILE); + if (@master != @imstats) { &escape ("mismatch in master & imstats file lengths"); } + + open (FILE, $statlist); + @statlist = ; + close (FILE); + if (@master != @statlist) { &escape ("mismatch in master & statlist file lengths"); } + + open (FILE, ">$output"); + + for ($i = 0; $i < @master; $i++) { + $line = $master[$i]; chop $line; + ($path, $root, $mode, $status) = split (" ", $line); + if ($status != $STAT_KEEP) { next; } + + $line = $imstats[$i]; chop $line; + ($SKY, $fringe, $dfringe) = split (" ", $line); + + $file = $statlist[$i]; chop $file; + open (STAT, "$file"); + @stats = ; + close (STAT); + + $line = $stats[$ccd]; + ($name, $sky) = split (" ", $line); + + # compare $sky with average sky $SKY? + $dsky = $sky - $SKY; + print "$i: $dsky\n"; + print FILE "$name $sky $fringe 0.0 0.0\n"; + } + close (FILE); + + &goodbye; +} + +# re-create master list, applying changes from detrend list +if ($ARGV[0] eq "-master") { + + if (@ARGV != 3) { + print STDERR "fr.mklists -master CONFIG.master CONFIG.detrend\n"; + &escape; + } + + $master = $ARGV[1]; + $detrend = $ARGV[2]; + + open (FILE, $master); + @master = ; + close (FILE); + foreach $name (@master) { chop ($name); } + + open (FILE, $detrend); + @detrend = ; + close (FILE); + foreach $name (@detrend) { chop ($name); } + + @remaster = (); + MASTER: + foreach $name (@master) { + ($path, $root, $mode, $status) = split (" ", $name); + + if (($status == $STAT_XDET) || ($status == $STAT_DETR)) { + # find entry in detrend list. if it exists, set status to status - 2 + DETREND: + foreach $dname (@detrend) { + ($dpath, $droot, $dmode) = split (" ", $name); + if ($droot eq $root) { + if ($status == $STAT_XDET) { $status = $STAT_XCLD; } + if ($status == $STAT_DETR) { $status = $STAT_KEEP; } + last DETREND; + } + } + } + + $new = "$path $root $mode $status"; + @remaster = (@remaster, $new); + } + + open (FILE, ">$master"); + foreach $name (@remaster) { + print FILE "$name\n"; + } + close (FILE); + &goodbye; +} + +# create list of input (detrended) frames for a single CCD for mkstats (status == 1) +if ($ARGV[0] eq "-inlist") { + + if (@ARGV != 5) { + print STDERR "fr.mklists -inlist CONFIG.master CCD TMPPATH CONF-CCD.inlist\n"; + &escape; + } + + $infile = $ARGV[1]; + $ccd = $ARGV[2]; + $tmppath = $ARGV[3]; + $outfile = $ARGV[4]; + + open (FILE, "$infile"); + @inlist = ; + close (FILE); + + open (FILE, ">$outfile"); + foreach $name (@inlist) { + ($path, $root, $mode, $status) = split (" ", $name); + if ($status != $STAT_KEEP) { next; } + + printf FILE "%s/%s.med/%s%s.fits\n", $tmppath, $root, $root, $ccd; + } + close (FILE); + &goodbye; +} + +### this old -imstats will be replaced. +# create list of input (detrended) frames for a single CCD for mkstats (status == 1) +if ($ARGV[0] eq "-imstats") { + + if (@ARGV != 5) { + print STDERR "fr.mklists -inlist CONFIG.master CCD TMPPATH CONF-CCD.imstats\n"; + &escape; + } + + $infile = $ARGV[1]; + $ccd = $ARGV[2]; + $tmppath = $ARGV[3]; + $outfile = $ARGV[4]; + + open (FILE, "$infile"); + @inlist = ; + close (FILE); + + open (FILE, ">$outfile"); + foreach $name (@inlist) { + ($path, $root, $mode, $status) = split (" ", $name); + if ($status != $STAT_KEEP) { next; } + + printf FILE "%s/%s.imstats\n", $tmppath, $root; + } + close (FILE); + &goodbye; +} + +# create list of input stats files +if ($ARGV[0] eq "-frstats") { + + if (@ARGV != 4) { + print STDERR "fr.mklists -frstats CONFIG.master TMPPATH CONF-CCD.imstats\n"; + &escape; + } + + $infile = $ARGV[1]; + $tmppath = $ARGV[2]; + $outfile = $ARGV[3]; + + open (FILE, "$infile"); + @inlist = ; + close (FILE); + + open (FILE, ">$outfile"); + foreach $name (@inlist) { + ($path, $root, $mode, $status) = split (" ", $name); + printf FILE "%s/%s.imstats\n", $tmppath, $root; + } + close (FILE); + &goodbye; +} + +# create list of input stats files +if ($ARGV[0] eq "-maplist") { + + if (@ARGV != 4) { + print STDERR "fr.mklists -maplist CONFIG.master TMPPATH CONFIG.maplists\n"; + &escape; + } + + $infile = $ARGV[1]; + $tmppath = $ARGV[2]; + $outfile = $ARGV[3]; + + open (FILE, "$infile"); + @inlist = ; + close (FILE); + + open (FILE, ">$outfile"); + foreach $name (@inlist) { + ($path, $root, $mode, $status) = split (" ", $name); + printf FILE "%s/%s.maplist 1\n", $tmppath, $root; + } + close (FILE); + &goodbye; +} + +&escape ("unknown mode $ARGV[0]"); + +########################################################################### + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub escape { + print STDERR "ERROR: @_\n"; + exit 1; +} + +sub goodbye { + print STDERR "SUCCESS @_\n"; + exit 0; +} + Index: /trunk/Ohana/src/perl/src/fr.mkmodes =================================================================== --- /trunk/Ohana/src/perl/src/fr.mkmodes (revision 17) +++ /trunk/Ohana/src/perl/src/fr.mkmodes (revision 17) @@ -0,0 +1,146 @@ +#!/usr/bin/env perl + +{ # grab the command line arguments: + $elconf = ""; + $elixcf = "-c /h/eugene/.ptolemyrc"; + @tARGV = (); + for (; @ARGV > 0; ) { + + # grab elixir/ptolemy config option -c + if ($ARGV[0] eq "-c") { + shift; + $elixcf = "-c $ARGV[0]"; + shift; + next; + } + + # grab elixir/ptolemy config option -C + if ($ARGV[0] eq "-C") { + @opt = (@opt, $ARGV[0]); + shift; + @opt = (@opt, $ARGV[0]); + $elconf = $ARGV[0]; + shift; + next; + } + + # grab elixir/ptolemy config option -D + if ($ARGV[0] eq "-D") { + @opt = (@opt, $ARGV[0]); + shift; + @opt = (@opt, $ARGV[0]); + shift; + @opt = (@opt, $ARGV[0]); + shift; + next; + } + + @tARGV = (@tARGV, $ARGV[0]); + shift; + } + @ARGV = @tARGV; + $elixir = join (" ", $elixcf, @opt); +} + +# check the usage +if ($ARGV[0] eq "-h") { usage (); } +if ($ARGV[0] eq "-help") { usage (); } +if (@ARGV != 3) { die "USAGE: fr.mkmodes (maplist) (mode.fits) (mode.list)\n" } + +# assign the command line arguments +$list = $ARGV[0]; +$output = $ARGV[1]; +$modes = $ARGV[2]; + +# find the appropriate script file +$confdir = `gconfig $elixir -q CONFDIR`; chop ($confdir); +$script = "$confdir/mana/modes.pro"; +$Nccd = `cameraconfig $elixir -Nccd`; chop ($Nccd); + +# load in list of input image lists +open (LIST, $list); +@list = ; +close (LIST); + +# if mode list exists, load it in and use the selected modes +# to set the new default selection +$GotModes = 0; +if (-e $modes) { + open (LIST, $modes); + @modes = ; + close (LIST); + $GotModes = 1; +} + +# send commands to mana: +open (MANA, "|mana --norc"); +print MANA "input $script\n"; + +# create a mana list of input file names +print MANA "list names\n"; +$Nimages = 0; +foreach $line (@list) { + ($name, $status) = split (" ", $line); + if ($status) { print MANA " $name\n"; } + $Nimages ++; +} +print MANA "end\n"; + +# create a mana list of input file names +print MANA "macro go\n"; +print MANA " mkimage $output\n"; +print MANA " exit 0\n"; +print MANA "end\n"; +print MANA "go\n"; +print MANA "exit 1\n"; +close (MANA); +if ($?) { + print STDERR "ERROR running mana\n"; + exit 1; +} + +# create new list of modes. if modes existed, use selected modes, otherwisaudio/x-pn-realaudio-plugine first 8: +$DefaultStatus = 1; +open (LIST, ">$modes"); +for ($i = 0; $i < $Nimages; $i++) { + # this is just a little funny: there is not a 1-1 relationship + # between the selected images and the modes in this selection. + # only the first few modes will be significant, so we are just + # cutting of the few end modes + if ($i >= 8) { $DefaultStatus = 0; } + if ($GotModes) { + ($mode, $status) = split (" ", $modes[$i]); + print LIST "$mode $status\n"; + } else { + print LIST "$i $DefaultStatus\n"; + } +} +close (LIST); + +print STDOUT "SUCCESS: finished with fr.detrend\n"; +exit 0; + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +sub usage { + print "\n"; + print "USAGE: fr.mkmodes (list) (output) (modes)\n"; + print " list: list of lists - each list contains names of the input images (*.map/*.fits)\n"; + print " output: master image of orthonormal modes\n"; + print " modes: list of modes in output, with status\n"; + exit 1; +} + +# mana within perl: we embed the mana functions within a macro to trap the +# exit status. If mana has an error with one of the steps, it will exit the macros and +# the second exit will be called. Otherwise, the "go" macro will perform the exit 0 +# and mana will exit with status 0 + Index: /trunk/Ohana/src/perl/src/fr.modesave =================================================================== --- /trunk/Ohana/src/perl/src/fr.modesave (revision 17) +++ /trunk/Ohana/src/perl/src/fr.modesave (revision 17) @@ -0,0 +1,78 @@ +#!/usr/bin/env perl + +# check the usage +if ($ARGV[0] eq "-h") { &usage (); } +if ($ARGV[0] eq "-help") { &usage (); } +if (@ARGV != 6) { &usage (); } + +# assign the command line arguments +$modefits = $ARGV[0]; +$modelist = $ARGV[1]; +$modesave = $ARGV[2]; +$startime = $ARGV[3]; +$stoptime = $ARGV[4]; +$filter = $ARGV[5]; + +# find the appropriate script file +$confdir = `gconfig -q CONFDIR`; chop ($confdir); +$script = "$confdir/mana/modes.pro"; + +# load in list of modes +open (LIST, $modelist); +@modelist = ; +close (LIST); + +$Nmode = 8; + +# run mana script: +open (MANA, "|mana --norc"); +print MANA "input $script\n"; + +print MANA "macro go\n"; +print MANA "\$filter = $filter\n"; +print MANA "\$start = \"$startime\"\n"; +print MANA "\$stop = \"$stoptime\"\n"; +print MANA "\$Nmode = $Nmode\n"; +for ($i = 0; $i < $Nmode; $i++ ) { + ($mode, $status) = split (" ", $modelist[$i]); + if ($status) { + print MANA "\$mode$i = 1\n"; + } else { + print MANA "\$mode$i = 0\n"; + } +} +print MANA "rd U $modefits\n"; +print MANA "savemodes $modesave\n"; +print MANA "exit 0\n"; + +print MANA "end\n"; +print MANA "go\n"; +print MANA "exit 1\n"; +close (MANA); +if ($?) { + print STDERR "ERROR problem with fr.modesave\n"; + exit 1; +} + +print STDOUT "SUCCESS: finished with fr.modesave\n"; +exit 0; + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +sub usage { + print "USAGE: fr.modesave (mode.fits) (mode.list) (mode.mef.fits) (start) (stop) (filter)\n"; + exit 1; +} + +# mana within perl: we embed the mana functions within a macro to trap the +# exit status. If mana has an error with one of the steps, it will exit the macros and +# the second exit will be called. Otherwise, the "go" macro will perform the exit 0 +# and mana will exit with status 0 Index: /trunk/Ohana/src/perl/src/fr.modestats =================================================================== --- /trunk/Ohana/src/perl/src/fr.modestats (revision 17) +++ /trunk/Ohana/src/perl/src/fr.modestats (revision 17) @@ -0,0 +1,92 @@ +#!/usr/bin/env perl + +# check the usage +if ($ARGV[0] eq "-h") { &usage (); } +if ($ARGV[0] eq "-help") { &usage (); } +if (@ARGV != 5) { &usage (); } + +# assign the command line arguments +$imlist = $ARGV[0]; +$modefits = $ARGV[1]; +$modelist = $ARGV[2]; +$modejpg = $ARGV[3]; # root of jpg images +$residjpg = $ARGV[4]; # root of jpg images + +# find the appropriate script file +$confdir = `gconfig -q CONFDIR`; chop ($confdir); +$script = "$confdir/mana/modes.pro"; + +# test named Xserver, or start vnc on specified machine +$xhost=`gconfig -q XHOST`; chop ($xhost); +$xdisp=`gconfig -q XDISP`; chop ($xdisp); +if (vsystem ("xdpyinfo -display $xdisp")) { + print STDERR "X server is not running. start it now on $xhost\n"; + exit 1; +} +$ENV{'DISPLAY'} = $xdisp; + +# load in list of input image lists +open (LIST, $imlist); +@imlist = ; +close (LIST); + +# load in list of input image lists +open (LIST, $modelist); +@modelist = ; +close (LIST); +$Nmode = 0; +foreach $line (@modelist) { + ($mode, $status) = split (" ", $line); + if ($status) { $Nmode ++; } +} + +# run mana script: +open (MANA, "|mana --norc"); +print MANA "input $script\n"; + +print MANA "macro go\n"; + +# we'll use the default 8 to generate the jpgs of the modes +print MANA "jpgmodes $modefits $modejpg\n"; + +# reset $Nmode for the actual number desired +print MANA "\$Nmode = $Nmode\n"; +print MANA "getmodes\n"; +for ($i = 0; $i < @imlist; $i++) { + ($name, $status) = split (" ", $imlist[$i]); + $jpgname = sprintf "%s.%03d.jpg", $residjpg, $i; + print MANA "jpgresid $name $jpgname\n"; +} +print MANA "exit 0\n"; + +print MANA "end\n"; +print MANA "go\n"; +print MANA "exit 1\n"; +close (MANA); +if ($?) { + print STDERR "ERROR problem with fr.modestats\n"; + exit 1; +} + +print STDOUT "SUCCESS: finished with fr.modestats\n"; +exit 0; + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +sub usage { + print "USAGE: fr.modestats (map.list) (mode.fits) (mode.list) (modes[.NNN.jpg]) (resid[.NNN.jpg])\n"; + exit 1; +} + +# mana within perl: we embed the mana functions within a macro to trap the +# exit status. If mana has an error with one of the steps, it will exit the macros and +# the second exit will be called. Otherwise, the "go" macro will perform the exit 0 +# and mana will exit with status 0 Index: /trunk/Ohana/src/perl/src/fr.select =================================================================== --- /trunk/Ohana/src/perl/src/fr.select (revision 17) +++ /trunk/Ohana/src/perl/src/fr.select (revision 17) @@ -0,0 +1,288 @@ +#!/usr/bin/env perl + +# check the usage +if ($ARGV[0] eq "-h") { usage (); } +if ($ARGV[0] eq "-help") { usage (); } +if (@ARGV != 5) { die "ERROR: USAGE: fr.select (filter) (start) (stop) (mode) (output)\n"; } + +# assign the command line arguments +$filter = $ARGV[0]; +$start = $ARGV[1]; +$stop = $ARGV[2]; +$mode = "\U$ARGV[3]\E"; +if (($mode ne "MEF") && ($mode ne "SPLIT")) { die "ERROR: mode must be either -split or -mef\n";} +$output = $ARGV[4]; + +# global constants +# these probably should go in the config files eventually. +$MAX_CNTS = 60000; +$MIN_CNTS = 2000; +$MIN_FLUX = 2; +$MAX_FLUX = 40; +# if ($filter eq "R") { $MIN_CNTS = 900; } +if ($filter eq "NB920") { $MIN_CNTS = 180; $MIN_FLUX = 0.3; } + +$Nccd = `cameraconfig -Nccd`; chop ($Nccd); +$line = `cameraconfig -axes`; chop ($line); +($Naxis1, $Naxis2) = split (" ", $line); + +@good = (); +@marginal = (); + +$criteria = "-type object -mode $mode -trange $start $stop -filter $filter"; + +# define filter lines. +@filtline = (); +# convert given filter name to list of possible names: +$answer = `filtnames $ARGV[0] -all`; +@filtlist = split (" ", $answer); + +foreach $name (@filtlist) { + $line = "-type object -mode $mode -trange $start $stop -filter $name"; + push @filtline, $line; +} + +# run selection on each possible $filtline +@list = (); +foreach $line (@filtline) { + @tlist = `imsearch -ccd 0 $line`; + @list = (@list, @tlist); +} +$Nlist = @list; +print STDERR "found $Nlist images\n"; + +IMLIST: + foreach $image (@list) { + @words = split (" ",$image); + + # poor way to search for all images + if ($mode eq "SPLIT") { + # all $Nccd images must exist on disk, split files are assumed to be + # in a subdirectory of their own, .fits extension assumed + @answer = <$words[4]/*.fits>; + if (@answer != $Nccd) { print STDERR "$words[5] rejected: missing images\n"; next IMLIST; } + } + + # images have to have the correct dimensions + if ($mode eq "SPLIT") { + $answer = `echo $words[4]/$words[5] | fields NAXIS1 NAXIS2`; + } else { + $answer = `echo $words[4]/$words[5] | fields -x 0 NAXIS1 NAXIS2`; + } + ($tmp, $Nx, $Ny) = split (" ", $answer); + if (($Nx != $Naxis1) || ($Ny != $Naxis2)) { print STDERR "$words[5] rejected: wrong dimensions\n"; next IMLIST; } + + # $match is a word unique to the full mosaic image (the rootdir for split, the image for mef) + if ($mode eq "split") { + @answer = split ("/", $words[4]); + $match = $answer[-1]; + } else { + $match = $words[5]; + } + @list2 = `imsearch -name $match`; + + MOSLIST: + foreach $ccd (@list2) { + @words2 = split (" ", $ccd); + + $cnts = $words2[11]; + $flux = $words2[11] / $words2[7]; + # test for acceptable flux range + if ($cnts < $MIN_CNTS) { print STDERR "$words[5] rejected: cnts too low: $cnts vs $MIN_CNTS\n"; next IMLIST; } + if ($cnts > $MAX_CNTS) { print STDERR "$words[5] rejected: cnts too high: $cnts vs $MAX_CNTS\n"; next IMLIST; } + if ($flux < $MIN_FLUX) { print STDERR "$words[5] rejected: flux too low: $flux vs $MIN_FLUX\n"; next IMLIST; } + if ($flux > $MAX_FLUX) { print STDERR "$words[5] rejected: flux too high: $flux vs $MAX_FLUX\n"; next IMLIST; } + } + + $fullname = "$words[4]/$words[5]"; + $root = gt_names ($fullname, "root", $mode); + $path = gt_names ($fullname, "path", $mode); + @good = (@good, "$path $root $mode"); +} + +open (LIST, ">$output"); +for ($i = 0; $i < @good; $i++) { + print LIST "$good[$i]\n"; +} +close (LIST); +print STDERR "SUCCESS\n"; +exit 0; + +# cfht MEF/SPLIT name utilities: + +sub gt_names { + # in: filename mode type + # out: word + + my ($value); + + $value = ""; + if ($_[2] eq "MEF") { $value = mefnames ($_[0], $_[1]); } + if ($_[2] eq "SPLIT") { $value = splitnames ($_[0], $_[1]); } + + return $value; +} + +sub mefnames { + # in: (/path/file.fits) (mode) + # out: word + + my($fullname) = $_[0]; + my($mode) = $_[1]; + my($answer); + + # split rootdir and filename: + my (@words) = split ("/", $fullname); + $N = @words; + + if ($mode eq "path") { + $answer = ""; + for ($i = 0; $i < $N - 1; $i++) { + $answer = $answer . $words[$i] . "/"; + } + chop ($answer); # strip off last / + if ($answer eq "") { $answer = "."; } + return ($answer); + } + + if ($mode eq "root") { + $answer = "$words[$N-1]"; + $answer =~ s/.fits$//; + return ($answer); + } + + if ($mode eq "Nccd") { + if (! -e $fullname) { + return (0); + } + $answer = `echo $fullname | fields NEXTEND`; + @words = split (" ", $answer); + if ($words[1] eq "") { + return (0); + } + return ($words[1]); + } + + return (0); +} + +sub splitnames { + # in: (/path/file) (mode) + # out: word + # /path/file is directory containing Nccd fits images + + my($fullname) = $_[0]; + my($mode) = $_[1]; + my($answer, $N, $tmpname, @imlist, @words); + + # split rootdir and filename: + @words = split ("/", $fullname); + $N = @words; + + if ($mode eq "path") { + $answer = ""; + for ($i = 0; $i < $N - 2; $i++) { + $answer = $answer . $words[$i] . "/"; + } + chop ($answer); # strip off last / + if ($answer eq "") { $answer = "."; } + return ($answer); + } + + if ($mode eq "root") { + $answer = "$words[$N-2]"; + return ($answer); + } + + if ($mode eq "Nccd") { + + $tmpname = "$fullname/$words[$N-1]"; + @imlist = <$tmpname??.fits>; + + $Nccd = @imlist; + return $Nccd; + } + + return (0); +} + +sub ckimtype { + # in: (/path/file) + # out: MEF | SPLIT | SINGLE | (NULL) + + my ($answer, $name, $value); + my ($file) = $_[0]; + + if (! -e $file) { + print STDOUT "can't open file\n"; + return ""; + } + + # if /path/file is a directory, it is split: + if (-d $file) { return "SPLIT"; } + + # check that the file is a FITS image + $answer = `file -L $file`; + if ($?) { + print STDOUT "can't open file\n"; + return ""; + } + ($name, $value) = split (" ", $answer); + if ($value ne "FITS") { + print STDOUT "not a valid image\n"; + return ""; + } + + # check for NAXIS = 0 (MEF) + $answer = `echo $file | fields NAXIS`; + # if ($?) { return ""; } + ($name, $value) = split (" ", $answer); + if ($value eq 0) { return "MEF"; } + + if ($value == 2) { return "SINGLE"; } + + print STDOUT "not a valid image\n"; + return ""; +} + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + print STDERR "ending execution\n"; + die "@_"; +} + +sub usage { + print "USAGE: fr.select (filter) (start) (stop) (mode) (output)\n"; + print " filter: R I Z (etc)\n"; + print " start: start date (yyyy/mm/dd,hh:mm:ss)\n"; + print " stop: stop date\n"; + print " mode: MEF or SPLIT\n"; + print " output: output file name\n"; + exit 1; +} + +# we need to select the list of images which satisfy a few criteria: +# 1) all 12 CCDs must exist +# 2) stats must be measured for each +# 3) stats for all 12 must be within range (2000 - 40000) +# 4) NAXIS1 == 2080 && NAXIS2 == 4128 + +# fr.select: +# this program takes a list of criteria which define a fringe / +# skyring frame, and an output filename, and fills the file with all +# images that fit the given criteria. It checks to make sure that the +# images have flux and counts in the appropriate range, and that all +# CCDs are available, and that they have the correct dimensions. + +# the output file consists of lines with the following entries: +# (path) (root) (mode) +# path: complete path to the image +# root: base name for file - MEF: root.fits, SPLIT: root/rootNN.fits +# mode: MEF / SPLIT + + Index: /trunk/Ohana/src/perl/src/grab.keywords =================================================================== --- /trunk/Ohana/src/perl/src/grab.keywords (revision 17) +++ /trunk/Ohana/src/perl/src/grab.keywords (revision 17) @@ -0,0 +1,223 @@ +#!/usr/bin/env perl + +$version = 1.0; + +if (@ARGV != 3) { die "USAGE: grab.keywords (infile) (cmproot) (outfile)\n" ; } + +$infile = $ARGV[0]; +$cmproot = $ARGV[1]; +$outfile = $ARGV[2]; + +# $infile is the image.fits file +# $cmproot is the rootname of the processed output for this file (contains astrom keywords) +# $outfile is the output header data file + +# grab astrometry keywords from $cmpfile: +@header = (); + + CMPTEST: { + # make this look for hdx files in hdxdir (fix dads.keywords as well) + # need to extract all header files first + + # try *.smp: + $cmpfile = "$cmproot.smp"; + if (-e $cmpfile) { + $answer = `echo $cmpfile | fields NASTRO`; + @words = split (" ", $answer); + if ($words[1] > 0) { last CMPTEST; } + } + + # try *.cmp: + $cmpfile = "$cmproot.cmp"; + if (-e $cmpfile) { + $answer = `echo $cmpfile | fields NASTRO`; + @words = split (" ", $answer); + if ($words[1] > 0) { last CMPTEST; } + } + + $cmpfile = ""; + } + +if ($cmpfile) { @header = `fhead $cmpfile`; } + +# set some default values: +@astrom = (); +$fsatur = 0; +$flimit = 0; +$exptime = 0; +$Nastro = 0; + +# search for the appropriate lines: +foreach $line (@header) { + + # astrometry keywords which are copied directly + if ($line =~ /CTYPE1 =/) { @astrom = (@astrom, $line);} + if ($line =~ /CTYPE2 =/) { @astrom = (@astrom, $line);} + if ($line =~ /CRPIX1 =/) { @astrom = (@astrom, $line);} + if ($line =~ /CRPIX2 =/) { @astrom = (@astrom, $line);} + if ($line =~ /CRVAL1 =/) { @astrom = (@astrom, $line);} + if ($line =~ /CRVAL2 =/) { @astrom = (@astrom, $line);} + if ($line =~ /NASTRO =/) { @astrom = (@astrom, $line); $Nastro = substr ($line, 10, 21); } + if ($line =~ /CERROR =/) { @astrom = (@astrom, $line);} + if ($line =~ /EQUINOX =/) { @astrom = (@astrom, $line);} + + # convert the PC00i00j matrix & CDELTi to CDi_j + if ($line =~ /PC001001=/) { $pc11 = substr ($line, 10, 21); } + if ($line =~ /PC001002=/) { $pc12 = substr ($line, 10, 21); } + if ($line =~ /PC002001=/) { $pc21 = substr ($line, 10, 21); } + if ($line =~ /PC002002=/) { $pc22 = substr ($line, 10, 21); } + if ($line =~ /CDELT1 =/) { $cd1 = substr ($line, 10, 21); } + if ($line =~ /CDELT2 =/) { $cd2 = substr ($line, 10, 21); } + + # save these values for the photometry section + if ($line =~ /FSATUR =/) { $fsatur = substr ($line, 10, 21); } + if ($line =~ /FLIMIT =/) { $flimit = substr ($line, 10, 21); } + if ($line =~ /EXPTIME =/) { $exptime = substr ($line, 10, 21); } + + # we will not use the FWHM values until those are better defined... + if (0) { + if ($line =~ /FWHM_X =/) { + $tmp = substr ($line, 10, 21); + $tmp = $tmp * 0.2; + $line = sprintf "FWHM_A = %20G / stellar profile major axis (arcsec) \n", $tmp; + @astrom = (@astrom, $line); + } + if ($line =~ /FWHM_Y =/) { + $tmp = substr ($line, 10, 21); + $tmp = $tmp * 0.2; + $line = sprintf "FWHM_B = %20G / stellar profile minor axis (arcsec) \n", $tmp; + @astrom = (@astrom, $line); + } + if ($line =~ /ANGLE =/) { @astrom = (@astrom, $line);} + } +} + +# check for validity of astrometry data +if ($Nastro == 0) { + print STDERR "can't find all astrometry keywords from $cmproot\n"; + $line = sprintf "COMMENT Elixir failed to find an astrometry solution for this image\n"; + @astrom = ($line); +} else { + # convert the pc, cdelt terms to cd terms + $cd11 = $cd1*$pc11; + $cd12 = $cd2*$pc12; + $cd21 = $cd1*$pc21; + $cd22 = $cd2*$pc22; + $line = sprintf "CD1_1 = %20G / WCS Coordinate scale matrix \n", $cd11; @astrom = (@astrom, $line); + $line = sprintf "CD1_2 = %20G / WCS Coordinate scale matrix \n", $cd12; @astrom = (@astrom, $line); + $line = sprintf "CD2_1 = %20G / WCS Coordinate scale matrix \n", $cd21; @astrom = (@astrom, $line); + $line = sprintf "CD2_2 = %20G / WCS Coordinate scale matrix \n", $cd22; @astrom = (@astrom, $line); +} + +# grab the appropriate photometry data +@photom = (); +@photlist = `transearch -image $infile 00 split -equiv`; +if ($?) { @photlist = (); } + +# check validity of photometry data +$Nphot = @photlist; +if ($Nphot == 0) { + print STDERR "can't get photometry data for this image\n"; + $line = sprintf "COMMENT Elixir failed to find photometry data for this image\n"; + @photom = ($line); +} else { + # parse the photometry data line + @words = split (" ", $photlist[$Nphot-1]); + $line = sprintf "PHOT_C = %20G / Nightly zero point - actual \n", $words[2]; @photom = (@photom, $line); + $line = sprintf "PHOT_C0 = %20G / Nightly zero point - nominal \n", $words[3]; @photom = (@photom, $line); + $line = sprintf "PHOT_CS = %20G / Nightly zero point - scatter \n", $words[4]; @photom = (@photom, $line); + $line = sprintf "PHOT_X = %20G / Nightly zero point - color term \n", $words[5]; @photom = (@photom, $line); + $line = sprintf "PHOT_K = %20G / Nightly zero point - airmass term \n", $words[6]; @photom = (@photom, $line); + $line = sprintf "PHOT_C1 = '%-18s' / Nightly zero point - color 1 \n", $words[7]; @photom = (@photom, $line); + $line = sprintf "PHOT_C2 = '%-18s' / Nightly zero point - color 2 \n", $words[8]; @photom = (@photom, $line); + $line = sprintf "PHOT_NM = %20d / Nightly zero point - N images \n", $words[9]; @photom = (@photom, $line); + $line = sprintf "PHOT_NS = %20d / Nightly zero point - N stars \n", $words[10]; @photom = (@photom, $line); + + # is there was no cmpfile, we should not set the SAT and LIM values. + if ($exptime == 0) { + $line = sprintf "COMMENT Photometric Analysis is incomplete for this image.\n"; + @photom = (@photom, $line); + $line = sprintf "COMMENT MAG_SAT and MAG_LIM cannot be determined.\n"; + @photom = (@photom, $line); + } else { + # adjust fsatur & flimit values by phot data + $fsatur = $fsatur - 25.0 + $words[2] + 2.5*log($exptime) / log(10.0); + $line = sprintf "MAG_SAT = %20G / approx saturation (mag) \n", $fsatur; + @photom = (@photom, $line); + + $flimit = $flimit - 25.0 + $words[2] + 2.5*log($exptime) / log(10.0); + $line = sprintf "MAG_LIM = %20G / approx completeness limit (mag) \n", $flimit; + @photom = (@photom, $line); + } + + # add some comments + $line = sprintf "COMMENT Formula for Photometry, based on keywords given in this header: \n"; @photom = (@photom, $line); + $line = sprintf "COMMENT m = -2.5*log(DN) + 2.5*log(EXPTIME) \n"; @photom = (@photom, $line); + $line = sprintf "COMMENT M = m + PHOT_C + PHOT_K*(AIRMASS - 1) + PHOT_X*(PHOT_C1 - PHOT_C2) \n"; @photom = (@photom, $line); +} + +# add generic Elixir comments: + +$now = localtime; +@comment = (); +$line = sprintf "COMMENT --------------- Elixir Analysis --------------- \n"; @comment = (@comment, $line); +$line = sprintf "COMMENT Elixir processing performed \@ CFHT, version $version \n"; @comment = (@comment, $line); +$line = sprintf "COMMENT Elixir version: $version \n"; @comment = (@comment, $line); +$line = sprintf "COMMENT Elixir processing date: $now \n"; @comment = (@comment, $line); +$line = sprintf "COMMENT Elixir website: http://www.cfht.hawaii.edu/Instruments/Elixir \n"; @comment = (@comment, $line); +$line = sprintf "COMMENT Elixir email: elixir\@cfht.hawaii.edu \n"; @comment = (@comment, $line); +$line = sprintf "COMMENT Elixir team: Eugene Magnier & Jean-Charles Cuillandre \n"; @comment = (@comment, $line); +# (line < 80) 12345678901234567890123456789012345678901234567890123456789012345678901234567890 + +@output = (@comment, @astrom, @photom); +$line = sprintf "COMMENT --------------- Elixir Analysis (end) --------------- \n"; @output = (@output, $line); + +# write output to file +open (FILE, ">$outfile"); +foreach $line (@output) { + print FILE "$line"; +} +close (FILE); +print STDERR "wrote $outfile\n"; + +exit 0; + +# given an image directory with a name like /path/output (a SPLIT): + +# for each ccd: + +# 1) get astrometry +# 2) + +#ckrunid 570965o/570965o00.fits +#set dir=`gconfig -q -D RUNID 01Ak01 TMPDIR` +#$dir/570965o/570965o00.cmp + + +################################################################################### + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + + + +sub junk { + + # create the basic entries for a header + $line = sprintf "SIMPLE = T / Standard FITS \n"; @output = (@output, $line); + $line = sprintf "BITPIX = 8 / no actual data in this file\n"; @output = (@output, $line); + $line = sprintf "NAXIS = 0 / Number of axes \n"; @output = (@output, $line); + + + + # fill in the bottom of the header + $line = sprintf "END"; @output = (@output, $line); +} + Index: /trunk/Ohana/src/perl/src/imclean.cfht =================================================================== --- /trunk/Ohana/src/perl/src/imclean.cfht (revision 17) +++ /trunk/Ohana/src/perl/src/imclean.cfht (revision 17) @@ -0,0 +1,48 @@ +#!/usr/bin/env perl + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + print STDERR "ending execution\n"; + die "@_"; +} + +if (@ARGV < 3) { + print STDERR "ERROR: USAGE: USAGE: imclean.cfht (fits) (obj) (cmp) [option]\n"; + print STDERR " corrects for errors with CD1_1, CRPIX1 on 12k for 51400 < MJD < 51540\n"; + print STDERR " also determines and inserts the photcode for the image\n"; + exit 2; +} + +# input image must already be in SPLIT mode +# determine the photcode of this image: +$photcode=`photcode -quiet $ARGV[0] 0 split`; +if ($?) { + print STDERR "ERROR: cannot find photcode\n"; + exit 1; +} +chop ($photcode); + +# check if we need to correct the WCS terms +$line = `echo $ARGV[0] | fields IMAGEID MJD-OBS`; +chop ($line); +($name, $id, $mjd) = split (" ", $line); +$fix=""; + +print STDERR "mjd $mjd, $id $id\n"; +if (($mjd > 51400) && ($mjd < 51540) && (($id == 2) || ($id == 6))) { + $line = `echo $ARGV[0] | fields CD1_1 CRPIX1 NAXIS1`; + ($name, $cd11, $crpix1, $nx) = split (" ", $line, 4); + $crpix1 = $nx - $crpix1; + $cd11 = -$cd11; + $fix = "-key CD1_1 %f $cd11 -key CRPIX1 %f $crpix1"; +} + +vsystem ("imclean @ARGV -p $photcode $fix"); + +exit 0; + Index: /trunk/Ohana/src/perl/src/imclean.subaru =================================================================== --- /trunk/Ohana/src/perl/src/imclean.subaru (revision 17) +++ /trunk/Ohana/src/perl/src/imclean.subaru (revision 17) @@ -0,0 +1,52 @@ +#!/usr/bin/env perl + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + print STDERR "ending execution\n"; + die "@_"; +} + +if (@ARGV < 3) { + print STDERR "ERROR: USAGE: USAGE: imclean.cfht (fits) (obj) (cmp) [option]\n"; + print STDERR " corrects for errors with CD1_1, CRPIX1 on 12k for 51400 < MJD < 51540\n"; + print STDERR " also determines and inserts the photcode for the image\n"; + exit 2; +} + +# input image must already be in SPLIT mode +# determine the photcode of this image: +$photcode=`photcode -quiet $ARGV[0] 0 split`; +if ($?) { + print STDERR "ERROR: cannot find photcode\n"; + exit 1; +} +chop ($photcode); + +# check if we need to correct the WCS terms +$line = `echo $ARGV[0] | fields DET-ID`; +chop ($line); +($name, $id) = split (" ", $line); + +$cfix = ""; +if ($id == 0) { $cfix = "-key CRPIX1 %f 4000.0 -key CRPIX2 %f 5000.0"; } +if ($id == 1) { $cfix = "-key CRPIX1 %f 4000.0 -key CRPIX2 %f 3000.0"; } +if ($id == 2) { $cfix = "-key CRPIX1 %f 0.0 -key CRPIX2 %f 1000.0"; } +if ($id == 3) { $cfix = "-key CRPIX1 %f 0.0 -key CRPIX2 %f -1000.0"; } +if ($id == 4) { $cfix = "-key CRPIX1 %f 4000.0 -key CRPIX2 %f -1000.0"; } +if ($id == 5) { $cfix = "-key CRPIX1 %f 4000.0 -key CRPIX2 %f 1000.0"; } +if ($id == 6) { $cfix = "-key CRPIX1 %f 0.0 -key CRPIX2 %f 5000.0"; } +if ($id == 7) { $cfix = "-key CRPIX1 %f 0.0 -key CRPIX2 %f 3000.0"; } +if ($id == 8) { $cfix = "-key CRPIX1 %f 0.0 -key CRPIX2 %f -3000.0"; } +if ($id == 9) { $cfix = "-key CRPIX1 %f 4000.0 -key CRPIX2 %f -3000.0"; } + +$fix = "-key PC001001 %f 1.0 -key PC001002 %f 0.0 -key PC002001 %f 0.0 -key PC002002 %f 1.0"; + +vsystem ("imclean @ARGV -p $photcode $fix $cfix"); + +exit 0; + Index: /trunk/Ohana/src/perl/src/imstatqso =================================================================== --- /trunk/Ohana/src/perl/src/imstatqso (revision 17) +++ /trunk/Ohana/src/perl/src/imstatqso (revision 17) @@ -0,0 +1,71 @@ +#!/usr/local/bin/perl +# send sky & seeing to QSO db +# probably need some error checking on the +# system call functions (seeingstats & fields) + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +if (@ARGV != 3) { die "USAGE: imstatqso (name) (stats) (sdat)\n"; } + +$line = `echo $ARGV[0] | fields IMAGEID`; +($tmp, $ccd) = split (" ", $line); + +if ($ccd != 3) { + print STDOUT "SUCCESS: skipping ccd $ccd\n"; + exit 0; +} + +$line = `echo $ARGV[0] | fields OBSID`; +($tmp, $obs) = split (" ", $line); +$obs = substr ($obs, 0, 6); + +$line = `echo $ARGV[0] | fields OBSTYPE`; +($tmp, $type) = split (" ", $line); +$type = uc ($type); + +$line = `echo $ARGV[0] | fields EXPTIME`; +($tmp, $etime) = split (" ", $line); + +open (FILE, "$ARGV[1]"); +@lines = ; +close (FILE); +@words = split (" ", $lines[0]); +$skybg = $words[0]; +$bias = $words[1]; + +if ($etime == 0) { + $flux = -1000; +} else { + $flux = $skybg / $etime; +} + +$fwhm = `seeingstats $ARGV[2]`; +chop ($fwhm); +$fwhm = $fwhm * 0.2; + +# if this is a BIAS, send just the bias for skybg +if ($type eq "BIAS") { + vsystem ("/cfht/bin/update_xexpe.sh -U qso_elixir -P op1eliw --obsid $obs --skybg $bias"); + print STDOUT "SUCCESS: done with $ARGV[0]\n"; + exit (0); +} + +# if this is an OBJECT, send both fwhm & flux +if ($type eq "OBJECT") { + vsystem ("/cfht/bin/update_xexpe.sh -U qso_elixir -P op1eliw --obsid $obs --skybg $flux --iq $fwhm"); + print STDOUT "SUCCESS: done with $ARGV[0]\n"; + exit (0); +} + +# otherwise, just send flux +vsystem ("/cfht/bin/update_xexpe.sh -U qso_elixir -P op1eliw --obsid $obs --skybg $flux"); +print STDOUT "SUCCESS: done with $ARGV[0]\n"; +exit (0); Index: /trunk/Ohana/src/perl/src/imstats =================================================================== --- /trunk/Ohana/src/perl/src/imstats (revision 17) +++ /trunk/Ohana/src/perl/src/imstats (revision 17) @@ -0,0 +1,63 @@ +#!/usr/bin/env perl + +if (@ARGV != 5) { die "USAGE: imstats (file.fits) (file.stats) (file.split) CCD MODE\n" } + +$file = $ARGV[0]; +$stats = $ARGV[1]; +$split = $ARGV[2]; +$ccd = $ARGV[3]; +$mode = $ARGV[4]; + +# check for outdir: +@words = split ("/", $stats); +pop (@words); +$outdir = join ("/", @words); +if ($outdir eq "") { $outdir = "."; } +if (! -d $outdir) { + vsystem ("mkdir -p $outdir"); + if ($?) { + print STDERR "ERROR: can't make directory component for output $outdir\n"; + exit 1; + } +} + +if (-e $stats) { unlink ($stats); } +if (-e $split) { unlink ($split); } + +# find the appropriate script file +$confdir = `gconfig -q CONFDIR`; chop ($confdir); +$script = "$confdir/mana/imstats.pro"; + +$ccdkeyword = `gconfig CCDNUM-KEYWORD`; chop ($ccdkeyword); + +open (MANA, "|mana --norc"); +print MANA "input $script\n"; + +print MANA "\$CCDKEYWORD = $ccdkeyword\n"; +print MANA "macro go\n"; +print MANA " getstats $file $ccd $mode $stats $split\n"; # load images, create mosaic +print MANA " exit 0\n"; +print MANA "end\n"; + +print MANA "go\n"; +print MANA "exit 1\n"; +close (MANA); +if ($?) { + print STDERR "ERROR problem with imstats\n"; + exit 1; +} + +print STDOUT "SUCCESS: finished with imstats\n"; + +exit 0; + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + Index: /trunk/Ohana/src/perl/src/irstats =================================================================== --- /trunk/Ohana/src/perl/src/irstats (revision 17) +++ /trunk/Ohana/src/perl/src/irstats (revision 17) @@ -0,0 +1,111 @@ +#!/usr/bin/env perl + +if (@ARGV != 2) { die "USAGE: imstats (file.fits) (file.stats)\n" } + +$file = $ARGV[0]; +$stats = $ARGV[1]; +@medlist = (); +$cube = 1; + +# check for outdir: +@words = split ("/", $stats); +pop (@words); +$outdir = join ("/", @words); +if ($outdir eq "") { $outdir = "."; } +if (! -d $outdir) { + system ("mkdir -p $outdir"); + if ($?) { &escape ("ERROR: can't make directory component for output $outdir"); } +} + +if (-e $stats) { unlink ($stats); } + +# find the appropriate script file +$confdir = `gconfig -q CONFDIR`; chop ($confdir); +$script = "$confdir/mana/imstats.pro"; + +# check that image is not MEF? +$answer = `echo $file | fields NAXIS3`; +($tmp, $Nplane) = split (" ", $answer); +if ($Nplane == 0) { + $Nplane = 1; + $cube = 0; +} + +$temp = `mktemp /tmp/imstats.XXXXXX`; chop ($temp); + +# loop over cube planes: +open (MANA, "|mana --norc > /dev/null"); +print MANA "input $script\n"; + +print MANA "macro go\n"; +for ($plane = 0; $plane < $Nplane; $plane++) { + print MANA " irstats $file $plane $temp.$plane.fits $temp.stats $stats\n"; + @medlist = (@medlist, "$temp.$plane.fits"); +} +print MANA " exit 0\n"; +print MANA "end\n"; + +print MANA "go\n"; +print MANA "exit 1\n"; +close (MANA); +if ($?) { &escape ("ERROR problem with imstats"); } + +if (@medlist > 1) { + open (MED, "|medianfilter $temp.fits 0.25 0.75"); + foreach $file (@medlist) { + print MED "$file\n"; + } + close (MED); + if ($?) { &escape ("ERROR problem with medianfilter"); } + + system ("sexstats $temp.fits $temp.stats > /dev/null"); + if ($?) { &escape ("ERROR problem with sexstats"); } +} else { + system ("sexstats $temp.0.fits $temp.stats > /dev/null"); + if ($?) { &escape ("ERROR problem with sexstats"); } +} + +if ($cube) { + $fwhm = `seeingstats $temp.stats`; chop ($fwhm); + if ($?) { &escape ("ERROR problem with sexstats"); } + + open (MED, "$stats"); + @list = ; + close (MED); + + $sky = 0; + foreach $line (@list) { + ($tmp, $isky, $tmp) = split (" ", $line); + $sky += $isky; + } + $sky = $sky / @list; + + open (MED, ">>$stats"); + print MED "$Nplane $sky $fwhm\n"; + close (MED); +} + +&cleanup; +print STDOUT "SUCCESS: finished with imstats\n"; + +exit 0; + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub escape { + &cleanup; + die "@_\n"; +} + +sub cleanup { + if (-e "$temp") { unlink ("$temp"); } + if (-e "$temp.stats") { unlink ("$temp.stats"); } + if (-e "$temp.fits") { unlink ("$temp.fits"); } + foreach $file (@medlist) { + if (-e $file) { unlink $file; } + } +} Index: /trunk/Ohana/src/perl/src/merge.lists =================================================================== --- /trunk/Ohana/src/perl/src/merge.lists (revision 17) +++ /trunk/Ohana/src/perl/src/merge.lists (revision 17) @@ -0,0 +1,92 @@ +#!/usr/bin/env perl + +$update = 0; + +# grab the command line arguments: +@tARGV = (); +for (; @ARGV > 0; ) { + + # new images get mode of 0, old image keep their mode + if ($ARGV[0] eq "-update") { + shift; + $update = 1; + next; + } + + @tARGV = (@tARGV, $ARGV[0]); + shift; +} +@ARGV = @tARGV; + +if (@ARGV != 3) { die "USAGE: merge.lists (list.split) (list.msplit) (list.master) [-update]\n" ;} + +# load names from SPLIT and MEF +open (FILE, "$ARGV[0]"); +@split = ; +close (FILE); + +open (FILE, "$ARGV[1]"); +@mef = ; +close (FILE); + +# load old names from MASTER +open (FILE, "$ARGV[2]"); +@master = ; +close (FILE); + +# merge new entries into a single list, compare with state in master +@names = (@split, @mef); + +@newname = (); +@newmode = (); + +for ($i = 0; $i < @names; $i++) { + + $name = $names[$i]; chop ($name); + + $mode = 1; + if ($update) { + $mode = 0; + + INNER: + foreach $line (@master) { + @words = split (" ", $line); + if ($words[0] eq $name) { + $mode = $words[1]; + last INNER; + } + } + } + @newname = (@newname, $name); + @newmode = (@newmode, $mode); +} + +if (! @newname) { + print STDERR "ERROR: no relevant ccd images\n"; + exit 1; +} + +# check on list: if there are none selected, select all +$Ngood = 0; +foreach $mode (@newmode) { + if ($mode) { + $Ngood ++; + } +} +if ($Ngood == 0) { + foreach $mode (@newmode) { + $mode = 1; + } +} + +open (FILE, ">$ARGV[2]"); +for ($i = 0; $i < @newname; $i++) { + print FILE "$newname[$i] $newmode[$i]\n"; +} +close (FILE); + +# this file must be accessible by www user +chmod 0666, $ARGV[2]; + +print STDOUT "SUCCESS\n"; +exit 0; Index: /trunk/Ohana/src/perl/src/mkdetrend =================================================================== --- /trunk/Ohana/src/perl/src/mkdetrend (revision 17) +++ /trunk/Ohana/src/perl/src/mkdetrend (revision 17) @@ -0,0 +1,2338 @@ +#!/usr/bin/perl + +# strip off args related to the elixir config system, set env PTOLEMY +@ARGV = elixir_config (@ARGV); + +# interpret command-line arguments +if (@ARGV < 1) { + print STDOUT "USAGE: mkdetrend (mode) [arguments]\n"; + print STDOUT "mode = help gives a complete list\n"; + &escape; +} +if ($ARGV[0] eq "help") { &usage; } + +# main user level commands +if ($ARGV[0] eq "create") { &mk_create; } +if ($ARGV[0] eq "config") { &mk_config; } +if ($ARGV[0] eq "run") { &mk_run; } +if ($ARGV[0] eq "state") { &mk_state; } +if ($ARGV[0] eq "list.runs") { &mk_list_runs; } +if ($ARGV[0] eq "clean") { &mk_clean; } +if ($ARGV[0] eq "reset") { &mk_reset; } +if ($ARGV[0] eq "init") { &mk_init; } +if ($ARGV[0] eq "update") { &mk_update; } +if ($ARGV[0] eq "auto") { &mk_auto; } +# lower level user comands +if ($ARGV[0] eq "dup") { &mk_dup; } +if ($ARGV[0] eq "del") { &mk_del; } +if ($ARGV[0] eq "def") { &mk_def; } +if ($ARGV[0] eq "set") { &mk_set; } +if ($ARGV[0] eq "list.init") { &mk_list_init; } +if ($ARGV[0] eq "split") { &mk_split; } +if ($ARGV[0] eq "flips") { &mk_flips; } +if ($ARGV[0] eq "norm") { &mk_norm; } +if ($ARGV[0] eq "reg") { &mk_reg; } +if ($ARGV[0] eq "scat") { &mk_scat; } +if ($ARGV[0] eq "merge") { &mk_merge; } +if ($ARGV[0] eq "update.list") { &mk_update_list; } +if ($ARGV[0] eq "update.stats") { &mk_update_stats; } +# HTML cgibin commands +if ($ARGV[0] eq "htmldup") { &mk_htmldup; } +if ($ARGV[0] eq "htmldef") { &mk_htmldef; } +if ($ARGV[0] eq "htmldel") { &mk_htmldel; } +if ($ARGV[0] eq "htmlmod") { &mk_htmlmod; } +if ($ARGV[0] eq "htmlkeep") { &mk_htmlkeep; } +if ($ARGV[0] eq "htmlconfig") { &mk_htmlconfig; } +if ($ARGV[0] eq "html1") { &mk_html1; } +if ($ARGV[0] eq "html2") { &mk_html2; } +if ($ARGV[0] eq "html3") { &mk_html3; } +# other support commands +if ($ARGV[0] eq "dads") { &mk_dads; } +if ($ARGV[0] eq "dads.top") { &mk_dads_top; } +if ($ARGV[0] eq "meval") { &mk_meval; } +if ($ARGV[0] eq "eval") { &mk_eval; } +if ($ARGV[0] eq "fix.masters") { &mk_fixmasters; } +if ($ARGV[0] eq "check.splits") { &mk_checksplits; } + +if ($ARGV[0] eq "test") { &mk_test; } + +&escape ("invalid mkdetrend command $ARGV[0]"); + +######## top level functions ###################### + +############# define run ############## +sub mk_create { + if ($ARGV[1] eq "run") { &mk_createrun; } + if (@ARGV != 5) { &escape ("USAGE: mkdetrend create (camera) (run) (startdate) (stopdate)"); } + + $camera = $ARGV[1]; + $run = $ARGV[2]; + $start = $ARGV[3]; + $stop = $ARGV[4]; + + # create should NOT set the mkdetrend defaults + if (0) { + # set current run id: + system ("mkrun sys camera.mkdetrend $camera"); + if ($?) { &escape ("can't define camera: error in mkrun"); } + + # set current camera: + system ("mkrun sys runid.mkdetrend $run"); + if ($?) { &escape ("can't define run: error in mkrun"); } + } + + # reset values for the directories, etc. + $oldenv = $tmpenv; + &elixir_config (split (" ", "-run $run -camera $camera")); + unlink ($oldenv); + + # create necessary directories, empty them if they exist + foreach $name ("detdir", "html", "stats", "flips") { + $file = mkfiles ($name); + if (! -d $file) { + if (! mkdir ($file, 0777)) { + &escape ("can't create detdir $file\n"); + } + chmod 0775, $file; + } + } + $file = mkfiles ("split"); + symlink ("/data/koa/split", $file); + &save_dates ($start, $stop, "init"); + + # create run-specific config file + @list = (); + for ($i = 0; $i < @filt; $i++) { + $line = stconfig ("$run $type[$i] $filt[$i] 0 $start $stop init", "all"); + @list = (@list, $line); + } + save_config (@list); + + # make the necessary directories? + &goodbye; +} + +############# define run ############## +sub mk_createrun { + if (@ARGV != 3) { &escape ("USAGE: mkdetrend create run (run)"); } + if ($ARGV[1] ne "run") { &escape ("USAGE: mkdetrend create run (run)"); } + + $run = $ARGV[2]; + $answer = `mkrun run $run`; + if ($?) { &escape ("run $run not defined, use 'mkrun'"); } + ($newrun, $start, $stop, $camera) = split (" ", $answer); + if ($run ne $newrun) { &escape ("inconsistent answer from mkrun run $run"); } + + # reset values for the directories, etc. + $oldenv = $tmpenv; + &elixir_config (split (" ", "-run $run -camera $camera")); + unlink ($oldenv); + + # create necessary directories, empty them if they exist + foreach $name ("detdir", "html", "stats", "flips") { + $file = mkfiles ($name); + if (! -d $file) { + if (! mkdir ($file, 0777)) { + &escape ("can't create detdir $file\n"); + } + chmod 0775, $file; + } + } + $file = mkfiles ("split"); + symlink ("/data/koa/split", $file); + &save_dates ($start, $stop, "init"); + + # create run-specific config file + @list = (); + for ($i = 0; $i < @filt; $i++) { + $line = stconfig ("$run $type[$i] $filt[$i] 0 $start $stop init", "all"); + @list = (@list, $line); + } + save_config (@list); + + # make the necessary directories? + &goodbye; +} + +############# change current run ############## +sub mk_config { + if (@ARGV != 3) { &escape ("USAGE: mkdetrend config (camera) (run)"); } + + $camera = $ARGV[1]; + $run = $ARGV[2]; + + # set current run id: + system ("mkrun sys camera.mkdetrend $camera"); + if ($?) { &escape ("can't define camera: error in mkrun"); } + + # set current run id: + system ("mkrun sys runid.mkdetrend $run"); + if ($?) { &escape ("can't define run: error in mkrun"); } + + &goodbye; +} + +############# auto run system ############## +sub mk_auto { + my ($start, $stop, $mode); + + if ((@ARGV != 2) && (@ARGV != 3)) { &escape ("USAGE: mkdetrend auto [command]"); } + $command = $ARGV[1]; + + ($start, $stop, $mode) = load_dates (); + if ($command eq "set") { + if (@ARGV != 3) { &escape ("USAGE: mkdetrend auto set (mode)"); } + &save_dates ($start, $stop, $ARGV[2]); + &goodbye; + } + + if (@ARGV != 2) { &escape ("USAGE: mkdetrend auto [command]"); } + if ($command eq "show") { + print STDERR "MODE : $mode\n"; + &goodbye; + } + + if ($command eq "run") { + if ($mode eq "init") { + system ("mkdetrend reset hard"); + system ("mkdetrend init"); + system ("mkdetrend run"); + &save_dates ($start, $stop, "init"); + &goodbye; + } + + if ($mode eq "update") { + system ("mkdetrend update"); + &save_dates ($start, $stop, "update"); + &goodbye; + } + + if ($mode eq "hold") { + &goodbye; + } + } + &escape ("mkdetrend auto $command : command not found\n"); +} + +############# main run ############## +sub mk_run { + if (@ARGV != 1) { &escape ("USAGE: mkdetrend run"); } + + system ("mkdetrend flips"); + system ("mkdetrend norm"); + system ("mkdetrend merge"); + + &goodbye; +} + +############# main init ############## +sub mk_init { + if (@ARGV != 1) { &escape ("USAGE: mkdetrend init"); } + + system ("mkdetrend list.init"); + system ("mkdetrend split"); + + &goodbye; +} + +############# main update ############## +sub mk_update { + if (@ARGV != 1) { &escape ("USAGE: mkdetrend update"); } + + system ("mkdetrend reset update"); + system ("mkdetrend init"); + system ("mkdetrend update.list"); + system ("mkdetrend update.stats"); + system ("mkdetrend run"); + + &goodbye; +} + +############# show current state ############## +sub mk_state { + if (@ARGV != 1) { &escape ("USAGE: mkdetrend state"); } + + $file = mkfiles ("dates"); + if (! -e $file) { + print STDOUT "CAMERA $camera\n"; + print STDOUT "RUN $run\n"; + &escape ("setup not defined"); + } + ($start, $stop, $mode) = load_dates (); + + print STDOUT "CAMERA $camera\n"; + print STDOUT "RUN $run\n"; + print STDOUT "START $start\n"; + print STDOUT "STOP $stop\n"; + print STDOUT "MODE $mode\n"; + + @list = &load_config; + if (@list == 0) { &escape ("mkdetrend not configured"); } + + for ($i = 0; $i < @list; $i++) { + printf STDOUT "%3d %s\n", $i, $list[$i]; + } + &goodbye; +} + +############# show current state ############## +sub mk_list_runs { + if (@ARGV != 1) { &escape ("USAGE: mkdetrend list.runs"); } + + system ("ls $root"); + &goodbye; +} + +############## duplicate config ############### +sub mk_dup { + if (@ARGV != 2) { &escape ("USAGE: detrend dup (config)"); } + + $key = $ARGV[1]; + @list = load_config (); + + # look for entry that matches requested config + @match = (); + for ($i = 0; $i < @list; $i++) { + $config = gtconfig ($list[$i], "config"); + if ($key eq $config) { @match = (@match, $i); } + } + if (@match == 0) { &escape ("config $key not found\n"); } + + # create new config version based on version 0 + $Nnew = @match; + $old = $list[$match[0]]; + $new = stconfig ($old, "version", $Nnew); + @list = (@list, $new); + save_config (@list); + + # now we need to duplicate all of the reference files from the first config + for ($i = 0; $i < $Nccd; $i++) { + $fold = mknames ("master", $old, $ccds[$i]); + $fnew = mknames ("master", $new, $ccds[$i]); + system ("cp $fold $fnew"); + } + foreach $name ("stats", "medbin", "tenbin", "imbin") { + $fold = mknames ($name, $old); + $fnew = mknames ($name, $new); + system ("cp $fold $fnew"); + } + + &goodbye; + +} + +############## clean config ############### +sub mk_clean { + if (@ARGV != 1) { &escape ("USAGE: detrend clean"); } + # only deletes temporary files for configs in state 'done' + + @delete = ('fits', 'norm', 'proc.imbin', 'proc.medbin', 'proc.tenbin'); + @list = load_config (); + + $split = mkfiles ("split"); + @answer = `df -k $split`; + @words = split (" ", $answer[1]); + print STDERR "space free at start: $words[3]\n"; + $detdir = mkfiles ("detdir"); + open (CF, ">$detdir/clean.fail"); + + $Nmiss = 0; + $Nfail = 0; + $Ngood = 0; + + foreach $confline (@list) { + $status = gtconfig ($confline, "status"); + if ($status ne "done") { next; } + + print STDERR "deleting files from $confline\n"; + $confline = stconfig ($confline, "status", "running.clean"); + save_config (@list); + + foreach $ccd (@ccds) { + # delete these specific files: + @dlist = (); + push @dlist, &mknames ("fits", $confline, $ccd); + push @dlist, &mknames ("norm", $confline, $ccd); + push @dlist, &mknames ("proc.imbin", $confline, $ccd); + push @dlist, &mknames ("proc.medbin", $confline, $ccd); + push @dlist, &mknames ("proc.tenbin", $confline, $ccd); + + # delete file, if it exists + foreach $file (@dlist) { + if (! -e $file) { $Nmiss ++; next; } + if (!unlink $file) { $Nfail ++; print CF "$file\n"; next; } + $Ngood ++; + } + + # delete files names in these files: + $name = &mknames ("msplit", $confline, $ccd); + open (FILE, "$name"); + @dlist = ; + close (FILE); + + # delete file, if it exists + foreach $file (@dlist) { + chop $file; + if (! -e $file) { $Nmiss ++; next; } + if (!unlink $file) { $Nfail ++; print CF "$file\n"; next; } + $Ngood ++; + } + + } + $confline = stconfig ($confline, "status", "clean"); + save_config (@list); + } + close (CF); + + $split = mkfiles ("split"); + @answer = `df -k $split`; + @words = split (" ", $answer[1]); + print STDERR "space free at end: $words[3]\n"; + print STDERR "$Ngood files deleted\n"; + print STDERR "$Nmiss files already removed\n"; + print STDERR "$Nfail files not deleted, see '$detdir/clean.fail'\n"; + + &goodbye; +} + +############## delete config ############### +sub mk_del { + if (@ARGV != 2) { &escape ("USAGE: mkdetrend del (config.ver)"); } + + $key = $ARGV[1]; + @list = load_config (); + + # look for entry that matches requested config + $match = -1; + for ($i = 0; $i < @list; $i++) { + $version = gtconfig ($list[$i], "version"); + if ($key eq $version) { + $match = $i; + last; + } + } + if ($match == -1) { + print STDERR "config.ver $key not found\n"; + &escape; + } + + # create new list without match: + @newlist = (); + for ($i = 0; $i < @list; $i++) { + if ($i == $match) { next; } + @newlist = (@newlist, $list[$i]); + } + + save_config (@newlist); + &goodbye; + +} + +############## reset config ############### +sub mk_reset { + if (@ARGV != 2) { + print STDERR "USAGE: mkdetrend reset (level)\n"; + print STDERR " level = hard || update\n"; + &escape; + } + + $level = $ARGV[1]; + @list = load_config (); + + # find specific config: +RESET: + foreach $confline (@list) { + $status = gtconfig ($confline, "status"); + + if ($level eq "hard" ) { + $confline = stconfig ($confline, "status", "init"); + } + if ($level eq "update") { + if (($status eq "done.merge") || ($status eq "modified") || ($status eq "update")) { + $confline = stconfig ($confline, "status", "update"); + next RESET; + } + if (($status eq "freeze") || ($status eq "accepted")) { + $confline = stconfig ($confline, "status", "freeze"); + next RESET; + } + $confline = stconfig ($confline, "status", "init"); + } + } + save_config (@list); + &goodbye; +} + +############## define config ############### +sub mk_def { + if (@ARGV != 4) { &escape ("USAGE: mkdetrend def (config.ver) (start) (stop)"); } + + $key = $ARGV[1]; + $start = $ARGV[2]; + $stop = $ARGV[3]; + + @list = load_config (); + + # find specific config: + $match = -1; + for ($i = 0; $i < @list; $i++) { + $version = gtconfig ($list[$i], "version"); + if ($key eq $version) { + $match = $i; + } + } + if (@match == -1) { + print STDERR "config.ver $key not found\n"; + &escape; + } + + $new = $list[$match]; + $new = stconfig ($new, "start", $start); + $new = stconfig ($new, "stop", $stop); + $list[$match] = $new; + + save_config (@list); + &goodbye; + +} + +############## list init ############### +sub mk_list_init { + if (@ARGV != 1) { &escape ("USAGE: mkdetrend list.init"); } + + @list = load_config (); + + # create namelist + $Nrun = 0; + $file = mkfiles ("list"); + open (FILE, ">$file"); + foreach $confline (@list) { + $status = gtconfig ($confline, "status"); + if ($status ne "init") { next; } + $Nrun ++; + $line = gtconfig ($confline, "mosaic"); + print FILE "$line\n"; + $confline = stconfig ($confline, "status", "running.init"); + } + close (FILE); + save_config (@list); + + if ($Nrun == 0) { &goodbye; } + + system ("elixir -D DETREND_DIR $det -D mode mkdetrend -D global.pending imselect.split $file"); + system ("mkdetrend meval init"); + + &goodbye; +} + +############## split ############### +sub mk_split { + if (@ARGV != 1) { &escape ("USAGE: mkdetrend split"); } + + @list = load_config (); + + # create namelist + $Nrun = 0; + $file = mkfiles ("list"); + open (FILE, ">$file"); + foreach $confline (@list) { + $status = gtconfig ($confline, "status"); + if (($status ne "done.init") && ($status ne "split")) { next; } + $Nrun ++; + for ($j = 0; $j < $Nccd; $j++) { + $line = gtconfig ($confline, "chiprun", $j); + print FILE "$line\n"; + } + $confline = stconfig ($confline, "status", "running.split"); + } + close (FILE); + save_config (@list); + + if ($Nrun == 0) { &goodbye; } + + system ("elixir -D DETREND_DIR $det -D mode mkdetrend -D global.pending split.mef $file"); + system ("mkdetrend eval split"); + + &goodbye; +} + +############## update lists ############### +sub mk_update_list { + if (@ARGV != 1) { &escape ("USAGE: mkdetrend update.list"); } + + @list = load_config (); + + # create namelist + $Nrun = 0; + $file = mkfiles ("list"); + open (FILE, ">$file"); + foreach $confline (@list) { + $status = gtconfig ($confline, "status"); + if ($status ne "update") { next; } + $Nrun ++; + $line = gtconfig ($confline, "mosaic"); + print FILE "$line\n"; + $confline = stconfig ($confline, "status", "running.update.list"); + } + close (FILE); + save_config (@list); + + if ($Nrun == 0) { &goodbye; } + + system ("elixir -D DETREND_DIR $det -D mode mkdetrend -D global.pending update.split $file"); + system ("mkdetrend meval update.list"); + + &goodbye; +} + +############## update stats ############### +sub mk_update_stats { + if (@ARGV != 1) { &escape ("USAGE: mkdetrend update.stats"); } + + @list = load_config (); + + # create namelist + $Nrun = 0; + $file = mkfiles ("list"); + open (FILE, ">$file"); + foreach $confline (@list) { + $status = gtconfig ($confline, "status"); + if (($status ne "done.update.list") && ($status ne "update.stats")) { next; } + $Nrun ++; + for ($j = 0; $j < $Nccd; $j++) { + $line = gtconfig ($confline, "chiprun", $j); + print FILE "$line\n"; + } + $confline = stconfig ($confline, "status", "running.update.stats"); + + } + close (FILE); + save_config (@list); + + if ($Nrun == 0) { &goodbye; } + + system ("elixir -D DETREND_DIR $det -D mode mkdetrend -D global.pending update.msplit $file"); + system ("mkdetrend eval update.stats"); + + &goodbye; +} + +############## set state ############### +sub mk_set { + if (@ARGV != 3) { &escape ("USAGE: mkdetrend set (config number) (state)"); } + + @list = load_config (); + + $key = $ARGV[1]; + $state = $ARGV[2]; + + $new = stconfig ($list[$key], "status", "$state"); + $list[$key] = $new; + save_config (@list); + + &goodbye; +} + +############## flips run ############### +sub mk_flips { + if (@ARGV != 1) { &escape ("USAGE: mkdetrend flips"); } + + @list = load_config (); + + # create namelist for those with appropriate status + $Nrun = 0; + $file = mkfiles ("list"); + open (FILE, ">$file"); + foreach $confline (@list) { + $status = gtconfig ($confline, "status"); + if (($status ne "done.split") && ($status ne "modified") && ($status ne "flips")) { next; } + $Nrun ++; + for ($j = 0; $j < $Nccd; $j++) { + $line = gtconfig ($confline, "chiprun", $j); + print FILE "$line\n"; + } + $confline = stconfig ($confline, "status", "running.flips"); + } + close (FILE); + save_config (@list); + + if ($Nrun == 0) { &goodbye; } + + system ("elixir -D DETREND_DIR $det -D mode mkdetrend -D global.pending create.subset $file"); + system ("mkdetrend eval flips"); + + &goodbye; +} + +############## norm run ############### +sub mk_norm { + if (@ARGV != 1) { &escape ("USAGE: mkdetrend norm"); } + + @list = load_config (); + + # create namelist for those with appropriate status + $Nrun = 0; + $file = mkfiles ("list"); + open (FILE, ">$file"); + foreach $confline (@list) { + $status = gtconfig ($confline, "status"); + if (($status ne "done.flips") && ($status ne "norm")) { next; } + $Nrun ++; + for ($j = 0; $j < $Nccd; $j++) { + $line = gtconfig ($confline, "chiprun", $j); + print FILE "$line\n"; + } + $confline = stconfig ($confline, "status", "running.norm"); + } + close (FILE); + save_config (@list); + + if ($Nrun == 0) { &goodbye; } + + vsystem ("elixir -D DETREND_DIR $det -D mode mkdetrend -D global.pending normal $file"); + vsystem ("mkdetrend eval norm"); + + &goodbye; +} + +############## merge run ############### +sub mk_merge { + if (@ARGV != 1) { &escape ("USAGE: mkdetrend merge"); } + + @list = load_config (); + + # create namelist for those with appropriate status + $Nrun = 0; + $file = mkfiles ("list"); + open (FILE, ">$file"); + foreach $confline (@list) { + $status = gtconfig ($confline, "status"); + if (($status ne "done.norm") && ($status ne "done.update.stats") && ($status ne "merge")) { next; } + $Nrun ++; + $line = gtconfig ($confline, "mosaic"); + $confline = stconfig ($confline, "status", "running.merge"); + print FILE "$line\n"; + } + close (FILE); + save_config (@list); + + if ($Nrun == 0) { &goodbye; } + + vsystem ("elixir -D DETREND_DIR $det -D mode mkdetrend -D global.pending stats $file"); + vsystem ("mkdetrend meval merge"); + + &goodbye; +} + +############## reg run ############### +sub mk_reg { + if (@ARGV != 1) { &escape ("USAGE: mkdetrend reg"); } + + @list = load_config (); + + # create namelist for those with appropriate status + foreach $confline (@list) { + $status = gtconfig ($confline, "status"); + if (($status ne "accepted") && ($status ne "reg")) { next; } + $confline = stconfig ($confline, "status", "running.reg"); + save_config (@list); + + $success = 1; + $ID = gtconfig ($confline, "ID"); + for ($j = 0; $j < $Nccd; $j++) { + $file = mknames ("norm", $confline, $ccds[$j]); + $line = "detregister $file -label elixir -ID $ID"; + $status = system ($line); + if ($status) { + print STDERR "error registering $file\n"; + $success = 0; + } + } + if ($success) { + $confline = stconfig ($confline, "status", "done.reg"); + } else { + $confline = stconfig ($confline, "status", "fail.reg"); + } + save_config (@list); + } + + # detregister is sequential anyway, run serial + # system ("elixir -D DETREND_DIR $det -D mode mkdetrend -D global.pending detregister $file"); + # system ("mkdetrend eval reg"); + + # use recipe file to decide if we apply 'scat' or not! + + $file = mkfiles ("list"); + # create list of images to apply scattered-light correction: + foreach $confline (@list) { + $type = gtconfig ($confline, "type"); + $status = gtconfig ($confline, "status"); + if (($status ne "done.reg") && ($status ne "scat")) { next; } + + # only flats get scat correction + if ($type eq "flat") { + $ID = gtconfig ($confline, "ID"); + + open (FILE, ">$file"); + for ($j = 0; $j < $Nccd; $j++) { + $line = mknames ("norm", $confline, $ccds[$j]); + print FILE "$line\n"; + } + close (FILE); + + $confline = stconfig ($confline, "status", "running.scat"); + save_config (@list); + + $status = vsystem ("fixscat $file B.0 $ID"); + if (($status == 0) || ($status == 2 * 256)) { + $confline = stconfig ($confline, "status", "done.scat"); + } else { + $confline = stconfig ($confline, "status", "fail.scat"); + } + save_config (@list); + } + } + + foreach $confline (@list) { + $status = gtconfig ($confline, "status"); + if (($status ne "done.reg") && ($status ne "done.scat")) { next; } + $confline = stconfig ($confline, "status", "done"); + } + save_config (@list); + &goodbye; +} + +############## html modify ############### +sub mk_fixmasters { + if (@ARGV != 1) { &escape ("USAGE: mkdetrend fix.masters"); } + + @list = load_config (); + + foreach $name (@list) { + + @mstate = (); + $master = mknames ("master", $name, $ccds[0]); + print STDERR "$master: $name\n"; + open (FILE, $master); + @master = ; + close FILE; + for ($j = 0; $j < @master; $j++) { + ($tmp, $state) = split (" ", $master[$j]); + @mstate = (@mstate, $state); + } + + # re-create all masters to match master for chip 00 + for ($i = 1; $i < $Nccd; $i++) { + + # load existing master file + $master = mknames ("master", $name, $ccds[$i]); + open (FILE, $master); + @master = ; + close FILE; + + $Nm = @master; + $Ns = @mstate; + if (@mstate != @master) { + print STDOUT "error: mis-match in image lists ccd $i\n"; + &escape; + } + + # write results back to master file + open (OUT, ">$master") or die "can't open $master"; + for ($j = 0; $j < @master; $j++) { + ($fname, $state) = split (" ", $master[$j]); + if ($state != $mstate[$j]) { print STDERR "error on $j $name\n"; } + printf OUT "%s %d\n", $fname, $mstate[$j]; + } + close (OUT); + } + } + &goodbye; +} + +############## html modify ############### +sub mk_checksplits { + if (@ARGV != 2) { &escape ("USAGE: mkdetrend check.splits (config)"); } + + $Nconfig = $ARGV[1]; + @list = load_config (); + $name = $list[$Nconfig]; + + # re-create all masters to match master for chip 00 + for ($i = 0; $i < $Nccd; $i++) { + + # load existing master file + $master = mknames ("master", $name, $ccds[$i]); + open (FILE, $master); + @master = ; + close FILE; + + for ($j = 0; $j < @master; $j++) { + ($fname, $state) = split (" ", $master[$j]); + if (! -e $fname) { + print STDERR "missing file $fname\n"; + } + } + } + &goodbye; +} + +#### HTML cgibin functions ################ + +############## html duplicate ############### +sub mk_htmldup { + if (@ARGV != 2) { &escape ("USAGE: mkdetrend htmldup (config)"); } + + $config = $ARGV[1]; + # we are just calling the "mkdetrend dup" function and then calling "mkdetrend html1" + + system ("mkdetrend dup $config"); + print STDOUT "\n"; + + &goodbye; + +} + +############## html delete ############### +sub mk_htmldel { + if (@ARGV != 2) { &escape ("USAGE: mkdetrend htmldel (config.ver)"); } + + $config = $ARGV[1]; + # we are just calling the "mkdetrend del" function and then calling "mkdetrend html1" + + system ("mkdetrend del $config"); + print STDOUT "\n"; + + &goodbye;; + +} + +############## html define ############### +sub mk_htmldef { + if (@ARGV != 2) { &escape ("USAGE: mkdetrend htmldef (config.ver)"); } + + $key = $ARGV[1]; + + # find (config.ver) in list: + + @list = load_config (); + + $match = -1; + for ($i = 0; $i < @list; $i++) { + $version = gtconfig ($list[$i], "version"); + if ($key eq $version) { + $match = $i; + last; + } + } + if ($match == -1) { &escape ("error: can't find config entry"); } + + # show the complete list for reference + print STDOUT "
Elixir Mkdetrend Report
\n"; + print STDOUT "\n"; + print STDOUT "\n"; + for ($i = 0; $i < @list; $i++) { + $config = gtconfig ($list[$i], "config"); + $version = gtconfig ($list[$i], "version"); + $status = gtconfig ($list[$i], "status"); + $from = gtconfig ($list[$i], "from"); + $to = gtconfig ($list[$i], "to"); + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + } + print STDOUT "
$version $from $to $status split delete redefine


\n"; + + $version = gtconfig ($list[$match], "version"); + $status = gtconfig ($list[$match], "status"); + $from = gtconfig ($list[$match], "from"); + $to = gtconfig ($list[$match], "to"); + print STDOUT "redefining $key:
\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "
$version $from $to $status
\n"; + + + # create a simple form for redefine: + print STDOUT "
\n"; + print STDOUT "start:
\n"; + print STDOUT "stop:
\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "
\n"; + print STDOUT "\n"; + + &goodbye;; + +} + +############## html modify ############### +sub mk_htmlmod { + if (@ARGV != 1) { &escape ("USAGE: mkdetrend htmlmod"); } + + $key = $ENV{'WWW_config'}; + $Nimage = $ENV{'WWW_Nimage'}; + + @list = load_config (); + + $match = -1; + for ($i = 0; $i < @list; $i++) { + $version = gtconfig ($list[$i], "version"); + if ($key eq $version) { + $match = $i; + last; + } + } + if ($match == -1) { &escape ("error: can't find config entry"); } + + # re-create $master to match selections + # depends on the format of data in the 'master' file + for ($i = 0; $i < $Nccd; $i++) { + + # load existing master file + $master = mknames ("master", $list[$match], $ccds[$i]); + open (FILE, $master); + @master = ; + close FILE; + + if ($Nimage != @master) { + print STDOUT "error: mis-match in image lists ccd $i\n"; + &escape; + } + + # write results back to master file + open (OUT, ">$master") or die "can't open $master"; + for ($j = 0; $j < @master; $j++) { + @tmpw = split (" ", $master[$j]); + $name = "WWW_image_$j"; + + $tmpw[1] = 0; + if ($ENV{$name} ne "") { $tmpw[1] = 1; } + printf OUT "%s %d\n", $tmpw[0], $tmpw[1]; + } + close (OUT); + } + # adjust the config file: convert status to 'modified' + $list[$match] = stconfig ($list[$match], "status", "modified"); + save_config (@list); + + print STDOUT "\n"; + &goodbye; +} + +############## html accept ############### +sub mk_htmlkeep { + if (@ARGV != 2) { &escape ("USAGE: mkdetrend htmlkeep (config.ver)"); } + + $key = $ARGV[1]; + @list = load_config (); + + $match = -1; + for ($i = 0; $i < @list; $i++) { + $version = gtconfig ($list[$i], "version"); + if ($key eq $version) { + $match = $i; + last; + } + } + if ($match == -1) { + print STDERR "error: can't find config entry\n"; + &escape; + } + + # adjust the config file: convert status to 'accepted' + $list[$match] = stconfig ($list[$match], "status", "accepted"); + save_config (@list); + + print STDOUT ""; + &goodbye; +} + +############## html config ############### +sub mk_htmlconfig { + if (@ARGV != 1) { &escape ("USAGE: mkdetrend htmlconfig"); } + + ## html headers + print STDOUT "
Elixir Mkdetrend Report
\n"; + print STDOUT "\n"; + + # create a simple form for redefine: + print STDOUT "
\n"; + if ($elconf) { + print STDOUT "enter new config:
\n"; + } else { + print STDOUT "enter new config:
\n"; + } + print STDOUT "\n"; + print STDOUT "
\n"; + print STDOUT "\n"; + + &goodbye; +} + +############## html level 1 ############### +sub mk_html1 { + if (@ARGV != 1) { &escape ("USAGE: mkdetrend html1"); } + + @list = load_config (); + + ## html headers + print STDOUT "
Elixir Mkdetrend Report
\n"; + print STDOUT "\n"; + + print STDOUT "\n"; + for ($i = 0; $i < @list; $i++) { + $config = gtconfig ($list[$i], "config"); + $version = gtconfig ($list[$i], "version"); + $from = gtconfig ($list[$i], "from"); + $to = gtconfig ($list[$i], "to"); + $status = gtconfig ($list[$i], "status"); + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + } + + print STDOUT "
$version $from $to $status split delete redefine


\n"; + if ($elconf eq "") { + print STDOUT "Current Config: default
\n"; + } else { + print STDOUT "Current Config: $elconf
\n"; + } + print STDOUT "Change Config\n"; + print STDOUT "\n"; + &goodbye;; +} + +############## html level 2 ############### +sub mk_html2 { + if (@ARGV != 2) { &escape ("USAGE: mkdetrend html2 (config.ver)"); } + + @list = load_config (); + + # entry on line will be either config.ver (== key) or config.ver.col for sorting + # grab just the key portion + $status = "none"; + ($key) = $ARGV[1] =~ /(\w+.\w+.\w+.\w+)/; # (config.ver) + $arg = $ARGV[1]; + + # find appropriate config.ver entry: + for ($i = 0; $i < @list; $i++) { + $version = gtconfig ($list[$i], "version"); + if ($key eq $version) { + $confline = $list[$i]; + $status = gtconfig ($confline, "status"); + last; + } + } + + $from = gtconfig ($confline, "from"); + $to = gtconfig ($confline, "to"); + print STDOUT "
Elixir Mkdetrend Report
\n"; + print STDOUT "\n"; + print STDOUT "
\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "
config from to
$version $from $to
\n"; + + $master = mknames ("master", $confline, $ccds[0]); + + if ($status eq "modified") { flips_report ($arg, $confline, "modified"); } + if ($status eq "accepted") { flips_report ($arg, $confline, "accepted"); } + if ($status eq "done.merge") { flips_report ($arg, $confline, "merged"); } + # if ($status eq "done.update") { flips_report ($arg, $confline, "updated"); } + if ($status eq "done.reg") { flips_report_done ($key, $confline, "registered"); } + if ($status eq "clean") { flips_report ($key, $confline, "registered"); } + + if ($status eq "none") { $message = "not found"; } + if ($status eq "init") { $message = "initialized, not yet run."; } + if ($status eq "not.available") { $message = "has no images available for detrend creation."; } + + foreach $step (init, flips, norm, merge) { + if ($status eq "running.$step") { $message = "running step $step"; } + if ($status eq "fail.$step") { $message = "failed step $step"; } + if ($status eq "done.$step") { $message = "has finished $step"; } + } + + print STDOUT "config $key $message
\n"; + + print STDOUT "\n"; + open (FILE, "$master"); + while ($line = ) { + chop ($line); + @entry = split ("/", $line); + $N = @entry - 1; + print STDOUT "\n"; + } + print STDOUT "
$entry[$N]
\n"; + + print STDOUT "\n"; + &goodbye; +} + +############## html level 3 ############### +sub mk_html3 { + if (@ARGV != 2) { &escape ("USAGE: mkdetrend html3 (entry.config.ver)"); } + + @list = load_config (); + + # extract the entry and key values from $ARGV[1] + ($entry, $key) = $ARGV[1] =~ /(\d+)\Q.\E(.*)/; + + $status = "none"; + # find appropriate config.ver entry: + for ($i = 0; $i < @list; $i++) { + $version = gtconfig ($list[$i], "version"); + if ($key eq $version) { + $confline = $list[$i]; + $status = gtconfig ($confline, "status"); + last; + } + } + + print STDOUT "
Elixir Mkdetrend Report
\n"; + print STDOUT "\n"; + + if ($status eq "none") { print STDOUT "config $key not found\n \n"; &goodbye; } + if ($status eq "init") { print STDOUT "config $key initialized, not yet run\n \n"; &goodbye; } + if ($status eq "not.available") { print STDOUT "config $key has no images available for detrend creation\n \n"; &goodbye; } + + # if ($status eq "done.update") { flips_entry ($key, $entry, $confline); } + if ($status eq "done.merge") { flips_entry ($key, $entry, $confline); } + if ($status eq "accepted") { flips_entry ($key, $entry, $confline); } + if ($status eq "modified") { flips_entry ($key, $entry, $confline); } + if ($status eq "done.reg") { flips_entry ($key, $entry, $confline); } + + foreach $step (init, flips, norm, merge) { + # print "step: $step, $status: $status\n"; + if ($status eq "running.$step") { print STDOUT "config $key running step $step \n \n"; &goodbye; } + if ($status eq "fail.$step") { print STDOUT "config $key failed step $step\n \n"; &goodbye; } + + if ($status eq "done.$step") { + print STDOUT "config $key has finished $step\n"; + + # load image names from CCD 0 list: + $master = mknames ("master", $confline, $ccds[0]); + print STDOUT "\n"; + open (FILE, "$master"); + while ($line = ) { + chop ($line); + @entry = split ("/", $line); + $N = @entry - 1; + print STDOUT "\n"; + } + print STDOUT "
$entry[$N]
\n"; + } + } + + # print STDOUT "\n"; + &goodbye; +} + +### other support commands #################### + +############## evaluate chip run ############### +sub mk_eval { + if (@ARGV != 2) { &escape ("USAGE: mkdetrend eval (step)"); } + + $step = $ARGV[1]; + @list = load_config (); + + # load success fifo info: + $file = `gconfig -D mode mkdetrend global.success`; chop $file; + open (FILE, "$file"); + @success = ; + close (FILE); + + # load failure fifo info: + $file = `gconfig -D mode mkdetrend global.failure`; chop $file; + open (FILE, "$file"); + @failure = ; + close (FILE); + + # entry must be in state 'running.$step' + # possible states: + # 1 all 12 chips in success == done.$step + # 2 any chips in failure == fail.$step + # 3 any chips missing == fail.$step + # 4 any chips in failure, merge.list == not.available (only for $step eq init) + # valid steps: init flips norm + + CONFIG: + foreach $confline (@list) { + $status = gtconfig ($confline, "status"); + if ($status ne "running.$step") { next; } + $state = 1; + + CCD: + for ($j = 0; $j < $Nccd; $j++) { + $entry = gtconfig ($confline, "chiprun", $j); + + # search for entry in success fifo: + foreach $value (@success) { + if ($value =~ /^$entry/) { next CCD; } + } + + # search for entry in failure fifo: note the special ending state for 'init' + foreach $value (@failure) { + if ($value =~ /^$entry/) { + $state = 2; + if ($step eq "split") { + ($status) = $value =~ /$entry\s+\S+\s+(\S+)/; + if ($status eq "merge.lists") { + $state = 4; + } + } + last CCD; + } + } + + # if we make it here, it wasn't in either fifo.success or fifo.failure... + $state = 3; + last CCD; + } + + if ($state == 1) { $confline = stconfig ($confline, "status", "done.$step"); } + if ($state == 2) { $confline = stconfig ($confline, "status", "fail.$step"); } + if ($state == 3) { $confline = stconfig ($confline, "status", "fail.$step"); } + if ($state == 4) { $confline = stconfig ($confline, "status", "not.available"); } + } + save_config (@list); + + system ("mkdetrend state"); + &goodbye; +} + +############## evaluate mosaic run ############### +sub mk_meval { + if (@ARGV != 2) { &escape ("USAGE: mkdetrend meval (step)"); } + + $step = $ARGV[1]; + @list = load_config (); + + # load success fifo info: + $file = `gconfig -D mode mkdetrend global.success`; chop $file; + open (FILE, "$file"); + @success = ; + close (FILE); + + # load failure fifo info: + $file = `gconfig -D mode mkdetrend global.failure`; chop $file; + open (FILE, "$file"); + @failure = ; + close (FILE); + + # entry must be in state 'running.$step' + # possible states: + # 1 entry in success == done.$step + # 2 entry in failure == fail.$step + # 3 entry missing == fail.$step + # valid steps: merge + + foreach $confline (@list) { + $status = gtconfig ($confline, "status"); + if ($status ne "running.$step") { next; } + $state = 3; + $entry = gtconfig ($confline, "mosaic"); + + MCHECK: + { + foreach $value (@success) { + if ($value =~ /^$entry/) { + $state = 1; + last MCHECK; + } + } + + foreach $value (@failure) { + if ($value =~ /^$entry/) { + $state = 2; + next MCHECK; + } + } + } + + if ($state == 1) { $confline = stconfig ($confline, "status", "done.$step"); } + if ($state == 2) { $confline = stconfig ($confline, "status", "fail.$step"); } + if ($state == 3) { $confline = stconfig ($confline, "status", "fail.$step"); } + } + + save_config (@list); + system ("mkdetrend state"); + + &goodbye; +} + +############## html for dads ############### +sub mk_dads { + if (@ARGV != 2) { &escape ("USAGE: mkdetrend dads (config.ver)"); } + + # options: mkdetrend dads (config.ver) + # return all relevant images (jpegs) for given config.ver + + @list = load_config (); + + # entry on line will be either config.ver (== key) or config.ver.col for sorting + # grab just the key portion + $status = "none"; + $arg = $ARGV[1]; + ($key) = $arg =~ /(\w+.\w+.\w+.\w+)/; # (config.ver) + + # find appropriate config.ver entry: + for ($i = 0; $i < @list; $i++) { + $version = gtconfig ($list[$i], "version"); + if ($key eq $version) { + $confline = $list[$i]; + $status = gtconfig ($confline, "status"); + last; + } + } + if (!$confline) { &escape ("$key not found"); } + + # only print for config.ver entries which are ready (done, clean) + if (($status ne "done") && ($status ne "clean")) { + &escape ("$version is not ready for release by Elixir"); + } + + # parse config entry and get data from appropriate files + $from = gtconfig ($confline, "from"); + $to = gtconfig ($confline, "to"); + open (STAT, mknames ("stats", $confline)); @statdata = ; close (STAT); + open (MED, mknames ("medbin", $confline)); @medndata = ; close (MED); + open (TEN, mknames ("tenbin", $confline)); @tenndata = ; close (TEN); + open (MASTER, mknames ("master", $confline, $ccds[0])); @mastdata = ; close (MASTER); + + $tmpname = mknames ("master", $confline, $ccds[0]); + + # get stats from the stats & master files + $Nkeep = 0; + $Ncnt = 0; + $Sigma = 0; + $Nimage = @statdata; + for ($i = 0; $i < $Nimage; $i++) { + @tmpw = split (" ", $mastdata[$i]); + @tmps = split (" ", $statdata[$i]); + if ($tmpw[1]) { $Nkeep++; $Ncnt += $tmps[3]; $Sigma += $tmps[8]*$tmps[8]; } + } + $imbin = mknames ("dads.imbin", $confline); + + ($start, $stop, $mode) = &load_dates; + print STDOUT "$imbin $Nimage $start $stop\n"; + + $dir = mkfiles ("html"); + # create the image-by-image table lines + for ($i = 0; $i < $Nimage; $i++) { + @word = split (" ", $statdata[$i]); + $used = $word[12]; + $dawn = $word[11]; + + @tmpw = split (" ", $mastdata[$i]); + $keep = $tmpw[1]; + + # data files contain the complete path, but this may have changed + # replace path with mkfiles ("html") -> $dir + @tmpw = split ('/', $tenndata[$i]); + $tenimg = "$dir/$tmpw[-1]"; chop $tenimg; + @tmpw = split ('/', $medndata[$i]); + $medimg = "$dir/$tmpw[-1]"; chop $medimg; + + print STDOUT "$tenimg $medimg $word[0] $word[1] $dawn $word[2] $word[3] $word[5] $word[6] $word[8] $used\n"; + } + &goodbye; +} + +############## html for dads ############### +sub mk_dads_html { + if (@ARGV != 2) { &escape ("USAGE: mkdetrend dads (config.ver)"); } + + @list = load_config (); + + # entry on line will be either config.ver (== key) or config.ver.col for sorting + # grab just the key portion + $status = "none"; + $arg = $ARGV[1]; + ($key) = $arg =~ /(\w+.\w+.\w+.\w+)/; # (config.ver) + + # find appropriate config.ver entry: + for ($i = 0; $i < @list; $i++) { + $version = gtconfig ($list[$i], "version"); + if ($key eq $version) { + $confline = $list[$i]; + $status = gtconfig ($confline, "status"); + last; + } + } + + print STDOUT "
Elixir Mkdetrend Report
\n"; + print STDOUT "\n"; + + # only print for config.ver entries which are ready + if ($status ne "done.reg") { &escape ("$version is not ready for release by Elixir"); } + + # parse config entry and get data from appropriate files + $from = gtconfig ($confline, "from"); + $to = gtconfig ($confline, "to"); + open (STAT, mknames ("stats", $confline)); @statdata = ; close (STAT); + open (MED, mknames ("medbin", $confline)); @medndata = ; close (MED); + open (TEN, mknames ("tenbin", $confline)); @tenndata = ; close (TEN); + open (MASTER, mknames ("master", $confline, $ccds[0])); @mastdata = ; close (MASTER); + + $tmpname = mknames ("master", $confline, $ccds[0]); + + # get stats from the stats & master files + $Nkeep = 0; + $Ncnt = 0; + $Sigma = 0; + $Nimage = @statdata; + for ($i = 0; $i < $Nimage; $i++) { + @tmpw = split (" ", $mastdata[$i]); + @tmps = split (" ", $statdata[$i]); + if ($tmpw[1]) { $Nkeep++; $Ncnt += $tmps[3]; $Sigma += $tmps[8]*$tmps[8]; } + } + $Sigma = sprintf "%5.3f", 100*sqrt ($Sigma/$Nkeep); + + print STDOUT "
\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "
config from to
$version $from $to
\n"; + + $imbin = mknames ("dads.imbin", $confline); + print STDOUT "
\n"; + print STDOUT "this config has been created by Elixir.
\n"; + print STDOUT "there are $Nimage images, $Nkeep used.
\n"; + print STDOUT "Total Counts: $Ncnt
r.m.s. median sigma: $Sigma%

\n"; + print STDOUT "
\n"; + + print STDOUT "
Statistics on each available input image.
+ Time is in UT, light background means dawn, grey means dusk.\n"; + + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + + # sort the list by image seq number + @order = (); + for ($i = 0; $i < $Nimage; $i++) { @order = (@order, $i); } + $col = 0; + @entry = sort by_col @order; + + # create the image-by-image table lines + for ($i = 0; $i < $Nimage; $i++) { + $N = $entry[$i]; + + @word = split (" ", $statdata[$N]); + $used = $word[12]; + $dawn = $word[11]; + + @tmpw = split (" ", $mastdata[$N]); + $keep = $tmpw[1]; + + @tmpw = split ("/", $medndata[$N]); + $medname = $tmpw[-1]; + + @tmpw = split ("/", $tenndata[$N]); + $tenname = $tmpw[-1]; + + print STDOUT "\n"; + if ($dawn) { print STDOUT "\n"; } + else { print STDOUT "\n"; } + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + if ($used) { print STDOUT "\n"; } + else { print STDOUT "\n"; } + print STDOUT "\n\n"; + } + + print STDOUT "
image Date Time Mean Sigma (raw) Sigma (clipped) Sigma (med) image used?
$word[0] $word[1] $word[2] $word[2] $word[3] $word[5] $word[6] $word[8] yesno
\n"; + &goodbye; +} + +############## dads level 1 ############### +sub mk_dads_top { + if (@ARGV != 1) { &escape ("USAGE: mkdetrend dads.top"); } + + @list = load_config (); + + ## html headers + print STDOUT "
Elixir Mkdetrend Report
\n"; + print STDOUT "\n"; + + print STDOUT "\n"; + for ($i = 0; $i < @list; $i++) { + $config = gtconfig ($list[$i], "config"); + $version = gtconfig ($list[$i], "version"); + $from = gtconfig ($list[$i], "from"); + $to = gtconfig ($list[$i], "to"); + $status = gtconfig ($list[$i], "status"); + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + } + + print STDOUT "
$version $from $to $status
\n"; + &goodbye;; + +} + +sub by_col { + @word = split (" ", $statdata[$a]); $va = $word[$col]; + @word = split (" ", $statdata[$b]); $vb = $word[$col]; + $va <=> $vb; +} + +sub flips_report { + + $col = 0; + ($config) = $_[0] =~ /(\w+.\w+.\w+)/; + ($key) = $_[0] =~ /(\w+.\w+.\w+.\w+)/; # (config.ver) + + # look for optional sort key (config.ver[.key]) + if ($_[0] =~ /$key.(\d+)/) { + ($col) = $_[0] =~ /$key.(\d+)/; + } else { + $col = 0; + } + + $line = $_[1]; + $message = $_[2]; + + open (FILE, mknames ("stats", $line)); @statdata = ; close (FILE); + open (FILE, mknames ("medbin", $line)); @medndata = ; close (FILE); + open (FILE, mknames ("master", $line, $ccds[0])); @mastdata = ; close (FILE); + + $Nkeep = 0; + $Ncnt = 0; + $Sigma = 0; + $Nimage = @statdata; + for ($i = 0; $i < $Nimage; $i++) { + @tmpw = split (" ", $mastdata[$i]); + @tmps = split (" ", $statdata[$i]); + if ($tmpw[1]) { $Nkeep++; $Ncnt += $tmps[3]; $Sigma += $tmps[8]*$tmps[8]; } + } + if ($Nkeep > 0) { + $Sigma = sprintf "%5.3f", 100*sqrt ($Sigma/$Nkeep); + } else { + $Sigma = 100.0; + } + + $imbin = mknames ("imbin", $line); + print STDOUT "
\n"; + print STDOUT "this config has been $message.
\n"; + print STDOUT "there are $Nimage images, $Nkeep used.
\n"; + print STDOUT "Total Counts: $Ncnt
r.m.s. median sigma: $Sigma%

\n"; + print STDOUT "you have the following choices:
\n"; + print STDOUT " return to top level
\n"; + print STDOUT " split config
\n"; + print STDOUT " accept config
\n"; + print STDOUT "
\n"; + + print STDOUT "
\n"; + + print STDOUT "
Statistics on each available input image.
+ Time is in UT, light background means dawn, grey means dusk. Click + on the column heading to sort by that entry\n"; + + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n\n"; + + @order = (); + for ($i = 0; $i < $Nimage; $i++) { @order = (@order, $i); } + + @entry = sort by_col @order; + + for ($i = 0; $i < $Nimage; $i++) { + $N = $entry[$i]; + + @word = split (" ", $statdata[$N]); + $used = $word[12]; + $dawn = $word[11]; + + @tmpw = split (" ", $mastdata[$N]); + $keep = $tmpw[1]; + + @tmpw = split ("/", $medndata[$N]); + $medname = $tmpw[-1]; + + # $sig1 = sprintf "%5.3f", $word[4]; + # $sig2 = sprintf "%5.3f", $word[5]; + # $sig3 = sprintf "%5.3f", $word[6]; + # $sig4 = sprintf "%5.3f", $word[7]; + # $mean = sprintf "%8.1f", $word[3]; + + print STDOUT "\n"; + if ($dawn) { print STDOUT "\n"; } + else { print STDOUT "\n"; } + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + if ($used) { print STDOUT "\n"; } + else { print STDOUT "\n"; } + if ($keep) { print STDOUT "\n\n"; } + else { print STDOUT "\n\n"; } + + } + + print STDOUT "
image Date Time Mean Sigma (raw) Sigma (clipped) Sigma (med) image used? keep?
$word[0] $word[1] $word[2] $word[2] $word[3] $word[5] $word[6] $word[8] \n"; + print STDOUT "yesno
\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + # print STDOUT "
\n"; + print STDOUT "stop:
\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "
\n"; + print STDOUT "\n"; + + &goodbye; +} + +############## html modify ############### +sub mk_htmlmod { + + if (@ARGV != 1) { &escape ("USAGE: mkfringe htmlmod"); } + + # images which are marked for exclusion are included in the + # environment variable as $WWW_image_NN -- NN = sequence number + # in the master / defringe file + + $key = $ENV{'WWW_config'}; + $Nimage = $ENV{'WWW_Nimage'}; + + @list = load_config (); + + $match = -1; + for ($i = 0; $i < @list; $i++) { + $version = gtconfig ($list[$i], "version"); + if ($key eq $version) { + $match = $i; + last; + } + } + if ($match == -1) { &escape ("ERROR: can't find config entry"); } + + # change status entry in master list & $HTML.imstats + $HTML = mkfiles ("html"); + $imstat = "$HTML/$version.imstats"; + $master = mknames ("master", $list[$match]); + + # load data from master list + open (FILE, "$master"); + @master = ; + close (FILE); + if ($Nimage != @master) { &escape ("mis-match in image list lengths"); } + + # load data from imstats list + open (FILE, "$imstat"); + @imstat = ; + close (FILE); + if ($Nimage != @imstat) { &escape ("mis-match in image list lengths"); } + + for ($i = 0; $i < @master; $i++) { + chop ($master[$i]); + chop ($imstat[$i]); + ($path, $root, $mode, $status) = split (" ", $master[$i]); + $name = "WWW_image_$i"; + $newstatus = $status; + if ($ENV{$name} eq "") { + $hstatus = 0; + if (($status == 0) || ($status == 1)) { $newstatus = 0; } + if (($status == 2) || ($status == 3)) { $newstatus = 2; } + } else { + $hstatus = 1; + if (($status == 0) || ($status == 1)) { $newstatus = 1; } + if (($status == 2) || ($status == 3)) { $newstatus = 3; } + } + $master[$i] = "$path $root $mode $newstatus"; + ($line, $status) = $imstat[$i] =~ m|(\s*\S+\s+\S+\s+\S+\s+\S+\s+\S+\s+\S+\s+\S+\s+\S+\s+\S+\s+\S+\s+)(\S)|; + $imstat[$i] = "$line $hstatus"; + } + + # save master list + open (FILE, ">$master"); + foreach $line (@master) { print FILE "$line\n"; } + close (FILE); + + # save imstats list + open (FILE, ">$imstat"); + foreach $line (@imstat) { print FILE "$line\n"; } + close (FILE); + + print STDOUT "\n"; + + # adjust the config file: convert status to 'modified' + $list[$match] = stconfig ($list[$match], "status", "modified"); + save_config (@list); + &goodbye; + +} + +############## html changes modes ############### +sub mk_htmlmodes { + + if (@ARGV != 1) { &escape ("USAGE: mkfringe htmlmodes"); } + + # modes which are marked for exclusion are included in the + # environment variable as $WWW_mode_NN -- NN = sequence number + + $key = $ENV{'WWW_config'}; + $Nmode = $ENV{'WWW_Nmode'}; + + @list = load_config (); + + $match = -1; + for ($i = 0; $i < @list; $i++) { + $version = gtconfig ($list[$i], "version"); + if ($key eq $version) { + $match = $i; + last; + } + } + if ($match == -1) { &escape ("ERROR: can't find config entry"); } + + $modelist = mknames ("modelist", $list[$match]); + open (FILE, "$modelist"); + @inlist = ; + close (FILE); + + open (FILE, ">$modelist"); + for ($i = 0; $i < @inlist; $i++) { + ($N, $status) = split (" ", $inlist[$i]); + if ($i < $Nmode) { + $name = "WWW_mode_$i"; + $newstatus = $status; + if ($ENV{$name} eq "") { + $newstatus = 0; + } else { + $newstatus = 1; + } + } else { + $newstatus = 0; + } + print FILE "$i $newstatus\n"; + } + close (FILE); + + print STDOUT "\n"; + + # adjust the config file: convert status to 'modified' + $list[$match] = stconfig ($list[$match], "status", "modified.map"); + save_config (@list); + &goodbye; +} + +############## html changes modes ############### +sub mk_htmlmaps { + + if (@ARGV != 1) { &escape ("USAGE: mkfringe htmlmaps"); } + + # maps which are marked for inclusion are given in the + # environment variable as $WWW_mode_NN -- NN = sequence number + + $key = $ENV{'WWW_config'}; + $Nmaps = $ENV{'WWW_Nmaps'}; + + @list = load_config (); + + $match = -1; + for ($i = 0; $i < @list; $i++) { + $version = gtconfig ($list[$i], "version"); + if ($key eq $version) { + $match = $i; + last; + } + } + if ($match == -1) { &escape ("ERROR: can't find config entry"); } + + $maplist = mknames ("maplist", $list[$match]); + open (FILE, "$maplist"); + @inlist = ; + close (FILE); + + open (FILE, ">$maplist"); + for ($i = 0; $i < @inlist; $i++) { + ($Name, $status) = split (" ", $inlist[$i]); + $name = "WWW_map_$i"; + $newstatus = $status; + if ($ENV{$name} eq "") { + $newstatus = 0; + } else { + $newstatus = 1; + } + print FILE "$Name $newstatus\n"; + } + close (FILE); + + print STDOUT "\n"; + + # adjust the config file: convert status to 'modified' + $list[$match] = stconfig ($list[$match], "status", "modified.map"); + save_config (@list); + &goodbye; +} + +############## html accept ############### +sub mk_htmlkeep { + + if (@ARGV != 2) { &escape ("USAGE: mkfringe htmlkeep (config.ver)"); } + + $key = $ARGV[1]; + @list = load_config (); + + $match = -1; + for ($i = 0; $i < @list; $i++) { + $version = gtconfig ($list[$i], "version"); + if ($key eq $version) { + $match = $i; + last; + } + } + if ($match == -1) { &escape ("ERROR: can't find config entry"); } + + # adjust the config file: convert status to 'accepted' + $list[$match] = stconfig ($list[$match], "status", "accepted"); + save_config (@list); + + print STDOUT ""; + # print STDOUT "\n"; + &goodbye; +} + +############## html config ############### +sub mk_htmlconfig { + + if (@ARGV != 1) { &escape ("USAGE: mkdetrend htmlconfig"); } + + ## html headers + print STDOUT "
Elixir Mkdetrend Report
\n"; + print STDOUT "\n"; + + # create a simple form for redefine: + print STDOUT "
\n"; + if ($elconf) { + print STDOUT "enter new config:
\n"; + } else { + print STDOUT "enter new config:
\n"; + } + print STDOUT "\n"; + print STDOUT "
\n"; + print STDOUT "\n"; + + &goodbye; +} + +############## html level 1 ############### +sub mk_html1 { + + + if (@ARGV != 1) { &escape ("USAGE: mkfringe html1"); } + + @list = load_config (); + + ## html headers + print STDOUT "
Elixir Mkfringe Report
\n"; + print STDOUT "\n"; + + print STDOUT "\n"; + for ($i = 0; $i < @list; $i++) { + $config = gtconfig ($list[$i], "config"); + $version = gtconfig ($list[$i], "version"); + $from = gtconfig ($list[$i], "from"); + $to = gtconfig ($list[$i], "to"); + $status = gtconfig ($list[$i], "status"); + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + } + + print STDOUT "
$version $from $to $status split delete redefine

\n"; + if ($elconf eq "") { + print STDOUT "Current Config: default
\n"; + } else { + print STDOUT "Current Config: $elconf
\n"; + } + print STDOUT "Change Config\n"; + print STDOUT "\n"; + &goodbye; + +} + + + +############## html level 2 ############### +sub mk_html2 { + + if (@ARGV != 2) { + print STDERR "USAGE: mkfringe html2 (config.ver)\n"; + &goodbye; + } + + @list = load_config (); + + # entry on line will be either config.ver (== key) or config.ver.col for sorting + # grab just the key portion + $status = "none"; + ($key) = $ARGV[1] =~ /(\w+.\w+.\w+.\w+)/; # (config.ver) + $arg = $ARGV[1]; + + # find appropriate config.ver entry: + for ($i = 0; $i < @list; $i++) { + $version = gtconfig ($list[$i], "version"); + if ($key eq $version) { + $confline = $list[$i]; + $status = gtconfig ($confline, "status"); + last; + } + } + + $from = gtconfig ($confline, "from"); + $to = gtconfig ($confline, "to"); + print STDOUT "
Elixir Mkfringe Report
\n"; + print STDOUT "\n"; + print STDOUT "
\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "
config from to status
$version $from $to $status
\n"; + + if ($status eq "modified") { flips_report ($arg, $confline, "modified"); } + if ($status eq "accepted") { flips_report ($arg, $confline, "accepted"); } + if ($status eq "done.merge") { flips_report ($arg, $confline, "merged"); } + if ($status eq "done.prep") { flips_report ($arg, $confline, "prepped"); } + if ($status eq "done.reg") { flips_report ($key, $confline, "registered"); } + if ($status eq "done") { flips_report ($key, $confline, "done"); } + + if ($status eq "done.map") { map_report ($arg, $confline, "mapped"); } + if ($status eq "modified.map") { map_report ($arg, $confline, "mapped"); } + + if ($status eq "none") { $message = "not found"; } + if ($status eq "init") { $message = "initialized, not yet run."; } + if ($status eq "not.available") { $message = "has no images available for detrend creation."; } + + foreach $step (init, flips, norm, merge) { + if ($status eq "running.$step") { $message = "running step $step"; } + if ($status eq "fail.$step") { $message = "failed step $step"; } + if ($status eq "done.$step") { $message = "has finished $step"; } + } + + print STDOUT "config $key $message
\n"; + + $master = mknames ("master", $confline); + print STDOUT "\n"; + open (FILE, "$master"); + while ($line = ) { + chop ($line); + @entry = split ("/", $line); + $N = @entry - 1; + print STDOUT "\n"; + } + print STDOUT "
$entry[$N]
\n"; + + # print STDOUT "\n"; + &goodbye; + print STDOUT "
"; +} + + + +############## html level 3 ############### +sub mk_html3 { + + if (@ARGV != 3) { + print STDERR "USAGE: mkfringe html3 (entry.config.ver) (mode)\n"; + &goodbye; + } + + @list = load_config (); + + # extract the entry and key values from $ARGV[1] + ($entry, $key) = $ARGV[1] =~ /(\d+)\Q.\E(.*)/; + $mode = $ARGV[2]; + + $status = "none"; + # find appropriate config.ver entry: + for ($i = 0; $i < @list; $i++) { + $version = gtconfig ($list[$i], "version"); + if ($key eq $version) { + $confline = $list[$i]; + $status = gtconfig ($confline, "status"); + last; + } + } + + print STDOUT "
Elixir Mkfringe Report
\n"; + print STDOUT "\n"; + + if ($status eq "none") { print STDOUT "config $key not found\n \n"; &goodbye; } + if ($status eq "init") { print STDOUT "config $key initialized, not yet run\n \n"; &goodbye; } + if ($status eq "not.available") { print STDOUT "config $key has no images available for detrend creation\n \n"; &goodbye; } + + if ($status eq "done.prep") { flips_entry ($key, $entry, $confline, $mode); } + if ($status eq "done.merge") { flips_entry ($key, $entry, $confline, $mode); } + if ($status eq "accepted") { flips_entry ($key, $entry, $confline, $mode); } + if ($status eq "modified") { flips_entry ($key, $entry, $confline, $mode); } + if ($status eq "done.reg") { flips_entry ($key, $entry, $confline, $mode); } + if ($status eq "done") { flips_entry ($key, $entry, $confline, $mode); } + + foreach $step (init, flips, norm, merge) { + # print "step: $step, $status: $status\n"; + if ($status eq "running.$step") { print STDOUT "config $key running step $step \n \n"; &goodbye; } + if ($status eq "fail.$step") { print STDOUT "config $key failed step $step\n \n"; &goodbye; } + + if ($status eq "done.$step") { + print STDOUT "config $key has finished $step\n"; + + # load image names from CCD 0 list: + $master = mknames ("master", $confline, "00"); + print STDOUT "\n"; + open (FILE, "$master"); + while ($line = ) { + chop ($line); + @entry = split ("/", $line); + $N = @entry - 1; + print STDOUT "\n"; + } + print STDOUT "
$entry[$N]
\n"; + } + } + + # print STDOUT "\n"; + &goodbye; +} + +$dadswww = "img"; + + +############## html for dads ############### +sub mk_dads { + + if (@ARGV != 2) { + print STDERR "USAGE: mkfringe dads (config.ver)\n"; + &goodbye; + } + + @list = load_config (); + + # entry on line will be either config.ver (== key) or config.ver.col for sorting + # grab just the key portion + $status = "none"; + $arg = $ARGV[1]; + ($key) = $arg =~ /(\w+.\w+.\w+.\w+)/; # (config.ver) + + # find appropriate config.ver entry: + for ($i = 0; $i < @list; $i++) { + $version = gtconfig ($list[$i], "version"); + if ($key eq $version) { + $confline = $list[$i]; + $status = gtconfig ($confline, "status"); + last; + } + } + + print STDOUT "
Elixir Mkfringe Report
\n"; + print STDOUT "\n"; + + # only print for config.ver entries which are ready + if ($status ne "done") { + &escape ("$version is not ready for release by Elixir"); + } + + # parse config entry and get data from appropriate files + $from = gtconfig ($confline, "from"); + $to = gtconfig ($confline, "to"); + open (STAT, mknames ("stats", $confline)); @statdata = ; close (STAT); + open (MED, mknames ("medbin", $confline)); @medndata = ; close (MED); + open (TEN, mknames ("tenbin", $confline)); @tenndata = ; close (TEN); + open (MASTER, mknames ("master", $confline, 0)); @mastdata = ; close (MASTER); + + $tmpname = mknames ("master", $confline, 0); + + # get stats from the stats & master files + $Nkeep = 0; + $Ncnt = 0; + $Sigma = 0; + $Nimage = @statdata; + for ($i = 0; $i < $Nimage; $i++) { + @tmpw = split (" ", $mastdata[$i]); + @tmps = split (" ", $statdata[$i]); + if ($tmpw[1]) { $Nkeep++; $Ncnt += $tmps[3]; $Sigma += $tmps[8]*$tmps[8]; } + } + $Sigma = sprintf "%5.3f", 100*sqrt ($Sigma/$Nkeep); + + print STDOUT "
\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "
config from to
$version $from $to
\n"; + + $imbin = mknames ("dads.imbin", $confline); + print STDOUT "
\n"; + print STDOUT "this config has been created by Elixir.
\n"; + print STDOUT "there are $Nimage images, $Nkeep used.
\n"; + print STDOUT "Total Counts: $Ncnt
r.m.s. median sigma: $Sigma%

\n"; + print STDOUT "
\n"; + + print STDOUT "
Statistics on each available input image.
+ Time is in UT, light background means dawn, grey means dusk.\n"; + + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + + # sort the list by image seq number + @order = (); + for ($i = 0; $i < $Nimage; $i++) { @order = (@order, $i); } + $col = 0; + @entry = sort by_col @order; + + # create the image-by-image table lines + for ($i = 0; $i < $Nimage; $i++) { + $N = $entry[$i]; + + @word = split (" ", $statdata[$N]); + $used = $word[12]; + $dawn = $word[11]; + + @tmpw = split (" ", $mastdata[$N]); + $keep = $tmpw[1]; + + @tmpw = split ("/", $medndata[$N]); + $medname = $tmpw[-1]; + + @tmpw = split ("/", $tenndata[$N]); + $tenname = $tmpw[-1]; + + print STDOUT "\n"; + if ($dawn) { print STDOUT "\n"; } + else { print STDOUT "\n"; } + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + if ($used) { print STDOUT "\n"; } + else { print STDOUT "\n"; } + print STDOUT "\n\n"; + } + + print STDOUT "
image Date Time Mean Sigma (raw) Sigma (clipped) Sigma (med) image used?
$word[0] $word[1] $word[2] $word[2] $word[3] $word[4] $word[6] $word[8] yesno
\n"; + &goodbye; +} + + + +############## html level 1 ############### +sub mk_dads_top { + + if (@ARGV != 1) { + print STDERR "USAGE: mkfringe dads.top\n"; + &goodbye; + } + + @list = load_config (); + + ## html headers + print STDOUT "
Elixir Mkfringe Report
\n"; + print STDOUT "\n"; + + print STDOUT "\n"; + for ($i = 0; $i < @list; $i++) { + $config = gtconfig ($list[$i], "config"); + $version = gtconfig ($list[$i], "version"); + $from = gtconfig ($list[$i], "from"); + $to = gtconfig ($list[$i], "to"); + $status = gtconfig ($list[$i], "status"); + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + } + + print STDOUT "
$version $from $to $status
\n"; + &goodbye; + +} + +sub by_col { + @word = split (" ", $statdata[$a]); $va = $word[$col]; + @word = split (" ", $statdata[$b]); $vb = $word[$col]; + $va <=> $vb; +} + +sub flips_report { + + $col = 0; + ($config) = $_[0] =~ /(\w+.\w+.\w+)/; + ($key) = $_[0] =~ /(\w+.\w+.\w+.\w+)/; # (config.ver) + + # look for optional sort key (config.ver[.key]) + if ($_[0] =~ /$key.(\d+)/) { + ($col) = $_[0] =~ /$key.(\d+)/; + } else { + $col = 0; + } + + $line = $_[1]; + $message = $_[2]; + + # list files: VERSION.imstats, VERSION.med.medbin.list, VERSION.med.tenbin.list, VERSION.def.medbin.list VERSION.def.tenbin.list + + $root = mknames ("htmlroot", $line); + open (FILE, "$root.imstats"); @statdata = ; close (FILE); + open (FILE, "$root.med.medbin.list"); @meddata = ; close (FILE); + open (FILE, "$root.def.medbin.list"); @defdata = ; close (FILE); + +# format of statdata file: +# OBS DATE TIME SKY FLUX FR1 dFR1 FR2 dFR2 stat keep +# 606363 2001-10-09 10:21:15.62 12455.7 20.76 246.9 84.0 N/A N/A 1 1 + + $Nkeep = 0; + $Ncnt = 0; + $Resid = 0; + $fResid = 0; + $Nimage = @statdata; + for ($i = 0; $i < $Nimage; $i++) { + @tmp = split (" ", $statdata[$i]); + if ($tmp[9]) { $Nkeep++; $Ncnt += $tmp[3]; } + $Resid += $tmp[8]; + $fResid += $tmp[8] / $tmp[3]; + } + if ($Nimage > 0) { $Resid = $Resid / $Nimage; } + if ($Nimage > 0) { $fResid = $fResid / $Nimage; } + $Resid = sprintf "%7.3f", $Resid; + $fResid = sprintf "%7.3f", $fResid; + + # $imbin = mknames ("dads.imbin", $line); + print STDOUT ""; + if (-e "$root.medbin.jpg") { + @tmpw = split ("/", "$root.medbin.jpg"); + $imname = "$www/$tmpw[-1]"; + print STDOUT "\n"; + } + print STDOUT "
\n"; + print STDOUT "this config has been $message.
\n"; + print STDOUT "there are $Nimage images, $Nkeep used.
\n"; + print STDOUT "Total Counts: $Ncnt
\n"; + print STDOUT "Median residual scatter: $Resid
\n"; + print STDOUT "Median fractional residual: $fResid

\n"; + print STDOUT "you have the following choices:
\n"; + print STDOUT " return to top level
"; + print STDOUT " split config
"; + print STDOUT " accept config
\n"; + + print STDOUT "
\n"; + print STDOUT "
Statistics on each available input image.
\n"; + print STDOUT "Time is in UT. Click on the column heading to sort by that entry\n"; + + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n\n"; + + @order = (); + for ($i = 0; $i < $Nimage; $i++) { @order = (@order, $i); } + + @entry = sort by_col @order; + + for ($i = 0; $i < $Nimage; $i++) { + $N = $entry[$i]; + + @word = split (" ", $statdata[$N]); + $used = $word[9]; + $keep = $word[10]; + + @tmpw = split ("/", $meddata[$N]); + $medname = $tmpw[-1]; + @tmpw = split ("/", $defdata[$N]); + $defname = $tmpw[-1]; + + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + if ("$defname" ne "") { + print STDOUT "\n"; + } else { + print STDOUT "\n"; + } + if ($used) { print STDOUT "\n"; } + else { print STDOUT "\n"; } + if ($keep) { print STDOUT "\n\n"; } + else { print STDOUT "\n\n"; } + + } + + print STDOUT "
image Date Time Sky Flux Fringe dFringe Resid dResid F image R image used? keep?
$word[0] $word[1] $word[2] $word[3] $word[4] $word[5] $word[6] $word[7] $word[8] N/A yesno
\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "
\n"; + + print STDOUT "
\n"; + print STDOUT "Fringe Correlation Plot
\n"; + if (-e "$root.stats.png") { + @tmpw = split ("/", "$root.stats.png"); + $imname = "$www/$tmpw[-1]"; + print STDOUT "\n"; + } + print STDOUT "
\n"; + + print STDOUT "\n"; + &goodbye; + +} + +sub flips_report_done { + + ($config) = $_[0] =~ /(\w+.\w+.\w+)/; + ($key) = $_[0] =~ /(\w+.\w+.\w+.\w+)/; # (config.ver) + $line = $_[1]; + + open (STAT, mknames ("stats", $line)); + open (MED, mknames ("medbin", $line)); + open (MASTER, mknames ("master", $line, 0)); + + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n\n"; + + for ($i = 0; $line = ; $i++) { + + chop ($line); + # print STDOUT "$line
\n"; + @word = split (" ",$line); + $used = $word[12]; + $dawn = $word[11]; + + $line = ; + chop ($line); + # print STDOUT "$line
\n"; + @tmpw = split (" ",$line); + $keep = $tmpw[1]; + + # mkfringe works with files in the user's paths, but the web page needs + # to work with files visible to the web server + $line = ; + chop ($line); + @tmpw = split ("/", $line); + $N = @tmpw - 1; + $medname = $tmpw[$N]; + + $sig1 = sprintf "%5.3f", $word[4]; + $sig2 = sprintf "%5.3f", $word[5]; + $sig3 = sprintf "%5.3f", $word[6]; + $sig4 = sprintf "%5.3f", $word[7]; + $mean = sprintf "%8.1f", $word[3]; + + print STDOUT "\n"; + if ($dawn) { print STDOUT "\n"; } + else { print STDOUT "\n"; } + print STDOUT "\n"; + print STDOUT "\n"; + if ($used) { print STDOUT "\n"; } + else { print STDOUT "\n"; } + } + $Nimage = $i; + + print STDOUT "
image Date Time Mean Sigma (raw) Sigma (clipped) Sigma (med) image used?
$word[0] $word[1] $word[2] $word[2] $word[3] $word[5] $word[6] $word[8] yesno
\n"; + print STDOUT "\n"; + + &goodbye; + +} + +sub flips_entry { + + my($version)= $_[0]; # version of desired entry + my($entry) = $_[1]; # desired entry in list + my($line) = $_[2]; # list of image stats + my($mode) = $_[3]; # 'def' or 'med' + + if (($mode ne "def") && ($mode ne "med")) { + print STDOUT "error in mkfringe mode\n"; + &goodbye; + } + + # load image & stat lists + $root = mknames ("htmlroot", $line); + open (FILE, "$root.imstats"); @statdata = ; close (FILE); + open (FILE, "$root.$mode.tenbin.list"); @meddata = ; close (FILE); + + $Nimage = @statdata; + if ($entry >= $Nimage) { + print STDOUT " selected entry out of range\n"; + &goodbye; + } + + $first = ($entry == 0); + $last = ($entry == $Nimage - 1); + $next = $entry + 1; + $prev = $entry - 1; + + $line = $statdata[$entry]; + chop ($line); + @word = split (" ",$line); + $used = $word[9]; + $keep = $word[10]; + + # mkfringe works with files in the user's paths, but the web page needs + # to work with files visible to the web server + $line = $meddata[$entry]; + chop ($line); + @tmpw = split ("/", $line); + $name = "$www/$tmpw[-1]"; + + print STDOUT "\n"; + print STDOUT "mode: $mode
\n"; + + print STDOUT "\n"; + + print STDOUT "\n"; + print STDOUT "\n"; + if (!$first) { print STDOUT "\n"; } + if (!$last) { print STDOUT "\n"; } + print STDOUT "
\n"; + print STDOUT "\n"; + print STDOUT "\n"; + if ($mode eq "med") { + print STDOUT "\n"; + } else { + print STDOUT "\n"; + } + print STDOUT "\n"; + if ($used) { + print STDOUT "\n"; + } else { + print STDOUT "\n"; + } + print STDOUT "\n\n"; + print STDOUT "
image Date Time Sky Flux Fringe dFringe Resid dResid used?
$word[0]
$word[0] $word[1] $word[2] $word[3] $word[4] $word[5] $word[6] $word[7] $word[8] yesno
\n"; + + print STDOUT "
return to config list
return to $version
goto prev image
goto next image
\n"; + + print STDOUT "\n"; + &goodbye; +} + +sub map_report { + + $col = 0; + ($config) = $_[0] =~ /(\w+.\w+.\w+)/; + ($key) = $_[0] =~ /(\w+.\w+.\w+.\w+)/; # (config.ver) + + # look for optional sort key (config.ver[.key]) + if ($_[0] =~ /$key.(\d+)/) { + ($col) = $_[0] =~ /$key.(\d+)/; + } else { + $col = 0; + } + + $line = $_[1]; + $message = $_[2]; + + open (LIST, mknames ("maplist", $line)); @mapdata = ; close (LIST); + open (LIST, mknames ("modelist", $line)); @modedata = ; close (LIST); + + open (LIST, mknames ("modesjpg", $line)); @modeslist = ; close (LIST); + open (LIST, mknames ("residjpg", $line)); @residlist = ; close (LIST); + foreach $name (@modeslist) { chop ($name); } + foreach $name (@residlist) { chop ($name); } + + print STDOUT "You have the following choices:
\n"; + print STDOUT " return to top level
"; + print STDOUT " accept config
"; + + print STDOUT "Modes avaliable for this config
\n"; + print STDOUT "
\n"; + # 4 x N table of possible modes + $MaxModes = 8; + print STDOUT "\n"; + for ($i = 0; $i < $MaxModes; $i++) { + if ((($i - 0) % 4) == 0) { print STDOUT "\n"; } + ($junk, $status) = split (" ", $modedata[$i]); + $name = sprintf "%s/%s", $www, $modeslist[$i]; + print STDOUT "\n"; + if ($status) { print STDOUT "\n"; } + else { print STDOUT "\n"; } + if ((($i - 3) % 4) == 0) { print STDOUT "\n"; } + } + print STDOUT "
\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "
\n"; + + # 2 x N table of image residuals + print STDOUT "Residual images
\n"; + print STDOUT "
\n"; + print STDOUT "\n"; + for ($i = 0; $i < @mapdata; $i++) { + if ((($i - 0) % 6) == 0) { print STDOUT "\n"; } + + ($name, $status) = split (" ", $mapdata[$i]); + @words = split ("/", $name); + $basename = $words[-1]; + $basename =~ s/.maplist$//; + + $imname = sprintf "%s/%s", $www, $residlist[$i]; + print STDOUT "\n"; + print STDOUT "\n"; + if ($status) { print STDOUT "\n"; } + else { print STDOUT "\n"; } + + if ((($i - 5) % 6) == 0) { print STDOUT "\n"; } + else { print STDOUT "\n"; } + + } + print STDOUT "
$basename
 
\n"; + $Nmaps = @mapdata; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "
\n"; + + &goodbye; + +} + +print STDOUT "error: invalid mkfringe command\n"; + +# run: $root/detrend.config - current run +# detdir: $det - directory for current run +# config: $det/fringe.config - config info for specific run, 1 line per setup +# dates: $det/dates.dat - dates for specific run +# list: $det/fringe.list - temporary list to pass to elixirs +# plist: $det/fringe.plist - list of files to process (detrend) for elixir +# proc: $det/proc - directory to store temporary processed images +# fringe: $det/fringe - directory to store data files +# html: $det/html - directory to store results for www +# www: $www/$run/html - html directory as seen by Web server + +#### TOOLS TO ABSTRACT FILENAMES ################################################################### + +# construct specific file names +sub mkfiles { + # in: (type) + my($type) = $_[0]; + my($value); + + { + if ($type eq "run") { + $value = "$root/fringe.config"; + last; + } + if ($type eq "detdir") { + $value = "$det"; + last; + } + if ($type eq "config") { + $value = "$det/fringe.config"; + last; + } + if ($type eq "dates") { + $value = "$det/dates.dat"; + last; + } + if ($type eq "list") { + $value = "$det/fringe.list"; + last; + } + if ($type eq "plist") { + $value = "$det/fringe.plist"; + last; + } + if ($type eq "proc") { + $value = "$det/proc"; + last; + } + if ($type eq "fringe") { + $value = "$det/fringe"; + last; + } + if ($type eq "html") { + $value = "$det/html"; + last; + } + if ($type eq "www") { + $value = "$www"; + last; + } + &escape ("unknown type for mkfiles"); + } + $value; +} + +# construct files from config info: +# CRUNID TYPE FILTER [CCD] VERSION START STOP STATE +#************************** + +sub mknames { + # in: (type) (config.ver) [ccd] + my ($type, $version, @words, $dir, $value, $ccd); + + $type = $_[0]; + $version = $_[1]; + @words = split (" ", $version); + $ccd = $_[2]; + + { + # list of fringe frames + if ($type eq "config") { + $dir = mkfiles ("fringe"); + $value = sprintf "$dir/$words[0].$words[1].$words[2].$words[3]"; + last; + } + # list of fringe frames + if ($type eq "frlist") { + $dir = mkfiles ("fringe"); + $value = sprintf "$dir/$words[0].$words[1].$words[2].$words[3].frlist"; + last; + } + # smoothed (final) fringe image + if ($type eq "smfile") { + $dir = mkfiles ("fringe"); + $value = sprintf "$dir/$words[0].$words[1].$words[2].$ccd.$words[3].sm.fits"; + last; + } + # master list of input images + if ($type eq "master") { + $dir = mkfiles ("fringe"); + $value = sprintf "$dir/$words[0].$words[1].$words[2].$words[3].master"; + last; + } + # list of image statistics files + if ($type eq "imstats") { + $dir = mkfiles ("fringe"); + $value = sprintf "$dir/$words[0].$words[1].$words[2].$words[3].imstats"; + last; + } + # list of image map lists + if ($type eq "maplist") { + $dir = mkfiles ("fringe"); + $value = sprintf "$dir/$words[0].$words[1].$words[2].$words[3].maplist"; + last; + } + # list of image map lists + if ($type eq "modelist") { + $dir = mkfiles ("fringe"); + $value = sprintf "$dir/$words[0].$words[1].$words[2].$words[3].mode.list"; + last; + } + # list of image map lists + if ($type eq "modefits") { + $dir = mkfiles ("fringe"); + $value = sprintf "$dir/$words[0].$words[1].$words[2].$words[3].mode.fits"; + last; + } + # list of image map lists + if ($type eq "modesave") { + $dir = mkfiles ("fringe"); + $value = sprintf "$dir/$words[0].$words[1].$words[2].$words[3].mode.mef.fits"; + last; + } + # mosaic fringe statistics file + if ($type eq "frstats") { + $dir = mkfiles ("fringe"); + $value = sprintf "$dir/$words[0].$words[1].$words[2].$words[3].frstats"; + last; + } + # images to be detrended + if ($type eq "detrend") { + $dir = mkfiles ("fringe"); + $value = sprintf "$dir/$words[0].$words[1].$words[2].$words[3].detrend"; + last; + } + # list of input image lists to defringe + if ($type eq "defringe") { + $dir = mkfiles ("fringe"); + $value = sprintf "$dir/$words[0].$words[1].$words[2].$words[3].defringe"; + last; + } + # file in HTML dir with all image stats + if ($type eq "htmlroot") { + $dir = mkfiles ("html"); + $value = "$dir/$words[0].$words[1].$words[2].$words[3]"; + last; + } + # file in HTML dir with all image stats + if ($type eq "stats") { + $dir = mkfiles ("html"); + $value = "$dir/$words[0].$words[1].$words[2].$words[3].stats"; + last; + } + # file in HTML dir with all medbin jpg image names (also root for images) + if ($type eq "modesjpg") { + $dir = mkfiles ("html"); + $value = "$dir/$words[0].$words[1].$words[2].$words[3].modes"; + last; + } + # file in HTML dir with all medbin jpg image names (also root for images) + if ($type eq "residjpg") { + $dir = mkfiles ("html"); + $value = "$dir/$words[0].$words[1].$words[2].$words[3].resid"; + last; + } + # file in HTML dir with all medbin jpg image names (also root for images) + if ($type eq "medbin") { + $dir = mkfiles ("html"); + $value = "$dir/$words[0].$words[1].$words[2].$words[3].medbin"; + last; + } + # file in HTML dir with all tenbin jpg image names (also root for images) + if ($type eq "tenbin") { + $dir = mkfiles ("html"); + $value = "$dir/$words[0].$words[1].$words[2].$words[3].tenbin"; + last; + } + # file in HTML dir with jpg image of fringe framge + if ($type eq "imbin") { + $dir = mkfiles ("html"); + $value = "$dir/$words[0].$words[1].$words[2].$words[3].imbin.jpg"; + last; + } + # file in WWW dir with jpg image of fringe framge + if ($type eq "dads.imbin") { + $dir = mkfiles ("www"); + $value = "$dir/$words[0].$words[1].$words[2].$words[3].imbin.jpg"; + last; + } + &escape ("unknown type for mknames: $type"); + } + return ($value); +} + +#### TOOLS TO INTERACT WITH FORMATED CONFIG FILE ##################################################### + +# parse config info +# CRUNID TYPE FILTER [CCD] VERSION START STOP STATE +#************************** +sub gtconfig { + my ($value, $type, @words, $ccd); + # in: (config line) (type) + @words = split (" ", $_[0]); + $type = $_[1]; + + { + if ($type eq "elixir") { + $value = "$words[0] $words[1] $words[2] $words[3] $words[4] $words[5]"; + last; + } + if ($type eq "chiprun") { + $ccd = $_[2]; + $value = "$words[0] $words[1] $words[2] $ccd $words[3] $words[4] $words[5]"; + last; + } + if ($type eq "config") { + $value = "$words[0].$words[1].$words[2]"; + last; + } + if ($type eq "filter") { + $value = "$words[2]"; + last; + } + if ($type eq "ID") { + $value = "$words[0]"; + last; + } + if ($type eq "version") { + $value = "$words[0].$words[1].$words[2].$words[3]"; + last; + } + if ($type eq "from") { + $value = "$words[4]"; + last; + } + if ($type eq "to") { + $value = "$words[5]"; + last; + } + if ($type eq "status") { + $value = "$words[6]"; + last; + } + &escape ("unknown type for gtconfig"); + } + + return $value; +} + +# set config value +# TYPE FILTER CRUNID VERSION START STOP STATE +# CRUNID TYPE FILTER [CCD] VERSION START STOP STATE +#************************** +sub stconfig { + # in: (config line) (value) (type) + my (@words) = split (" ", $_[0]); + my ($type) = $_[1]; + my ($value) = $_[2]; + my ($line); + + { + if ($type eq "all") { + $line = sprintf "%s %6s %4s %2d %s %s %s", $words[0], $words[1], $words[2], $words[3], $words[4], $words[5], $words[6]; + last; + } + if ($type eq "version") { + $line = sprintf "%s %6s %4s %2d %s %s %s", $words[0], $words[1], $words[2], $value, $words[4], $words[5], $words[6]; + last; + } + if ($type eq "start") { + $line = sprintf "%s %6s %4s %2d %s %s %s", $words[0], $words[1], $words[2], $words[3], $value, $words[5], $words[6]; + last; + } + if ($type eq "stop") { + $line = sprintf "%s %6s %4s %2d %s %s %s", $words[0], $words[1], $words[2], $words[3], $words[4], $value, $words[6]; + last; + } + if ($type eq "status") { + $line = sprintf "%s %6s %4s %2d %s %s %s", $words[0], $words[1], $words[2], $words[3], $words[4], $words[5], $value; + last; + } + &escape ("unknown type for stconfig"); + } + + return $line; +} + +# load dates & mode (returns @list) +sub load_dates { + my ($file, $line, @list); + my ($start, $stop); + + $file = mkfiles ("dates"); + @list = (); + open (FILE, "$file"); + @list = ; + close (FILE); + + ($tmp, $start) = split (" ", $list[0]); + if ($tmp ne "START") { print STDERR "dates file is confused\n"; } + + ($tmp, $stop) = split (" ", $list[1]); + if ($tmp ne "STOP") { print STDERR "dates file is confused\n"; } + + ($tmp, $mode) = split (" ", $list[2]); + if ($tmp ne "MODE") { print STDERR "dates file missing mode\n"; } + if ($mode eq "") { $mode = "hold"; } + + ($start, $stop, $mode); +} + +# write to dates file +sub save_dates { + # save_dates start stop auto.mode + my (@outlist) = @_; + + my ($file) = mkfiles ("dates"); + open (FILE, ">$file"); + print FILE "START $outlist[0]\n"; + print FILE "STOP $outlist[1]\n"; + print FILE "MODE $outlist[2]\n"; + close (FILE); +} + +# load config lines (returns @list) +sub load_config { + my ($file, $line, @list); + + $file = mkfiles ("config"); + @list = (); + open (FILE, "$file"); + while ($line = ) { + chop ($line); + @list = (@list, $line); + } + close (FILE); + + @list; +} + +# write to config file +sub save_config { + + my(@outlist) = sort @_; + + my($file) = mkfiles ("config"); + open (FILE, ">$file"); + for ($i = 0; $i < @outlist; $i++) { + print FILE "$outlist[$i]\n"; + } + close (FILE); + +} + +#### USEFUL TOOLS ################################################################################# + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + unlink $tmpenv; + exit 0; +} + +sub escape { + unlink $tmpenv; + print STDERR "$_[0]\n"; + exit 1; +} + +# grab complete configuration info from the elixir config system, +# applying appropriate command-line arguments +sub elixir_config { + my (@argv) = @_; + my ($opt, $config, @tmparg, $status); + $config = ""; + if ($ENV{'PTOLEMY'}) { $config = "-c $ENV{'PTOLEMY'}"; } + umask (0); + + # look for optional command-line arguments + @tmparg = @argv; + foreach (@tmparg) { + $value = shift @argv; + + if ($value eq "-c") { + $value = shift @argv; + $config = "-c $value"; + next; + } + + if ($value eq "-C") { + push @opt, $value; + $value = shift @argv; + push @opt, $value; + $elconf = $value; + next; + } + + if ($value eq "-C") { + push @opt, $value; + $value = shift @argv; + push @opt, $value; + $value = shift @argv; + push @opt, $value; + next; + } + + if ($value eq "-run") { + $run = shift @argv; + push @opt, "-D RUNID.MKFRINGE $run -D RUNID $run"; + next; + } + + if ($value eq "-camera") { + $camera = shift @argv; + push @opt, "-D CAMERA.MKFRINGE $camera -D CAMERA $camera"; + next; + } + push @argv, $value; + } + + # load RUNID from state.data (unless set on command line) + if ($run eq "") { + $run = `gconfig RUNID.MKFRINGE`; chop $run; + if ($?) { &escape ("run is not defined: use 'mkdetrend config' or 'mkrun sys'\n"); } + if ($run eq "") { &escape ("run is not defined: use 'mkdetrend config' or 'mkrun sys'\n"); } + push @opt, "-D RUNID.MKDETREND $run -D RUNID $run"; + } + + # load CAMERA from state.data (unless set on command line) + if ($camera eq "") { + $camera = `gconfig CAMERA.MKFRINGE`; chop $camera; + if ($?) { &escape ("camera is not defined: use 'mkrun sys' to set\n"); } + if ($camera eq "") { &escape ("camera is not defined: use 'mkrun sys'\n"); } + push @opt, "-D CAMERA.MKDETREND $camera -D CAMERA $camera"; + } + + # set env PTOLEMY using values from command line + $config = join (" ", $config, @opt); + $tmpenv = `mktemp /tmp/elixir.XXXXXX`; chop ($tmpenv); + $status = system ("gconfig -raw $config > $tmpenv"); + if ($status) { &escape ("error in elixir configuration: gconfig fails"); } + $ENV{'PTOLEMY'} = "$tmpenv"; + + # set global variables based on new config info + $root = `gconfig DETREND_ROOT`; chop $root; + if ($?) { &escape ("error with elixir configuration variable: DETREND_ROOT"); } + + $wwwroot = `gconfig DETREND_WWW`; chop $wwwroot; + if ($?) { &escape ("error with elixir configuration variable: DETREND_WWW"); } + + $Nccd = `cameraconfig -Nccd`; chop ($Nccd); + if ($?) { &escape ("error with elixir camera configuration"); } + + $answer = `cameraconfig -ccds`; + @ccds = split (" ", $answer); + if ($?) { &escape ("error with elixir camera configuration"); } + + # desired types: + @type = ('fringe', 'fringe'); + @filt = ('I', 'Z'); + + $CGI = `gconfig CGIBIN`; chop ($CGI); + if ($?) { &escape ("error with elixir configuration variable: CGIBIN"); } + + $det = "$root/$run"; + $www = "$wwwroot/$run/html"; + return (@argv); +} + +sub usage { + + if (@ARGV == 1) { + print STDERR "\n --- user modes ---\n"; + print STDERR "create (run) (startdate) (stopdate)\n"; + print STDERR "mkconfig\n"; + print STDERR "config (run)\n"; + print STDERR "init\n"; + print STDERR "run\n"; + print STDERR "list.runs\n"; + print STDERR "set (config.ver) (state)\n"; + print STDERR "reg\n"; + print STDERR "state \n"; + print STDERR "help \n"; + print STDERR "\n --- internal modes --- \n"; + print STDERR "flips\n"; + print STDERR "norm\n"; + print STDERR "update\n"; + print STDERR "merge\n"; + print STDERR "dup (config)\n"; + print STDERR "del (config)\n"; + print STDERR "def (config.ver) (start) (stop)\n"; + print STDERR "eval (step)\n"; + print STDERR "mevel (step)\n"; + print STDERR "htmldup\n"; + print STDERR "htmldel\n"; + print STDERR "htmldef\n"; + print STDERR "htmlmod\n"; + print STDERR "htmlkeep\n"; + print STDERR "html1\n"; + print STDERR "html2 (config.ver)\n"; + print STDERR "html3 (entry.config.ver)\n"; + &goodbye; + } + + if (@ARGV > 2) { print STDERR "USAGE: mkfringe (help) [mode]\n"; &goodbye; } + + if ($ARGV[1] eq "config") { + print STDERR "set up initial configuration\n"; + &goodbye; + } + + if ($ARGV[1] eq "save") { + print STDERR "save results from current configuration\n"; + &goodbye; + } + + print STDERR "help for $ARGV[1] not defined\n"; + &goodbye; +} + +#### overview ######## + +# init: create lists of possible images for each master type: +# 01Ak01.fringe.I.0.master (MOSAIC) + +# detrend: detrend the input images + +# files needed for html pages: + +# html/* +# fringe/*.master Index: /trunk/Ohana/src/perl/src/mkrun =================================================================== --- /trunk/Ohana/src/perl/src/mkrun (revision 17) +++ /trunk/Ohana/src/perl/src/mkrun (revision 17) @@ -0,0 +1,704 @@ +#!/usr/bin/env perl + +# check usage +if (@ARGV < 1) { + print STDOUT "USAGE: mkrun (mode) [arguments]\n"; + print STDOUT " mkrun help gives a complete list\n"; + &goodbye; +} +if ($ARGV[0] eq "help") { &usage; } + +# this should come fron the config system +$runlist = `gconfig RUN_LIST`; chop $runlist; +@runlist = (); + +# call appropriate command +if ($ARGV[0] eq "create") { &create; } +if ($ARGV[0] eq "delete") { &delete; } +if ($ARGV[0] eq "hstcreate") { &hstcreate; } +if ($ARGV[0] eq "addqso") { &addqso; } +if ($ARGV[0] eq "delqso") { &delqso; } +if ($ARGV[0] eq "comment") { &comment; } +if ($ARGV[0] eq "status") { &status; } +if ($ARGV[0] eq "state") { &status; } +if ($ARGV[0] eq "sys") { &sysfunc; } +if ($ARGV[0] eq "run") { &getrun; } +if ($ARGV[0] eq "date") { &getdate; } +if ($ARGV[0] eq "update") { &update; } +if ($ARGV[0] eq "test") { &test; } +if ($ARGV[0] eq "today") { &today; } + +print STDOUT "invalid mkrun command\n"; +exit 1; + +########################################################### + +###### +sub test { + + $date = mjd_to_date ($ARGV[1]); + print "$ARGV[1] : $date\n"; + exit 1; +} + +###### +sub sysfunc { + + $statedata = `gconfig STATE_DATA`; chop ($statedata); + if ($?) { die "can't find STATE_DATA\n"; } + + # show current state + if (@ARGV == 1) { + system ("cat $statedata"); + exit 0; + } + + if (@ARGV == 2) { + $var = "\U$ARGV[1]\E"; + if ($var eq "INIT") { goto initsys; } + if ($var eq "RUNID") { goto getsys; } + if ($var eq "PROCESS") { goto getsys; } + if ($var eq "NOTIFY") { goto getsys; } + if ($var =~ m|CAMERA.(\S+)|) { goto getsys; } + if ($var =~ m|RUNID.(\S+)|) { goto getsys; } + die "invalid sys parameter $var\n"; + + getsys: + open (FILE, "$statedata"); + @list = ; + close (FILE); + + foreach $line (@list) { + ($key, $value) = split (" ", $line); + $key = "\U$key\E"; + if ($key ne $var) { next; } + print STDOUT "$value\n"; + exit 0; + } + die "can't find entry $var\n"; + + initsys: + open (FILE, "$statedata"); + print FILE "# elixir current state\n"; + print FILE "\n"; + print FILE "RUNID 02Bk03\n"; + print FILE "PROCESS 02Bk03\n"; + print FILE "\n"; + print FILE "CAMERA.CURRENT none\n"; + print FILE "CAMERA.MKDETREND none\n"; + print FILE "CAMERA.MKFRINGE none\n"; + print FILE "CAMERA.POSTRUN none\n"; + print FILE "\n"; + print FILE "RUNID.CURRENT none\n"; + print FILE "RUNID.MKDETREND none\n"; + print FILE "RUNID.MKFRINGE none\n"; + print FILE "RUNID.POSTRUN none\n"; + print FILE "\n"; + print FILE "NOTIFY \n"; + close (FILE); + exit 0; + } + + if (@ARGV == 3) { + $var = "\U$ARGV[1]\E"; + $nval = $ARGV[2]; + if ($var eq "RUNID") { goto setsys; } + if ($var eq "PROCESS") { goto setsys; } + if ($var eq "NOTIFY") { goto setsys; } + if ($var =~ m|CAMERA.(\S+)|) { goto setsys; } + if ($var =~ m|RUNID.(\S+)|) { goto setsys; } + die "invalid sys parameter $var\n"; + + setsys: + open (FILE, "$statedata"); + @list = ; + close (FILE); + + $found = 0; + foreach $line (@list) { + ($key, $value) = split (" ", $line); + $key = "\U$key\E"; + if ($key ne $var) { next; } + $found = 1; + $line = sprintf "%-20s %s\n", $var, $nval; + } + + if (! $found) { die "can't find entry $var\n"; } + open (FILE, ">$statedata"); + foreach $line (@list) { + print FILE "$line"; + } + close (FILE); + exit 0; + } + + print "USAGE: mkrun sys\n"; + print "USAGE: mkrun sys init\n"; + print "USAGE: mkrun sys (key)\n"; + print "USAGE: mkrun sys (key) (value)\n"; + exit 1; +} + +###### +sub update { + + $now = time; + $mjd = &sec_to_mjd ($now); + + &load_runlist; + + $match = ""; + foreach $line (@runlist) { + if ($line =~ /^\#/) { next; } # skip commented lines + ($runid, $start, $stop, $camera) = split (" ", $line); + if ($runid eq "") { next; } # skip empty lines + $mjd_start = date_to_mjd ($start); + $mjd_stop = date_to_mjd ($stop); + if (($mjd >= $mjd_start) && ($mjd <= $mjd_stop)) { + $match = $line; + last; + } + } + if ($match eq "") { + $camera = "none"; + $runid = "none"; + } + system ("mkrun sys camera.current $camera"); + system ("mkrun sys runid.current $runid"); + exit 0; +} + +###### +sub today { + + $now = time; + $mjd = &sec_to_mjd ($now); + + &load_runlist; + + $match = ""; + foreach $line (@runlist) { + if ($line =~ /^\#/) { next; } # skip commented lines + ($runid, $start, $stop, $camera) = split (" ", $line); + if ($runid eq "") { next; } # skip empty lines + $mjd_start = date_to_mjd ($start); + $mjd_stop = date_to_mjd ($stop); + if (($mjd >= $mjd_start) && ($mjd <= $mjd_stop)) { + $match = $line; + last; + } + } + if ($match eq "") { + $camera = "none"; + $runid = "none"; + } + print STDOUT "CAMERA: $camera, RUNID: $runid\n"; + exit 0; +} + +###### +sub getrun { + + if (@ARGV != 2) { die "USAGE: mkrun run (runid)\n"; } + + &load_runlist; + $line = grab_runline ($ARGV[1]); + print STDOUT "$line\n"; + exit 0; +} + +###### +sub getdate { + + if (@ARGV != 2) { die "USAGE: mkrun date (yyyy/mm/dd)\n"; } + + my ($mjd) = date_to_mjd ($ARGV[1]); + + &load_runlist; + + foreach $line (@runlist) { + if ($line =~ /^\#/) { next; } # skip commented lines + ($runid, $start, $stop) = split (" ", $line); + if ($runid eq "") { next; } # skip empty lines + $mjd_start = date_to_mjd ($start); + $mjd_stop = date_to_mjd ($stop); + if (($mjd >= $mjd_start) && ($mjd <= $mjd_stop)) { + print STDOUT "$line\n"; + exit 0; + } + } + print STDOUT ""; + exit 1; +} + +############ +sub status { + + &load_runlist; + foreach $line (@runlist) { + print STDOUT "$line\n"; + } + exit 0; +} + +############ +sub comment { + + my (@argv) = @_; + + if (@argv != 2) { + print STDOUT "USAGE: mkrun comment (comment line)\n"; + exit 2; + } + + $comment = $argv[1]; + + &load_runlist; + insert_comment ($argv[1]); + &save_runlist; + exit 0; +} + +############ +sub create { + + if (@ARGV != 5) { + print STDOUT "USAGE: mkrun create (run) (start) (stop) (camera)\n"; + exit 2; + } + + $runid = $ARGV[1]; + $start = $ARGV[2]; + $stop = $ARGV[3]; + $camera = $ARGV[4]; + + &load_runlist; + + $line = grab_runline ($runid); + ($Orunid, $Ostart, $Ostop, $Ocamera, $qrunid) = split (" ", $line); + $line = mk_runline ($runid, $start, $stop, $camera, $qrunid); + insert_runline ($line); + + # does not check for overlaps, but probably should + + &save_runlist; + exit 0; +} + +############ +sub delete { + + if (@ARGV != 2) { + print STDOUT "USAGE: mkrun delete (run)\n"; + exit 2; + } + + $runid = $ARGV[1]; + + &load_runlist; + + $Ns = @runlist; + delete_runline ($runid); + $Ne = @runlist; + + if ($Ns == $Ne) { + print STDERR "runid $runid not found\n"; + exit 1; + } + + &save_runlist; + exit 0; +} + +############ +sub hstcreate { + + if (@ARGV != 1) { + print STDOUT "USAGE: mkrun hstcreate\n"; + exit 2; + } + + print STDOUT "Enter HST date for start of first night (YYYY/MM/DD): "; + $start = ; chop $start; + $mjd = date_to_mjd ($start); + $mjd += 1.0; + $start = date_format (&mjd_to_date ($mjd)); + + print STDOUT "Enter HST date for start of last night (YYYY/MM/DD): "; + $stop = ; chop $stop; + $mjd = date_to_mjd ($stop); + $mjd += 2.0; + $stop = date_format (&mjd_to_date ($mjd)); + + print STDOUT "Enter camera: "; + $camera = ; chop $camera; + + print STDOUT "Enter run ID: "; + $runid = ; chop $runid; + + print STDOUT "Enter associated QSO run IDs (separated by commas): "; + $qrunid = ; chop $qrunid; + + &load_runlist; + +# $line = grab_runline ($runid); +# ($Orunid, $Ostart, $Ostop, $Ocamera, $Oqrunid) = split (" ", $line); + $line = mk_runline ($runid, $start, $stop, $camera, $qrunid); + insert_runline ($line); + + &save_runlist; + exit 0; +} + +############ +sub addqso { + if (@ARGV != 3) { + print STDOUT "USAGE: mkrun addqso (run) (qsorun)\n"; + exit 2; + } + + $runid = $ARGV[1]; + $qrunid = $ARGV[2]; + + &load_runlist; + + $line = grab_runline ($runid); + if ($line eq "") { + print STDERR "run id $runid not in run list\n"; + exit 1; + } + ($runid, $start, $stop, $camera, $Oqrunid) = split (" ", $line); + if ($Oqrunid) { + $qrunid = $Oqrunid . "," . $qrunid; + } + + $line = mk_runline ($runid, $start, $stop, $camera, $qrunid); + insert_runline ($line); + + &save_runlist; + exit 0; +} + +############ +sub delqso { + if (@ARGV != 2) { + print STDOUT "USAGE: mkrun delqso (qsorun)\n"; + exit 2; + } + + $qrunid = $ARGV[1]; + + &load_runlist; + + # find listed qrunid + $match = ""; + SEARCH: + foreach $line (@runlist) { + if ($line =~ /^\#/) { next; } # skip commented lines + ($tmp, $tmp, $tmp, $tmp, $qlist) = split (" ", $line); + @qlist = split (",", $qlist); + foreach $qid (@qlist) { + if ($qrunid ne $qid) { next; } + $match = $line; + last SEARCH; + } + } + if ($match eq "") { + print STDERR "QSO run id $qrunid not found in run list\n"; + exit 1; + } + + # recreate $qlist without $qrunid + @qnew = (); + foreach $qid (@qlist) { + if ($qid eq $qrunid) { next; } + push @qnew, $qid; + } + $qlist = join (",", @qnew); + + ($runid, $start, $stop, $camera) = split (" ", $match); + + $line = mk_runline ($runid, $start, $stop, $camera, $qlist); + insert_runline ($line); + + &save_runlist; + exit 0; +} + +####### runlist utilities ############################ +sub load_runlist { + open (FILE, "$runlist"); + @runlist = ; + foreach $line (@runlist) { + chop ($line); + } + close (FILE); +} + +sub save_runlist { + open (FILE, ">$runlist"); + foreach $line (@runlist) { + print FILE "$line\n"; + } + close (FILE); +} + +sub grab_runline { + my ($id) = $_[0]; + my ($line); + my ($runid); + + foreach $line (@runlist) { + if ($line =~ /^\#/) { next; } # skip commented lines + ($runid) = split (" ", $line); + if ($runid ne $id) { next; } + return ($line); + } + return (""); +} + +sub insert_comment { + my ($comment) = $_[0]; + + @runlist = (@runlist, $comment); + return 1; +} + +sub insert_runline { + my ($runline) = $_[0]; + my ($line); + my ($runid, $id); + + # match the run id lines + ($id) = split (" ", $runline); + foreach $line (@runlist) { + if ($line =~ /^\#/) { next; } # skip commented lines + ($runid) = split (" ", $line); + if ($runid ne $id) { next; } + $line = $runline; + return 1; + } + @runlist = (@runlist, $runline); + return 0; +} + +sub delete_runline { + my ($id) = $_[0]; + my ($line, $runid); + + # match the run id lines + @newlist = (); + foreach $line (@runlist) { + ($runid) = split (" ", $line); + if ($runid eq $id) { next; } + @newlist = (@newlist, $line); + } + @runlist = @newlist; + return 0; +} + +sub mk_runline { + my ($runid, $start, $stop, $camera, $qrunid, $line); + $runid = $_[0]; + $start = $_[1]; + $stop = $_[2]; + $camera = $_[3]; + $qrunid = $_[4]; + + $start = date_format ($start); + $stop = date_format ($stop); + $line = sprintf "%s %s %s %-9s %s", $runid, $start, $stop, $camera, $qrunid; + return ($line); +} + +# utilities ############################################## + +sub atcommand { + my ($cmd, $log, $time, $date); + $cmd = $_[0]; + $log = $_[1]; + $time = $_[2]; + $date = $_[3]; + + if (($log eq "") || ($log eq "NONE")) { $log = "/dev/null"; } + + printf "%s %s: %s\n", $date, $time, $cmd; + $line = sprintf "%s %s %s %s", $date, $time, $log, $cmd; + print SCHED "$line\n"; +} + + +sub vsystem { + # print STDERR "@_\n"; + my($status) = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +sub date_format { + my ($date) = $_[0]; + my ($year, $month, $day); + + ($year, $month, $day) = $date =~ /(\d+)\/(\d+)\/(\d+)/; + $date = sprintf "%4d/%02d/%02d", $year, $month, $day; + return ($date); +} + +sub date_to_mjd { + my ($date) = $_[0]; + my ($year, $month, $day, $mjd); + + ($year, $month, $day) = $date =~ /(\d+)\/(\d+)\/(\d+)/; + $mjd = get_mjd ($year, $month, $day); + + return ($mjd); +} + +sub mjd_to_date { + my ($mjd) = $_[0]; + my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday); + my ($date, $time); + + $time = 86400 * ($mjd - 40587.0); + ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = gmtime ($time); + $year += 1900; + $mon ++; + + $date = sprintf "%04d/%02d/%02d,%02d:%02d:%04.1f", $year, $mon, $mday, $hour, $min, $sec; + + return $date; +} + +sub sec_to_mjd { + my ($sec) = $_[0]; + my ($mjd); + + $mjd = $sec / 86400 + 40587.0; + return $mjd; +} + +# gmtime +# ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = gmtime(time); +# ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = localtime(time); +# $time = time +# 0 sec (unix) = 2440587.5 jd = 40587.0 mjd + +sub get_mjd { + + my($year) = $_[0]; + my($month) = $_[1]; + my($day) = $_[2]; + + my($jd) = $day - 32075 + int (1461*($year + 4800 + int (($month - 14)/12))/4) + + int(367*($month - 2 - int(($month - 14)/12)*12)/12) + - int(3*int(($year + 4900 + int(($month - 14)/12))/100)/4) - 0.5 - 2400000.5; + + return ($jd); +} + +sub usage { + + if (@ARGV == 1) { + print STDERR "create (runid) (start) (stop) (camera) - create / change a camera run\n"; + print STDERR "delete (runid) - delete a camera run\n"; + print STDERR "hstcreate - interactive camera run creation\n"; + print STDERR "addqso (runid) (qsoid) - add a qso run to camera run\n"; + print STDERR "delqso (qsoid) - delete a qso run\n"; + print STDERR "comment (line) - add a comment line to run list\n"; + print STDERR "status - check current run list\n"; + print STDERR "date (date) - return run info for given date\n"; + print STDERR "run (runid) - return run info for given camera run\n"; + print STDERR "\n"; + print STDERR "sys - display current system variables\n"; + print STDERR "sys init - set defaults for system variables\n"; + print STDERR "sys (key) - fetch value of system variable\n"; + print STDERR "sys (key) (value) - set value of system variable\n"; + print STDERR "\n"; + &goodbye; + } + + if (@ARGV > 2) { print STDERR "USAGE: prepare.run (help) [mode]\n"; &goodbye; } + + &goodbye; +} + + + +############## +sub mk_events { + my ($runid, $start, $stop); + $runid = $_[0]; + $start = $_[1]; + $stop = $_[2]; + + $mjd_start = date_to_mjd ($start); + $mjd_stop = date_to_mjd ($stop); + + $Nday = $mjd_stop - $mjd_start + 1; + + if (! -e $schedule) { + # create a new schedule with PREVIOUS set to NEVER + open (SCHED, ">$schedule"); + print SCHED "# schedule for scheduler system\n"; + print SCHED "# E. Magnier\n"; + print SCHED "\n"; + print SCHED "# last time scheduler was run:\n"; + print SCHED "PREVIOUS NEVER\n"; + print SCHED "\n"; + close (SCHED); + } + + open (SCHED, ">>$schedule"); + print "\n"; + $date = `date "+%Y/%m/%d %k:%M:%S"`; chop ($date); + print SCHED "# added $date\n"; + + + ($year, $month, $day) = $start =~ /(\d+)\/(\d+)\/(\d+)/; + for ($Day = -1; $Day < $Nday + 7; $Day++) { + + $tday = $day + $Day - 1; + $date = `date -d $year/$month/$tday +%Y/%m/%d`; chop ($date); + + if ($Day == 0) { + atcommand ("mkrun sys RUNID $runid", "$logdir/config.log", "10:00", $date); + atcommand ("checkconfig -ckdirs", "$logdir/config.log", "10:00", $date); + atcommand ("mkdetrend create $runid $start $stop", "$logdir/mkdetrend.log", "10:00", $date); + atcommand ("mkfringe config $runid", "$logdir/mkdetrend.log", "10:00", $date); + atcommand ("mkfringe mkconfig", "$logdir/mkdetrend.log", "10:00", $date); + } + if ($Day == 4) { + atcommand ("mkdetrend auto set update", "$logdir/mkdetrend.log", "10:00", $date); + } + if ($Day == $Nday) { + atcommand ("mkdetrend auto set hold", "$logdir/mkdetrend.log", "10:00", $date); + } + } + close (SCHED); + +} + + +############## + +sub sched { + if (@ARGV != 2) { + print STDOUT "USAGE: mkrun sched (runid)\n"; + exit 2; + } + + $runid = $ARGV[1]; + &load_runlist; + + $line = grab_runline ($runid); + ($runid, $start, $stop, $camera, $qlist) = split (" ", $line, 4); + + mk_events ($runid, $start, $stop); + + exit 0; +} + +if ($ARGV[0] eq "sched") { &sched (@ARGV); } Index: /trunk/Ohana/src/perl/src/mktrans =================================================================== --- /trunk/Ohana/src/perl/src/mktrans (revision 17) +++ /trunk/Ohana/src/perl/src/mktrans (revision 17) @@ -0,0 +1,112 @@ +#!/usr/bin/env perl + +if (@ARGV != 2) { die "USAGE: mktrans (start) (stop)\n" ;} + +$start = $ARGV[0]; +$stop = $ARGV[1]; + +@photcodes = ("B", "V", "R", "I", "Z"); + +foreach $code (@photcodes) { + + @list = `photsearch -trange $start $stop -photcode $code`; + + # the lines from photsearch look like this: + # V 2001/02/03,15:38:53 26.249 0.017 elixir + + @dates = (); + + # use date hashes to extract stats for each date: + foreach $line (@list) { + + # parse the line for the date + @words = split (" ", $line); + ($date) = $words[1] =~ /(\d\d\d\d\/\d\d\/\d\d),/; + + # if this is a new date, save it in the list + unless ($sum1{$date}) { @dates = (@dates, $date); } + + # add to the stats + $sumN{$date} ++; + $sum1{$date} += $words[2]; + $sum2{$date} += $words[2]*$words[2]; + + # print STDERR "date: $date\n"; + + } + + @sdates = sort by_date @dates; + + # calculate mean and stdev for each date + foreach $date (@sdates) { + + $Np = $sumN{$date}; + $zp = $sum1{$date} / $Np; + $dzp = sqrt ($sum2{$date} / $Np - $zp*$zp); + + printf STDOUT "transreg %s %6.3f %6.4f %s 1d\n", $code, $zp, $dzp, $date; + } + + %sumN = (); + %sum1 = (); + %sum2 = (); + print STDOUT "\n"; + +} + +exit 0; + +sub by_date { + + ($year, $month, $day) = $a =~ /(\d\d\d\d).(\d\d).(\d\d)/; + $va = get_jd ($year, $month, $day); + ($year, $month, $day) = $b =~ /(\d\d\d\d).(\d\d).(\d\d)/; + $vb = get_jd ($year, $month, $day); + $va <=> $vb; +} + + + +################################################################################### + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + + +sub get_jd { + + my($year) = $_[0]; + my($month) = $_[1]; + my($day) = $_[2]; + + my($jd) = $day - 32075 + int (1461*($year + 4800 + int (($month - 14)/12))/4) + + int(367*($month - 2 - int(($month - 14)/12)*12)/12) + - int(3*int(($year + 4900 + int(($month - 14)/12))/100)/4) - 0.5; + + + return ($jd); + +} + +sub get_mjd { + + my($year) = $_[0]; + my($month) = $_[1]; + my($day) = $_[2]; + + my($jd) = $day - 32075 + int (1461*($year + 4800 + int (($month - 14)/12))/4) + + int(367*($month - 2 - int(($month - 14)/12)*12)/12) + - int(3*int(($year + 4900 + int(($month - 14)/12))/100)/4) - 0.5 - 2400000.5; + + + return ($jd); + +} + Index: /trunk/Ohana/src/perl/src/mktreport =================================================================== --- /trunk/Ohana/src/perl/src/mktreport (revision 17) +++ /trunk/Ohana/src/perl/src/mktreport (revision 17) @@ -0,0 +1,135 @@ +#!/usr/bin/env perl + +if (@ARGV != 2) { die "USAGE: mktreport (start) (stop)\n" ;} + +$start = $ARGV[0]; +$stop = $ARGV[1]; + +@photcodes = ("B", "V", "R", "I"); + +@list = `transearch -offset`; + +# the lines from transearch look like this: +# R 2001/04/15,00:00:00 -0.032 26.259 0.004 0.040 -0.090 B_L92 V_L92 5 15 elixir +# (date) (dZP) (ZPo) (sigma) + +@dates = (); + +# get the complete list of unique dates: + +LIST: +foreach $line (@list) { + + # parse the line for the date + @words = split (" ", $line); + ($date) = $words[1] =~ /(\d\d\d\d\/\d\d\/\d\d),/; + + unless ($found{$date}) { @dates = (@dates, $date); $found{$date} = 1; } + + for ($i = 0; $i < @photcodes; $i++) { + + if ($words[0] ne $photcodes[$i]) { next; } + + $name1 = "ZPo$i"; + $name2 = "dZP$i"; + $$name1{$date} = $words[2]; + $$name2{$date} = $words[4]; + next LIST; + } + + print STDERR "$words[0] not found in photcode list\n"; +} + +@sdates = sort by_date @dates; + +print STDOUT " "; +for ($i = 0; $i < @photcodes; $i++) { + printf STDOUT "%6s ", $photcodes[$i]; +} +print STDOUT " "; +for ($i = 0; $i < @photcodes; $i++) { + printf STDOUT "%6s ", "d$photcodes[$i]"; +} +print STDOUT "\n"; + +foreach $date (@sdates) { + + print STDOUT "$date "; + + for ($i = 0; $i < @photcodes; $i++) { + $name = "ZPo$i"; + if ($$name{$date}) { + printf STDOUT "%6.3f ", $$name{$date}; + } else { + print STDOUT " - "; + } + } + print STDOUT " "; + for ($i = 0; $i < @photcodes; $i++) { + $name = "dZP$i"; + if ($$name{$date}) { + printf STDOUT "%6.3f ", $$name{$date}; + } else { + print STDOUT " - "; + } + } + + print STDOUT "\n"; +} + +exit 0; + +sub by_date { + + ($year, $month, $day) = $a =~ /(\d\d\d\d).(\d\d).(\d\d)/; + $va = get_jd ($year, $month, $day); + ($year, $month, $day) = $b =~ /(\d\d\d\d).(\d\d).(\d\d)/; + $vb = get_jd ($year, $month, $day); + $va <=> $vb; +} + + + +################################################################################### + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + + +sub get_jd { + + my($year) = $_[0]; + my($month) = $_[1]; + my($day) = $_[2]; + + my($jd) = $day - 32075 + int (1461*($year + 4800 + int (($month - 14)/12))/4) + + int(367*($month - 2 - int(($month - 14)/12)*12)/12) + - int(3*int(($year + 4900 + int(($month - 14)/12))/100)/4) - 0.5; + + + return ($jd); + +} + +sub get_mjd { + + my($year) = $_[0]; + my($month) = $_[1]; + my($day) = $_[2]; + + my($jd) = $day - 32075 + int (1461*($year + 4800 + int (($month - 14)/12))/4) + + int(367*($month - 2 - int(($month - 14)/12)*12)/12) + - int(3*int(($year + 4900 + int(($month - 14)/12))/100)/4) - 0.5 - 2400000.5; + + + return ($jd); + +} + Index: /trunk/Ohana/src/perl/src/mosaic.merge =================================================================== --- /trunk/Ohana/src/perl/src/mosaic.merge (revision 17) +++ /trunk/Ohana/src/perl/src/mosaic.merge (revision 17) @@ -0,0 +1,114 @@ +#!/usr/bin/env perl +# this program takes a file template, with CCDNUM substituted for the +# CCD number. each file contains the ccd frames as separate extents. The program +# loads the names, then for each frame, it goes through the CCDNUM entries +# and mosaics together the appropriate image, writing them to an output filename +# formed from ARGV[1] (ARGV[1].n.jpg). These names are written to ARGV[1] +# +# this program returns immediately if all CCDNUM entries are not found. +# the previous function, detstats, must not create the *.stats file until the +# process is done. similarly, this program deletes the *.stats files to avoid +# confusion on a second pass + +$answer = `cameraconfig -ccds`; +@ccds = split (" ", $answer); + +if (@ARGV != 3) { die "ERROR: USAGE: mosaic.tenbin (name) (out) (type)\n" } +$type = "\U$ARGV[2]\E"; + +# find the appropriate script file +$confdir = `gconfig -q CONFDIR`; chop $confdir; +$script = "$confdir/mana/flips.pro"; + +# test named Xserver, or start vnc on specified machine +$xhost = `gconfig -q XHOST`; chop $xhost; +$xdisp = `gconfig -q XDISP`; chop $xdisp; +if (vsystem ("xdpyinfo -display $xdisp")) { + print STDERR "ERROR: X server is not running. start it now on $xhost\n"; + exit 1; +} +$ENV{'DISPLAY'} = $xdisp; + +# check for the existence of each input file, exit if non-existent +foreach $ccd (@ccds) { + $name = $ARGV[0]; + $name =~ s/CCDNUM/$ccd/; + unless (-r $name) { + print STDERR "ERROR: can't find all files\n"; + exit 1; + } +} + +# we are constructing the names of the input files. there are NCCD +# files with names of the form path/01Ak01.flat.I.CCDNUM.0.medbin we +# need to loop over all NEXTEND entries in these files, creating +# NEXTEND output images. First check that each file has the same NEXTEND + +@filenames = (); +for ($i = 0; $i < @ccds; $i++) { + $name = $ARGV[0]; + $name =~ s/CCDNUM/$ccds[$i]/; + push @filenames, $name; + + $line = `echo $name | fields NEXTEND`; + ($junk, $N) = split (" ", $line); + if ($i == 0) { + $Nline = $N; + } + if ($N != $Nline) { + print STDERR "ERROR: mis-matched number of images in $name\n"; + exit (1); + } +} + +open (MANA, "|mana --norc"); +print MANA "input $script\n"; + +# define list of names as mana list +print MANA "list names\n"; +foreach $name (@filenames) { + print MANA "$name\n"; +} +print MANA "end\n"; + +# define macro for 1 image +print MANA "macro mkimage\n"; +print MANA " mergemosaic \$1\n"; +if ($type eq "RAW") { print MANA " jpgraw \$2\n"; } +if ($type eq "FLAT") { print MANA " jpgnorm \$2\n"; } +if ($type eq "BIAS") { print MANA " jpgmosaic \$2\n"; } +if ($type eq "DARK") { print MANA " jpgmosaic \$2\n"; } +print MANA "end\n"; + +# define macro for image list +print MANA "macro go\n"; +open (LIST, ">$ARGV[1]"); +for ($i = 0; $i < $Nline; $i++) { + $outfile = sprintf "%s.%03d.jpg", $ARGV[1], $i; + print MANA " mkimage $i $outfile\n"; + print LIST "$outfile\n"; +} +close (LIST); +print MANA " exit 0\n"; +print MANA "end\n"; +print MANA "go\n"; +print MANA "exit 1\n"; +close (MANA); +if ($?) { + print STDERR "ERROR running mana\n"; + exit 1; +} + +print STDOUT "SUCCESS\n"; +exit 0; + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + Index: /trunk/Ohana/src/perl/src/mosaic.stats =================================================================== --- /trunk/Ohana/src/perl/src/mosaic.stats (revision 17) +++ /trunk/Ohana/src/perl/src/mosaic.stats (revision 17) @@ -0,0 +1,142 @@ +#!/usr/bin/env perl +# this program takes a list template, with CCDNUM substituted for the +# CCD number. each file contains a list of statistics for each image. The program +# loads the names, then for each frame, it goes through the CCDNUM entries +# and loads the appropriate statistics, writing them to the output file +# +# this program returns immediately if all CCDNUM entries are not found. +# the previous function, detstats, must not create the *.stats file until the +# process is done. similarly, this program deletes the *.stats files to avoid +# confusion on a second pass + +$answer = `cameraconfig -ccds`; +@ccds = split (" ", $answer); + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +if (@ARGV != 3) { die "ERROR: USAGE: mosaic.stats (name) (out) (type)\n" } + +$type = "\U$ARGV[2]\E"; + +# check for the existence of each input file, exit if non-existent +foreach $ccd (@ccds) { + $name = $ARGV[0]; + $name =~ s/CCDNUM/$ccd/; + unless (-r $name) { + print STDERR "ERROR: can't find $name\n"; + exit (0); + } +} + +# count number of lines in file 00: +$name = $ARGV[0]; +$name =~ s/CCDNUM/$ccds[0]/; + +# load in stats from files (Nlist*Nccd entries) +for ($i = 0; $i < @ccds; $i++) { + $name = $ARGV[0]; + $name =~ s/CCDNUM/$ccds[$i]/; + + $lname = "list$i"; + open (FILE, $name); + @$lname = ; + close (FILE); + + if ($i == 0) { + $Nline = @$lname; + } else { + if (@$lname != $Nline) { die "ERROR mis-matched file lengths\n"; } + } +} + +$dawn = 0; +$dusk = 1; +@pdate = (); +@ptwil = (); +$Nperiod = 0; +@period = (); + +open (OUTPUT, ">$ARGV[1]"); +for ($i = 0; $i < $Nline; $i++) { + + $mean = 0; + $medn = 0; + $sig12 = 0; + $sig22 = 0; + $mean2 = 0; + $mbin = 0; + $sbin2 = 0; + $mbin2 = 0; + + for ($j = 0; $j < @ccds; $j++) { + $lname = "list$j"; + $line = $$lname[$i]; + chop ($line); + @words = split (" ", $line); + $file = $words[0]; + $date = $words[1]; + $time = $words[2]; + $stat = $words[9]; + $mean += $words[3]; + $medn += $words[4]; + $sig12 += $words[5]*$words[5]; + $sig22 += $words[6]*$words[6]; + $mean2 += $words[3]*$words[3]; + + $mbin += $words[7]; + $sbin2 += $words[8]*$words[8]; + $mbin2 += $words[7]*$words[7]; + } + $N = $j; + + # identify even or morn twilight + @words = split (':', $time); + if (($words[0] > 12) && ($words[0] < 24)) { + $twilite = $dawn; + } else { + $twilite = $dusk; + } + $ThisPeriod = -1; + for ($j = 0; $j < $Nperiod; $j++) { + if (($pdate[$j] eq $date) && ($ptwil[$j] == $twilite)) { + $ThisPeriod = $j; + last; + } + } + if ($ThisPeriod == -1) { + $ThisPeriod = $Nperiod; + @pdate = (@pdate, $date); + @ptwil = (@ptwil, $twilite); + $Nperiod ++; + } + @period = (@period, $ThisPeriod); + + # determine global statistics + $Mean = $mean / $N; + $Medn = $medn / $N; + $Mbin = $mbin / $N; + + if ($type eq "FLAT") { + $Sig1 = sqrt ($sig12 / $N + $mean2 / $N - $Mean*$Mean) / abs ($Mean); + $Sig2 = sqrt ($sig22 / $N + $mean2 / $N - $Mean*$Mean) / abs ($Mean); + $Sbin = sqrt ($sbin2 / $N + $mbin2 / $N - $Mbin*$Mbin) / abs ($Mbin); + } else { + $Sig1 = sqrt ($sig12 / $N + $mean2 / $N - $Mean*$Mean); + $Sig2 = sqrt ($sig22 / $N + $mean2 / $N - $Mean*$Mean); + $Sbin = sqrt ($sbin2 / $N + $mbin2 / $N - $Mbin*$Mbin); + } + + printf OUTPUT "%6s %10s %11s %7.1f %7.1f %6.4f %6.4f %7.1f %6.4f %d %s %d %d\n", + $file, $date, $time, $Mean, $Medn, $Sig1, $Sig2, $Mbin, $Sbin, $period[$i], $pdate[$period[$i]], $ptwil[$period[$i]], $stat; + +} +close (OUTPUT); +print STDERR "SUCCESS\n"; Index: /trunk/Ohana/src/perl/src/normalize =================================================================== --- /trunk/Ohana/src/perl/src/normalize (revision 17) +++ /trunk/Ohana/src/perl/src/normalize (revision 17) @@ -0,0 +1,222 @@ +#!/usr/bin/env perl + +$version = "1.0"; + +# default variable values +$start = 0; +$stop = 0; +$oldflips = 0; +$addtime = 0; +$addconfig = 0; + +# grab the command line options +@tARGV = (); +for (; @ARGV > 0; ) { + if ($ARGV[0] eq "-oldflips") { + $oldflips = 1; + shift; next; + } + if ($ARGV[0] eq "-time") { + $addtime = 1; + $start = $ARGV[1]; + $stop = $ARGV[2]; + shift; shift; shift; next; + } + if ($ARGV[0] eq "-config") { + $addconfig = 1; + $elconf = $ARGV[1]; + shift; shift; next; + } + if ($ARGV[0] eq "-h") { &usage; } + if ($ARGV[0] eq "--help") { &usage; } + @tARGV = (@tARGV, $ARGV[0]); + shift; +} +@ARGV = @tARGV; + +if (@ARGV != 4) { &usage; } +if ($addtime && ("$start" == "")) { &usage; } +if ($addtime && ("$stop" == "")) { &usage; } + +# command line arguments +$input = $ARGV[0]; +$output = $ARGV[1]; +$ref = $ARGV[2]; +$type = uppercase ($ARGV[3]); + +$ccdword = `gconfig -q CCDNUM-KEYWORD`; chop ($ccdword); +$typeword = `gconfig -q IMAGETYPE-KEYWORD`; chop ($typeword); + +# choose appropriate type +if ($type eq "FLAT") { &mk_flat; } +if ($type eq "DARK") { &mk_dark; } +if ($type eq "BIAS") { &mk_dark; } +print STDERR "unknown type $type"; +exit 1; + +sub mk_dark { +# create mana macro, run (allows exit status to be checked) + open (MANA, "|mana --norc"); + print MANA "macro go\n"; + print MANA "echo 'starting normalize'\n"; + print MANA "rd a $input\n"; + print MANA "keyword a $typeword -w $type\n"; + + if ($addtime == 1) { + print MANA "keyword a TVSTART -w $start\n"; + print MANA "keyword a TVSTART -wc \"data validity start time\"\n"; + print MANA "keyword a TVSTOP -w $stop\n"; + print MANA "keyword a TVSTOP -wc \"data validity start time\"\n"; + } + if ($addconfig == 1) { + print MANA "keyword a ELCONF -w $elconf\n"; + print MANA "keyword a ELCONF -wc \"Original Elixir config\"\n"; + } + + print MANA "keyword a COMMENT -ws \"Elixir:normalize version $version\"\n"; + print MANA "keyword a COMMENT -ws \"no renormalization needed for $type\"\n"; + print MANA "wd a $output -bitpix 16 -bzero 32768.0 -bscale 1.0\n"; + print MANA "echo normlized done ($input to $output)\n"; + print MANA "exit 0\n"; + print MANA "end\n"; # end of macro 'go' + + print MANA "go\n"; + print MANA "exit 1\n"; + close (MANA); + if ($?) { + print STDERR "ERROR problem running mana in normalize (bias, dark)\n"; + exit 1; + } + print STDOUT "SUCCESS: finished with normalize\n"; + exit 0; +} + +sub mk_flat { + # check on reference existence (not needed for BIAS, DARK) + if (! -f $ref) { + print STDERR "ERROR: ref file $args[3] is missing\n"; + exit 1; + } + + # we need keywords defined by the process (flips) which creates the master frame + if ($oldflips) { + # these lines were used before flips was upgraded to add the DATAMODE keywords + $answer = `fhead $ref | grep "Output file mode"`; + @words = split (" ", $answer); + $refmode = $words[-1]; + + $answer = `fhead $input | grep "Output file mode"`; + @words = split (" ", $answer); + $mode = $words[-1]; + } else { + $answer = `echo $ref | fields DATAMODE`; + ($junk, $refmode) = split (" ", $answer); + $answer = `echo $input | fields DATAMODE`; + ($junk, $mode) = split (" ", $answer); + } + $answer = `echo $ref | fields $ccdword`; + ($junk, $refccd) = split (" ", $answer); + + # check for valid values + if ("$refmode" == "") { + print STDERR "ERROR: can't get reference mode value\n"; + exit 1; + } + if ("$mode" == "") { + print STDERR "ERROR: can't get image mode value\n"; + exit 1; + } + + # grab mask file + $mask = `detsearch -quiet -image $input 0 split -type mask`; chop ($mask); + if ($? || ($mask eq "")) { + print STDERR "can't find mask for this image, no mask applied\n"; + $mask = "none"; + } + + # run MANA + open (MANA, "|mana --norc"); + print MANA "macro go\n"; + print MANA "echo 'starting normalize'\n"; + print MANA "rd a $input\n"; + print STDERR "mask: $mask\n"; + if ($mask eq "none") { + print MANA "set b = a / $refmode\n"; + } else { + print MANA "rd c $mask\n"; + print MANA "set b = (a / $refmode) * c\n"; + } + + $scale = $refmode / $mode; + $newmode = $mode / $refmode; + print MANA "keyword b DATAMODE -wf $newmode\n"; + print MANA "keyword b FLATSCAL -wf $scale\n"; + print MANA "keyword b $typeword -w $type\n"; + if ($addtime == 1) { + print MANA " keyword b TVSTART -w $start\n"; + print MANA " keyword b TVSTART -wc \"data validity start time\"\n"; + print MANA " keyword b TVSTOP -w $stop\n"; + print MANA " keyword b TVSTOP -wc \"data validity start time\"\n"; + } + if ($addconfig == 1) { + print MANA "keyword b ELCONF -w $elconf\n"; + print MANA "keyword b ELCONF -wc \"Original Elixir config\"\n"; + } + print MANA "keyword b COMMENT -ws \"Elixir:normalize version $version\"\n"; + print MANA "keyword b COMMENT -ws \"FLAT image normalized wrt CCD $refccd\"\n"; + print MANA "clip b 0.0 0.0 6.4 0.0\n"; + print MANA "wd b $output -bitpix 16 -bzero 3.2 -bscale 0.0001\n"; + print MANA "echo normlized done ($input to $output)\n"; + print MANA "exit 0\n"; + print MANA "end\n"; # end of macro 'go' + + print MANA "go\n"; + print MANA "exit 1\n"; + close (MANA); + if ($?) { + print STDERR "ERROR problem running mana in normalize (flat)\n"; + exit 1; + } + print STDOUT "SUCCESS: finished with normalize\n"; + exit 0; +} + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +sub uppercase { + return "\U$_[0]\E"; +} + +# given a filename, check that its path exists, create it if not +sub ckpathname { + my ($file) = $_[0]; + my (@words, $dir); + + @words = split ("/", $file); + pop (@words); + $dir = join ("/", @words); + + if ($dir eq "") { $dir = "."; } + + if (! -d $dir) { + system ("mkdir -p $dir"); + if ($?) { + print STDERR "ERROR: can't make directory component for $file\n"; + exit 1; + } + } +} + +sub usage { + print STDERR "normalize (input) (output) (ref) (type) [-time start stop] [-oldflips]\n"; + exit 2; +} + Index: /trunk/Ohana/src/perl/src/seeingstats =================================================================== --- /trunk/Ohana/src/perl/src/seeingstats (revision 17) +++ /trunk/Ohana/src/perl/src/seeingstats (revision 17) @@ -0,0 +1,113 @@ +#!/usr/bin/env perl + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +sub min { + if ($_[0] < $_[1]) { + return ($_[0]); + } else { + return ($_[1]); + } +} + +sub max { + if ($_[0] > $_[1]) { + return ($_[0]); + } else { + return ($_[1]); + } +} + +if (@ARGV != 1) { die "ERROR: USAGE: seeingstats (file)\n" } + +open (FILE, $ARGV[0]); +@list = ; +close (FILE); + +# the file contains results from sextractor. the lines +# contain: FWHM FLAGS CLASS MAG +# reject bad objects, find mag min & number +@mag = (); +for ($i = 0; $i < @list; $i++) { + @words = split (" ", $list[$i]); + if ($words[1] > 0) { next; } + if ($words[3] > 0) { next; } + @mag = (@mag, $words[3]); +} + +# find Mag threshold +@Mag = sort {$a <=> $b} @mag; +$Nmag = @Mag; +$Nwant = int(min(max(0.25*$Nmag, 10), $Nmag-1)); +$Mlim = $Mag[$Nwant]; + +# fast way to zero a list of 1024 elements +@Nfwhm = (0.0); +for ($i = 0; $i < 10; $i++) { + @Nfwhm = (@Nfwhm, @Nfwhm); +} +$N = @Nfwhm; + +# reject bad objects, find mag min & number +@fwhm = (); +for ($i = 0; $i < @list; $i++) { + @words = split (" ", $list[$i]); + if ($words[1] > 0) { next; } + if ($words[3] > $Mlim) { next; } + @fwhm = (@fwhm, $words[0]); + + # accumulate entry in histogram (@Nfwhm) + $bin = int ($words[0]*10.0); + if ($bin < 0) { next; } + if ($bin > 999) { next; } + $Nfwhm[$bin] ++; +} + +# find the mode (bin size = 0.1 pixels) +$mode = 0; +$Nmode = $Nfwhm[$mode]; +for ($i = 1; $i < @Nfwhm; $i++) { + if ($Nfwhm[$i] > $Nmode) { + $mode = $i; + $Nmode = $Nfwhm[$mode]; + } +} +$Vmode = $mode * 0.1; +$Fmin = $Vmode - 0.2; +$Fmax = $Vmode + 0.2; + +# find the mean of values within 0.2 pix of the mode +$F = 0; +$N = 0; +for ($i = 0; $i < @fwhm; $i++) { + if ($fwhm[$i] < $Fmin) { next; } + if ($fwhm[$i] > $Fmax) { next; } + $N++; + $F += $fwhm[$i]; +} +if ($N > 3) { + $fwhm = $F / $N; + printf "%7.3f\n", $fwhm; + exit 0; +} + +# I don't think the above can ever fail to get an answer, but... +# if the mode search didn't work, resort to median +$F = 0; +$N = 0; +@Fwhm = sort {$a <=> $b} @fwhm; +$Nc = int(0.5*@Fwhm); +for ($i = $Nc-1; $i < $Nc+2; $i++) { + $N++; + $F += $Fwhm[$i]; +} +$fwhm = $F / $N; +printf "%7.3f\n", $fwhm; Index: /trunk/Ohana/src/perl/src/split.mef =================================================================== --- /trunk/Ohana/src/perl/src/split.mef (revision 17) +++ /trunk/Ohana/src/perl/src/split.mef (revision 17) @@ -0,0 +1,99 @@ +#!/usr/bin/env perl + +# we could test for each resulting file and re-construct the +# output lists using only the successful ones. This would work +# best after we re-organize the flips elixirs to run imselect 1x +# and the split parallel by image, not config + +if (@ARGV != 4) { die "USAGE: split.mef (list.mef) (outdir) (ccd) (list.msplit)\n"; } + +$inlist = $ARGV[0]; +$outdir = $ARGV[1]; +$ccd = $ARGV[2]; +$outlist= $ARGV[3]; + +$ccdkeyword = `gconfig CCDNUM-KEYWORD`; chop ($ccdkeyword); + +$line = `cameraconfig -axes`; chop ($line); +($Naxis1, $Naxis2) = split (" ", $line); + +if (! -d $outdir) { vsystem ("mkdir -p $outdir"); } + +open (FILE, "$inlist"); +@mef = ; +close (FILE); + +@split = (); +foreach $name (@mef) { + chop ($name); + + # convert name /path/name.fits to /outdir/rootccd.fits + @words = split ("/", $name); + $root = $words[-1]; + $root =~ s/.fits//; + + # change to use ccd number, not id? + $new = sprintf "%s/%s%s.fits", $outdir, $root, $ccd; + push @split, $new; +} + +# convert mef file to split files in outdir +# write all valid entries to outlist + +# start with empty file for msplit +unlink ($outlist); + +open (MANA, "|mana --norc"); + +# define the macro 'split' +print MANA "macro split\n"; +print MANA " \$CCDKEYWORD = $ccdkeyword\n"; +print MANA " rd a \$1 -n $ccd\n"; +print MANA " keyword a NAXIS1 nx\n"; +print MANA " keyword a NAXIS2 ny\n"; +print MANA " if ((\$nx == $Naxis1) && (\$ny == $Naxis2))\n"; +print MANA " wd a \$2 -bitpix 16 -bzero 32768 -bscale 1.0\n"; +print MANA " exec echo \$2 >> $outlist\n"; +print MANA " end\n"; +print MANA "end\n"; + +# create the macro 'go' with the commands +print MANA "macro go\n"; +for ($i = 0; $i < @mef; $i++) { + if (-e $split[$i]) { + # if NAXIS1 & NAXIS2 are valid, add entry to outlist + $answer = `echo $split[$i] | fields NAXIS1 NAXIS2`; + ($tmp, $nx, $ny) = split (" ", $answer); + if ($nx != $Naxis1) { next; } + if ($ny != $Naxis2) { next; } + print MANA "exec echo $split[$i] >> $outlist\n"; + # print STDERR "$split[$i] exists, skipping\n"; + next; + } + print MANA " split $mef[$i] $split[$i]\n"; +} +# if the macro ends successfully, exit 0 +print MANA " exit 0\n"; +print MANA "end\n"; + +# if the macro exits before the end, exit 1 +print MANA "go\n"; +print MANA "exit 1\n"; +close (MANA); + +$status = $?; +print STDERR "mana exit status: $status\n"; +if ($status) { + print STDERR "ERROR: problem running split.mef\n"; + exit 1; +} + +print STDERR "SUCCESS\n"; +exit 0; + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + Index: /trunk/Ohana/src/perl/src/update.astrometry.iraf =================================================================== --- /trunk/Ohana/src/perl/src/update.astrometry.iraf (revision 17) +++ /trunk/Ohana/src/perl/src/update.astrometry.iraf (revision 17) @@ -0,0 +1,116 @@ +#!/usr/bin/env perl + +$version = 1.0; +if (@ARGV != 2) { die "USAGE: update.astrometry.iraf (efile) (cmpfile)\n" ; } + +$efile = $ARGV[0]; +$cmpfile = $ARGV[1]; + +if (! -e $efile) { die "output file $efile not found\n"; } +if (! -e $cmpfile) { die "header source file $cmpfile not found\n"; } + +# grab astrometry keywords from $cmpfile: +@header = &load_header ($cmpfile); + +# set some default values: +@astrom = (); +$Nastro = 0; + +# search for the appropriate lines: +foreach $line (@header) { + + # astrometry keywords which are copied directly + if ($line =~ /NASTRO =/) { $Nastro = substr ($line, 10, 21); } + + if ($line =~ /CTYPE1 =/) { @astrom = (@astrom, $line);} + if ($line =~ /CTYPE2 =/) { @astrom = (@astrom, $line);} + if ($line =~ /CRPIX1 =/) { @astrom = (@astrom, $line);} + if ($line =~ /CRPIX2 =/) { @astrom = (@astrom, $line);} + if ($line =~ /CRVAL1 =/) { @astrom = (@astrom, $line);} + if ($line =~ /CRVAL2 =/) { @astrom = (@astrom, $line);} +# if ($line =~ /NASTRO =/) { @astrom = (@astrom, $line); $Nastro = substr ($line, 10, 21); } +# if ($line =~ /CERROR =/) { @astrom = (@astrom, $line);} + if ($line =~ /EQUINOX =/) { @astrom = (@astrom, $line);} + + # convert the PC00i00j matrix & CDELTi to CDi_j + if ($line =~ /PC001001=/) { $pc11 = substr ($line, 10, 21); } + if ($line =~ /PC001002=/) { $pc12 = substr ($line, 10, 21); } + if ($line =~ /PC002001=/) { $pc21 = substr ($line, 10, 21); } + if ($line =~ /PC002002=/) { $pc22 = substr ($line, 10, 21); } + if ($line =~ /CDELT1 =/) { $cd1 = substr ($line, 10, 21); } + if ($line =~ /CDELT2 =/) { $cd2 = substr ($line, 10, 21); } +} + +# check for validity of astrometry data +if ($Nastro == 0) { + print STDERR "can't find all astrometry keywords from $infile\n"; + @astrom = ($line); +} else { + # convert the pc, cdelt terms to cd terms + $cd11 = $cd1*$pc11; + $cd12 = $cd2*$pc12; + $cd21 = $cd1*$pc21; + $cd22 = $cd2*$pc22; + $line = sprintf "CD1_1 = %20G / WCS Coordinate scale matrix ", $cd11; @astrom = (@astrom, $line); + $line = sprintf "CD1_2 = %20G / WCS Coordinate scale matrix ", $cd12; @astrom = (@astrom, $line); + $line = sprintf "CD2_1 = %20G / WCS Coordinate scale matrix ", $cd21; @astrom = (@astrom, $line); + $line = sprintf "CD2_2 = %20G / WCS Coordinate scale matrix ", $cd22; @astrom = (@astrom, $line); +} + +# write output to file +foreach $line (@astrom) { + $hedit = convert_to_hedit ($line); + # print STDOUT "$line\n"; + print STDOUT "$hedit\n"; +} + +exit 0; + +################################################################################### + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +# load FITS header lines (up to including END) +sub load_header { + + my ($file) = $_[0]; + my ($buffer, $done, @buffer, $line); + + open (FILE, "$file"); + + $done = 0; + @buffer = (); + + while (! $done) { + read FILE, $buffer, 2880; + for ($i = 0; $i < 2880; $i+=80) { + $line = substr ($buffer, $i, 80); + if (! $done) { + @buffer = (@buffer, $line); + } + if ($line =~ /^END /) { $done = 1; } + } + } + close (FILE); + return (@buffer); +} + +sub convert_to_hedit { + + my ($line) = $_[0]; + my ($hedit, $keyword, $value); + + $keyword = substr ($line, 0, 8); + $value = substr ($line, 10, 21); + + $hedit = sprintf "hedit $efile $keyword $value ver- show-"; + return ($hedit); +} Index: /trunk/Ohana/src/perl/src/validate =================================================================== --- /trunk/Ohana/src/perl/src/validate (revision 17) +++ /trunk/Ohana/src/perl/src/validate (revision 17) @@ -0,0 +1,309 @@ +#!/usr/bin/env perl + +# validate +# -update sends the validation value to the QSO database +# 1 - valid image +# 2 - subvalid image (problem, but doesn't matter) +# 3 - invalid image +# 4 - data error (missing, corrupted image) + +# global constants: + +$TRUE = 1; +$FALSE = 0; +$RETRY = $TRUE; + +$PASS = (0 << 8); +$FAIL = (1 << 8); +$SUBVALID = (2 << 8); +$DATA_ERR = (3 << 8); + +$MODE_UNSET = 0; +$MODE_VALID = 1; +$MODE_SUBVALID = 2; +$MODE_INVALID = 3; +$MODE_DATAERR = 4; + +$STATS = $FALSE; +$update = $FALSE; + +$infile = ""; + +# include the CFHT bin directory in the path so we have access to QSO functions: +$ENV{'PATH'} = "$ENV{'PATH'}:/cfht/bin"; + +# grab the command line arguments: +@tARGV = (); +for (; @ARGV > 0; ) { + + if ($ARGV[0] eq "-stats") { + shift; + $STATS = $TRUE; + next; + } + if ($ARGV[0] eq "-update") { + shift; + $update = $TRUE; + next; + } + if ($ARGV[0] eq "-skip") { + shift; + $RETRY = $FALSE; + next; + } + if ($ARGV[0] eq "-infile") { + shift; + $infile = $ARGV[0]; + shift; + next; + } + + @tARGV = (@tARGV, $ARGV[0]); + shift; +} +@ARGV = @tARGV; + +if (@ARGV != 1) { die "USAGE: validate (crunid) [-infile filename] [-update]\n" ;} + +$crunid = $ARGV[0]; + +$answer = `mkrun run $crunid`; +if ($?) { die "ERROR finding run id: $crunid\n"; } +($id, $start, $stop, $camera, $qrunid) = split (" ", $answer); +# qrunid is space-separated (change?) +if ($id ne $crunid) { die "ERROR with run id: $crunid\n"; } +print STDERR "qso run ID(s): $qrunid\n"; + +@valid = (); +@invalid = (); +@dataerr = (); +@subvalid = (); + +if ($infile) { + # load images from previous output run or source file: + open (FILE, $infile); + @rawlist = ; + close (FILE); + + $mode = $MODE_UNSET; + @imlist = (); + + RAWLIST: + foreach $name (@rawlist) { + chop ($name); + + if ($name eq "") { next RAWLIST; } + + if ($name =~ /^valid images/) { + $mode = $MODE_VALID; + next RAWLIST; + } + if ($name =~ /^invalid images/) { + $mode = $MODE_INVALID; + next RAWLIST; + } + if ($name =~ /^subvalid images/) { + $mode = $MODE_SUBVALID; + next RAWLIST; + } + if ($name =~ /^dataerr images/) { + $mode = $MODE_DATAERR; + next RAWLIST; + } + + # plain list of image names (/path/name.fits) + if ($mode == $MODE_UNSET) { + # double check on name validity + ($file, $junk) = split (" ", $name, 2); + unless ($file =~ /\d\d\d\d\d\d\w/) { print STDERR "?"; next RAWLIST; } + @imlist = (@imlist, $file); + next RAWLIST; + } + + # ($file) = split (" ", $name); + $file = $name; + # place image names in the appropriate list + if ($mode == $MODE_VALID) { + @valid = (@valid, $file); + next RAWLIST; + } + if ($mode == $MODE_INVALID) { + @invalid = (@invalid, $file); + next RAWLIST; + } + if ($mode == $MODE_SUBVALID) { + @subvalid = (@subvalid, $file); + next RAWLIST; + } + if ($mode == $MODE_DATAERR) { + @dataerr = (@dataerr, $file); + next RAWLIST; + } + } +} else { + # load images directly from directory + # this is not sufficient. we need a better way to get a list of images for + # a given run id (with the current MEF / SPLIT state correct). + # + # probably we can just use imsearch -ccd 0 + $rawdir = `gconfig -q -D RUNID $crunid RAWDIR`; + chop ($rawdir); + if ($rawdir eq "") { + print STDERR "can't find config entry RAWDIR\n"; + exit 1; + } + @imlist = (); + + # load in the MEF files (must be of format 123456x.fits) + @tlist = <$rawdir/*.fits>; + foreach $tname (@tlist) { + if ((-f $tname) && ($tname =~ /\d\d\d\d\d\d\w.fits/)) { + @imlist = (@imlist, $tname); + } + } + + # load in the SPLIT directories (must be of format 123456x) + @tlist = <$rawdir/???????>; + foreach $tname (@tlist) { + if ((-d $tname) && ($tname =~ /\d\d\d\d\d\d\w/)) { + @imlist = (@imlist, $tname); + } + } +} + +if ($STATS) { + $Nvalid = @valid; + $Ninvalid = @invalid; + $Nsubvalid = @subvalid; + $Ndataerr = @dataerr; + + print STDOUT "valid $Nvalid\n"; + print STDOUT "invalid $Ninvalid\n"; + print STDOUT "subvalid $Nsubvalid\n"; + print STDOUT "dataerr $Ndataerr\n"; + exit 0; +} + +# load the QSO validated image list +@qsovalid = (); +if ($qrunid) { + @qruns = split (",", $qrunid); + @qsovalid = (); + foreach $id (@qruns) { + print STDERR "$id:\n"; + @answer = `select_val_xexp.sh -U qso_elixir -P op1eliw -qrunid $id`; + if ($?) { + print STDERR "error in qso run ID\n"; + exit 1; + } + @qsovalid = (@qsovalid, @answer); + } +} +# create qsostate hash to quickly find valid qso images +foreach $qline (@qsovalid) { + chop ($qline); + ($qname, $qeval, $eval, $seval) = split (" ", $qline); + $qsostate{$qname} = 1; +} + +if ($RETRY) { +# evaluate the remaining entries in imlist & invalid: + @imlist = (@imlist, @invalid, @dataerr); + @invalid = (); + @dataerr = (); + + IMLIST: + foreach $line (@imlist) { + ($name) = split (" ", $line); + @words = split ("/", $name); + $tmp = $words[-1]; + ($obsid) = $tmp =~ /(\d\d\d\d\d\d\w)/; + + $answer = `ckvalid $name`; chop ($answer); + $status = $?; + if ($status) { + print STDERR "-"; + } else { + print STDERR "+"; + } + + ($file, $mode, $type, $runid, $state) = split (" ", $answer, 2); + + if ($status == $PASS) { + @valid = (@valid, $answer); + next IMLIST; + } + if ($status == $SUBVALID) { + @subvalid = (@subvalid, $answer); + next IMLIST; + } + if ($status == $DATA_ERR) { + @dataerr = (@dataerr, $answer); + next IMLIST; + } + + # subvalid if not in qso list + if ($status == $FAIL) { + # are we in QSO list? + if ($qsostate{$obsid}) { + @invalid = (@invalid, $answer); + next IMLIST; + } else { + @subvalid = (@subvalid, $answer); + next IMLIST; + } + } + print STDERR "unknown result $answer\n"; + } +} + +@mode = ('valid', 'subvalid', 'invalid', 'dataerr'); +@code = ($MODE_VALID, $MODE_SUBVALID, $MODE_INVALID, $MODE_DATAERR); + +for ($i = 0; $i < @mode; $i++) { + $mode = $mode[$i]; + $code = $code[$i]; + + print STDOUT "$mode images\n"; + foreach $line (@$mode) { + print STDOUT "$line\n"; + if ($update) { + ($file, $mode, $type, $runid, $state) = split (" ", $line, 5); + $seval = get_seval ($state); + + @w = split ("/", $file); + $n = substr ($w[-1], 0, 6); + # print STDERR "update_xexpe.sh -U qso_elixir -P op1eliw --obsid $n --eval $code --Seval $seval >> test.list\n"; + vsystem ("update_xexpe.sh -U qso_elixir -P op1eliw --obsid $n --eval 0 --Seval $seval >> xexpe.list"); + } + } + print STDOUT "\n"; +} + +sub get_seval { + + my($state) = $_[0]; + my (@evals, $seval); + + @evals = split (" ", $state); + + $seval = ""; + if ($evals[0]) { $seval = $seval . "t"; } else { $seval = $seval . "f"; } # DATA + if ($evals[1]) { $seval = $seval . "t"; } else { $seval = $seval . "f"; } # DETREND + $seval = $seval . "-"; + if ($evals[2]) { $seval = $seval . "t"; } else { $seval = $seval . "f"; } # PHOTOM + if ($evals[3]) { $seval = $seval . "t"; } else { $seval = $seval . "f"; } # ASTROM + + return ($seval); +} + +sub vsystem { + print STDERR "@_\n"; + my($status) = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + Index: /trunk/Ohana/src/perl/src/wfi.keywords =================================================================== --- /trunk/Ohana/src/perl/src/wfi.keywords (revision 17) +++ /trunk/Ohana/src/perl/src/wfi.keywords (revision 17) @@ -0,0 +1,110 @@ +#!/usr/bin/env perl + +$version = 1.0; +$Nccd = `cameraconfig -Nccd`; chop ($Nccd); + +if (@ARGV != 2) { die "USAGE: grab.keywords (fitsfile) (hdrfile)\n" ; } + +$fitsfile = $ARGV[0]; # input image file +$hdrfile = $ARGV[1]; # hdr file for fits_insert + +@header = `fhead $fitsfile`; + +@newhead = (); +# grab lines from primary header +foreach $line (@header) { + # astrometry keywords which are copied directly + if ($line =~ /HIERARCH ESO INS FILT NAME =/) { + @word = split ("'", $line); + $newline = sprintf "FILTER = '%-18s' / %-46s \n", $word[1], "Filter name"; + @newhead = (@newhead, $newline); + } + if ($line =~ /HIERARCH ESO DPR TYPE =/) { + @word = split ("'", $line); + $value = @word[1]; + if ($value eq "SKY") { $value = "OBJECT"; } + if ($value eq "SKY,FLAT") { $value = "FLAT"; } + if ($value eq "DOME,FLAT") { $value = "FLAT"; } + $newline = sprintf "OBSTYPE = '%-18s' / %-46s \n", $value, "Obs Type"; + @newhead = (@newhead, $newline); + } + if ($line =~ /HIERARCH ESO TEL AIRM START =/) { + ($value) = $line =~ /HIERARCH ESO TEL AIRM START = \s*(\S+)/; + $newline = sprintf "AIRMASS = %20.10f / %-46s \n", $value, "Airmass"; + @newhead = (@newhead, $newline); + } + if ($line =~ /HIERARCH ESO TEL FOCU VALUE =/) { + ($value) = $line =~ /HIERARCH ESO TEL FOCU VALUE = \s*(\S+)/; + $newline = sprintf "FOCUS = %20.10f / %-46s \n", $value, "Focus Value"; + @newhead = (@newhead, $newline); + } + if ($line =~ /HIERARCH ESO INS SIGNAL1 ST =/) { + ($value) = $line =~ /HIERARCH ESO INS SIGNAL1 ST = \s*(\S+)/; + $newline = sprintf "SIGNAL1 = %20.10f / %-46s \n", $value, "Detector temp"; + @newhead = (@newhead, $newline); + } + if ($line =~ /HIERARCH ESO INS SIGNAL2 ST =/) { + ($value) = $line =~ /HIERARCH ESO INS SIGNAL2 ST = \s*(\S+)/; + $newline = sprintf "SIGNAL2 = %20.10f / %-46s \n", $value, "Electronic temp"; + @newhead = (@newhead, $newline); + } + if ($line =~ /HIERARCH ESO INS SIGNAL3 ST =/) { + ($value) = $line =~ /HIERARCH ESO INS SIGNAL3 ST = \s*(\S+)/; + $newline = sprintf "SIGNAL3 = %20.10f / %-46s \n", $value, "Barom press"; + @newhead = (@newhead, $newline); + } + $newline = sprintf "ROTATE = %20.10f / %-46s \n", 0.0, "Barom press"; + @newhead = (@newhead, $newline); + $newline = sprintf "NEXTEND = %20d / %-46s \n", $Nccd, "Nextend"; + @newhead = (@newhead, $newline); +} + +for ($i = 0; $i < $Nccd; $i++) { + @chiphead = (); + @header = `ftable -X $i $fitsfile`; + foreach $line (@header) { + if ($line =~ /HIERARCH ESO DET CHIP\d INDEX=/) { + ($value) = $line =~ /HIERARCH ESO DET CHIP\d INDEX= \s*(\S+)/; +# $newline = sprintf "CHIPID = %20d / %-46s \n", $value, "Detector ID"; +# @chiphead = (@chiphead, $newline); + $newline = sprintf "IMAGEID = %20d / %-46s \n", $value, "Detector ID"; + @chiphead = (@chiphead, $newline); + last; + } + } + + # write output to file + open (FILE, ">$hdrfile"); + foreach $line (@newhead) { + print FILE "$line"; + } + foreach $line (@chiphead) { + print FILE "$line"; + } + close (FILE); + + system ("fits_insert -X $i $fitsfile $hdrfile"); + if ($?) { die "problem with extension $i\n"; } +} + +# write output to file +open (FILE, ">$hdrfile"); +foreach $line (@newhead) { + print FILE "$line"; +} +system ("fits_insert $fitsfile $hdrfile"); +if ($?) { die "problem with phu\n"; } + +exit 0; + +################################################################################### + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +}