diff --git a/Makefile b/Makefile index c09f9b2d..477a1161 100644 --- a/Makefile +++ b/Makefile @@ -7,9 +7,9 @@ SRC = starcheck/src RELATED_LIB = $(SRC)/StarcheckParser.pm BIN = $(SRC)/starcheck.pl $(SRC)/starcheck LIB = $(SRC)/lib/Ska/Starcheck/Obsid.pm \ - $(SRC)/lib/Ska/Starcheck/Dark_Cal_Checker.pm $(SRC)/lib/Ska/Parse_CM_File.pm + $(SRC)/lib/Ska/Parse_CM_File.pm PYTHON_LIB = starcheck/calc_ccd_temps.py starcheck/pcad_att_check.py starcheck/plot.py \ - starcheck/version.py starcheck/__init__.py + starcheck/utils.py starcheck/__init__.py DOC_RST = $(SRC)/aca_load_review_cl.rst DOC_HTML = aca_load_review_cl.html @@ -23,7 +23,6 @@ TEST_BACKSTOP = JUL0918A/CR190_0603.backstop DATA_FILES = starcheck/data/aca_spec.json starcheck/data/ACABadPixels starcheck/data/agasc.bad \ starcheck/data/fid_CHARACTERIS_JUL01 starcheck/data/fid_CHARACTERIS_FEB07 \ starcheck/data/fid_CHARACTERISTICS starcheck/data/characteristics.yaml \ - starcheck/data/A.tlr starcheck/data/B.tlr starcheck/data/tlr.cfg \ starcheck/data/overlib.js starcheck/data/up.gif starcheck/data/down.gif \ SHA_FILES = ${SKA_ARCH_OS}/bin/ska_version $(BIN) $(LIB) \ diff --git a/sandbox_starcheck b/sandbox_starcheck index 03114591..89b9c04b 100755 --- a/sandbox_starcheck +++ b/sandbox_starcheck @@ -14,7 +14,7 @@ then exit 1 fi # Check for perl deps -perl -e "use IO::All; use Time::DayOfYear;" +perl -e "use IO::All;" if [[ $? -ne 0 ]]; then echo "****" diff --git a/starcheck/data/A.tlr b/starcheck/data/A.tlr deleted file mode 100644 index 8f7dddef..00000000 --- a/starcheck/data/A.tlr +++ /dev/null @@ -1,222 +0,0 @@ - 2000:001:00:00:00.000 AAC1CCSC 34B 60C0 - 350 A000 - 358 0080 - 343 59E0 - 35F 83A0 - 348 3260 - 350 0000 - 2000:001:00:11:30.000 AOFUNCDS 0 803 0203 - 2000:001:00:12:00.000 CIMODESL 0 7C0 6BA0 - 2000:001:00:12:20.000 AAC1CCSC 0 35B 8060 - 34C C000 - 35C 4000 - 354 2700 - 2000:001:00:13:05.000 AAC1CCSC 0 35A 8060 - 34D C000 - 35C 4000 - 354 2700 - 2000:001:00:13:50.000 AAC1CCSC 0 35C 4060 - 34C 3FE0 - 35C 4000 - 354 2700 - 2000:001:00:14:35.000 AAC1CCSC 0 35B 4060 - 34D 3FE0 - 35C 4000 - 354 2700 - 2000:001:00:15:20.000 AAC1CCSC 0 354 6060 - 34C C000 - 35C 4000 - 354 4E00 - 2000:001:00:16:50.000 AAC1CCSC 0 353 6060 - 34D C000 - 35C 4000 - 354 4E00 - 2000:001:00:18:20.000 AAC1CCSC 0 355 2060 - 34C 3FE0 - 35C 4000 - 354 4E00 - 2000:001:00:19:50.000 AAC1CCSC 0 354 2060 - 34D 3FE0 - 35C 4000 - 354 4E00 - 2000:001:00:21:20.000 AAC1CCSC 0 35D 2060 - 34D 3FE0 - 35C 0000 - 354 0580 - 2000:001:00:21:50.000 CIMODESL 0 7C0 63A0 - 2000:001:00:22:20.000 AOFUNCEN 0 803 0303 - 2000:001:00:22:30.000 AOSETINT 0 813 2B01 - 8A3 0001 - A06 A000 - 2000:001:00:54:30.000 AOFUNCDS 1 803 0203 - 2000:001:00:55:00.000 CIMODESL 1 7C0 6BA0 - 2000:001:00:55:20.000 AAC1CCSC 1 35B 0060 - 34C C000 - 35C C000 - 354 2700 - 2000:001:00:56:05.000 AAC1CCSC 1 35A 0060 - 34D C000 - 35C C000 - 354 2700 - 2000:001:00:56:50.000 AAC1CCSC 1 35B C060 - 34C 3FE0 - 35C C000 - 354 2700 - 2000:001:00:57:35.000 AAC1CCSC 1 35A C060 - 34D 3FE0 - 35C C000 - 354 2700 - 2000:001:00:58:20.000 AAC1CCSC 1 353 E060 - 34C C000 - 35C C000 - 354 4E00 - 2000:001:00:59:50.000 AAC1CCSC 1 352 E060 - 34D C000 - 35C C000 - 354 4E00 - 2000:001:01:01:20.000 AAC1CCSC 1 354 A060 - 34C 3FE0 - 35C C000 - 354 4E00 - 2000:001:01:02:50.000 AAC1CCSC 1 353 A060 - 34D 3FE0 - 35C C000 - 354 4E00 - 2000:001:01:04:20.000 AAC1CCSC 1 35C A060 - 34D 3FE0 - 35C 8000 - 354 0580 - 2000:001:01:04:50.000 CIMODESL 1 7C0 63A0 - 2000:001:01:05:20.000 AOFUNCEN 1 803 0303 - 2000:001:01:05:30.000 AOSETINT 1 813 2B01 - 8A3 0001 - A06 A000 - 2000:001:01:37:30.000 AOFUNCDS 2 803 0203 - 2000:001:01:38:00.000 CIMODESL 2 7C0 6BA0 - 2000:001:01:38:20.000 AAC1CCSC 2 35A 8060 - 34C C000 - 35D 4000 - 354 2700 - 2000:001:01:39:05.000 AAC1CCSC 2 359 8060 - 34D C000 - 35D 4000 - 354 2700 - 2000:001:01:39:50.000 AAC1CCSC 2 35B 4060 - 34C 3FE0 - 35D 4000 - 354 2700 - 2000:001:01:40:35.000 AAC1CCSC 2 35A 4060 - 34D 3FE0 - 35D 4000 - 354 2700 - 2000:001:01:41:20.000 AAC1CCSC 2 353 6060 - 34C C000 - 35D 4000 - 354 4E00 - 2000:001:01:42:50.000 AAC1CCSC 2 352 6060 - 34D C000 - 35D 4000 - 354 4E00 - 2000:001:01:44:20.000 AAC1CCSC 2 354 2060 - 34C 3FE0 - 35D 4000 - 354 4E00 - 2000:001:01:45:50.000 AAC1CCSC 2 353 2060 - 34D 3FE0 - 35D 4000 - 354 4E00 - 2000:001:01:47:20.000 AAC1CCSC 2 35C 2060 - 34D 3FE0 - 35D 0000 - 354 0580 - 2000:001:01:47:50.000 CIMODESL 2 7C0 63A0 - 2000:001:01:48:20.000 AOFUNCEN 2 803 0303 - 2000:001:01:48:30.000 AOSETINT 2 813 2B01 - 8A3 0001 - A06 A000 - 2000:001:02:20:30.000 AOFUNCDS 3 803 0203 - 2000:001:02:21:00.000 CIMODESL 3 7C0 6BA0 - 2000:001:02:21:20.000 AAC1CCSC 3 35A 0060 - 34C C000 - 35D C000 - 354 2700 - 2000:001:02:22:05.000 AAC1CCSC 3 359 0060 - 34D C000 - 35D C000 - 354 2700 - 2000:001:02:22:50.000 AAC1CCSC 3 35A C060 - 34C 3FE0 - 35D C000 - 354 2700 - 2000:001:02:23:35.000 AAC1CCSC 3 359 C060 - 34D 3FE0 - 35D C000 - 354 2700 - 2000:001:02:24:20.000 AAC1CCSC 3 352 E060 - 34C C000 - 35D C000 - 354 4E00 - 2000:001:02:25:50.000 AAC1CCSC 3 351 E060 - 34D C000 - 35D C000 - 354 4E00 - 2000:001:02:27:20.000 AAC1CCSC 3 353 A060 - 34C 3FE0 - 35D C000 - 354 4E00 - 2000:001:02:28:50.000 AAC1CCSC 3 352 A060 - 34D 3FE0 - 35D C000 - 354 4E00 - 2000:001:02:30:20.000 AAC1CCSC 3 35B A060 - 34D 3FE0 - 35D 8000 - 354 0580 - 2000:001:02:30:50.000 CIMODESL 3 7C0 63A0 - 2000:001:02:31:20.000 AOFUNCEN 3 803 0303 - 2000:001:02:31:30.000 AOSETINT 3 813 2B01 - 8A3 0001 - A06 A000 - 2000:001:03:03:30.000 AOFUNCDS 4 803 0203 - 2000:001:03:04:00.000 CIMODESL 4 7C0 6BA0 - 2000:001:03:04:20.000 AAC1CCSC 4 359 8060 - 34C C000 - 35E 4000 - 354 2700 - 2000:001:03:05:05.000 AAC1CCSC 4 358 8060 - 34D C000 - 35E 4000 - 354 2700 - 2000:001:03:05:50.000 AAC1CCSC 4 35A 4060 - 34C 3FE0 - 35E 4000 - 354 2700 - 2000:001:03:06:35.000 AAC1CCSC 4 359 4060 - 34D 3FE0 - 35E 4000 - 354 2700 - 2000:001:03:07:20.000 AAC1CCSC 4 352 6060 - 34C C000 - 35E 4000 - 354 4E00 - 2000:001:03:08:50.000 AAC1CCSC 4 351 6060 - 34D C000 - 35E 4000 - 354 4E00 - 2000:001:03:10:20.000 AAC1CCSC 4 353 2060 - 34C 3FE0 - 35E 4000 - 354 4E00 - 2000:001:03:11:50.000 AAC1CCSC 4 352 2060 - 34D 3FE0 - 35E 4000 - 354 4E00 - 2000:001:03:13:20.000 AAC1CCSC 4 35B 2060 - 34D 3FE0 - 35E 0000 - 354 0580 - 2000:001:03:13:50.000 CIMODESL 4 7C0 63A0 - 2000:001:03:14:20.000 AOFUNCEN 4 803 0303 - 2000:001:03:14:30.000 AOSETINT 4 813 2B01 - 8A3 0001 - A06 A000 diff --git a/starcheck/data/B.tlr b/starcheck/data/B.tlr deleted file mode 100644 index 11d6d3ff..00000000 --- a/starcheck/data/B.tlr +++ /dev/null @@ -1,222 +0,0 @@ - 2000:001:00:00:00.000 AAC1CCSC 34B 60C0 - 350 A000 - 358 0080 - 343 59E0 - 35F 83A0 - 348 3260 - 350 0000 - 2000:001:00:11:30.000 AOFUNCDS 0 803 0203 - 2000:001:00:12:00.000 CIMODESL 0 7C0 6FA0 - 2000:001:00:12:20.000 AAC1CCSC 0 35B 8060 - 34C C000 - 35C 4000 - 354 2700 - 2000:001:00:13:05.000 AAC1CCSC 0 35A 8060 - 34D C000 - 35C 4000 - 354 2700 - 2000:001:00:13:50.000 AAC1CCSC 0 35C 4060 - 34C 3FE0 - 35C 4000 - 354 2700 - 2000:001:00:14:35.000 AAC1CCSC 0 35B 4060 - 34D 3FE0 - 35C 4000 - 354 2700 - 2000:001:00:15:20.000 AAC1CCSC 0 354 6060 - 34C C000 - 35C 4000 - 354 4E00 - 2000:001:00:16:50.000 AAC1CCSC 0 353 6060 - 34D C000 - 35C 4000 - 354 4E00 - 2000:001:00:18:20.000 AAC1CCSC 0 355 2060 - 34C 3FE0 - 35C 4000 - 354 4E00 - 2000:001:00:19:50.000 AAC1CCSC 0 354 2060 - 34D 3FE0 - 35C 4000 - 354 4E00 - 2000:001:00:21:20.000 AAC1CCSC 0 35D 2060 - 34D 3FE0 - 35C 0000 - 354 0580 - 2000:001:00:21:50.000 CIMODESL 0 7C0 67A0 - 2000:001:00:22:20.000 AOFUNCEN 0 803 0303 - 2000:001:00:22:30.000 AOSETINT 0 813 2B01 - 8A3 0001 - A06 A000 - 2000:001:00:54:30.000 AOFUNCDS 1 803 0203 - 2000:001:00:55:00.000 CIMODESL 1 7C0 6FA0 - 2000:001:00:55:20.000 AAC1CCSC 1 35B 0060 - 34C C000 - 35C C000 - 354 2700 - 2000:001:00:56:05.000 AAC1CCSC 1 35A 0060 - 34D C000 - 35C C000 - 354 2700 - 2000:001:00:56:50.000 AAC1CCSC 1 35B C060 - 34C 3FE0 - 35C C000 - 354 2700 - 2000:001:00:57:35.000 AAC1CCSC 1 35A C060 - 34D 3FE0 - 35C C000 - 354 2700 - 2000:001:00:58:20.000 AAC1CCSC 1 353 E060 - 34C C000 - 35C C000 - 354 4E00 - 2000:001:00:59:50.000 AAC1CCSC 1 352 E060 - 34D C000 - 35C C000 - 354 4E00 - 2000:001:01:01:20.000 AAC1CCSC 1 354 A060 - 34C 3FE0 - 35C C000 - 354 4E00 - 2000:001:01:02:50.000 AAC1CCSC 1 353 A060 - 34D 3FE0 - 35C C000 - 354 4E00 - 2000:001:01:04:20.000 AAC1CCSC 1 35C A060 - 34D 3FE0 - 35C 8000 - 354 0580 - 2000:001:01:04:50.000 CIMODESL 1 7C0 67A0 - 2000:001:01:05:20.000 AOFUNCEN 1 803 0303 - 2000:001:01:05:30.000 AOSETINT 1 813 2B01 - 8A3 0001 - A06 A000 - 2000:001:01:37:30.000 AOFUNCDS 2 803 0203 - 2000:001:01:38:00.000 CIMODESL 2 7C0 6FA0 - 2000:001:01:38:20.000 AAC1CCSC 2 35A 8060 - 34C C000 - 35D 4000 - 354 2700 - 2000:001:01:39:05.000 AAC1CCSC 2 359 8060 - 34D C000 - 35D 4000 - 354 2700 - 2000:001:01:39:50.000 AAC1CCSC 2 35B 4060 - 34C 3FE0 - 35D 4000 - 354 2700 - 2000:001:01:40:35.000 AAC1CCSC 2 35A 4060 - 34D 3FE0 - 35D 4000 - 354 2700 - 2000:001:01:41:20.000 AAC1CCSC 2 353 6060 - 34C C000 - 35D 4000 - 354 4E00 - 2000:001:01:42:50.000 AAC1CCSC 2 352 6060 - 34D C000 - 35D 4000 - 354 4E00 - 2000:001:01:44:20.000 AAC1CCSC 2 354 2060 - 34C 3FE0 - 35D 4000 - 354 4E00 - 2000:001:01:45:50.000 AAC1CCSC 2 353 2060 - 34D 3FE0 - 35D 4000 - 354 4E00 - 2000:001:01:47:20.000 AAC1CCSC 2 35C 2060 - 34D 3FE0 - 35D 0000 - 354 0580 - 2000:001:01:47:50.000 CIMODESL 2 7C0 67A0 - 2000:001:01:48:20.000 AOFUNCEN 2 803 0303 - 2000:001:01:48:30.000 AOSETINT 2 813 2B01 - 8A3 0001 - A06 A000 - 2000:001:02:20:30.000 AOFUNCDS 3 803 0203 - 2000:001:02:21:00.000 CIMODESL 3 7C0 6FA0 - 2000:001:02:21:20.000 AAC1CCSC 3 35A 0060 - 34C C000 - 35D C000 - 354 2700 - 2000:001:02:22:05.000 AAC1CCSC 3 359 0060 - 34D C000 - 35D C000 - 354 2700 - 2000:001:02:22:50.000 AAC1CCSC 3 35A C060 - 34C 3FE0 - 35D C000 - 354 2700 - 2000:001:02:23:35.000 AAC1CCSC 3 359 C060 - 34D 3FE0 - 35D C000 - 354 2700 - 2000:001:02:24:20.000 AAC1CCSC 3 352 E060 - 34C C000 - 35D C000 - 354 4E00 - 2000:001:02:25:50.000 AAC1CCSC 3 351 E060 - 34D C000 - 35D C000 - 354 4E00 - 2000:001:02:27:20.000 AAC1CCSC 3 353 A060 - 34C 3FE0 - 35D C000 - 354 4E00 - 2000:001:02:28:50.000 AAC1CCSC 3 352 A060 - 34D 3FE0 - 35D C000 - 354 4E00 - 2000:001:02:30:20.000 AAC1CCSC 3 35B A060 - 34D 3FE0 - 35D 8000 - 354 0580 - 2000:001:02:30:50.000 CIMODESL 3 7C0 67A0 - 2000:001:02:31:20.000 AOFUNCEN 3 803 0303 - 2000:001:02:31:30.000 AOSETINT 3 813 2B01 - 8A3 0001 - A06 A000 - 2000:001:03:03:30.000 AOFUNCDS 4 803 0203 - 2000:001:03:04:00.000 CIMODESL 4 7C0 6FA0 - 2000:001:03:04:20.000 AAC1CCSC 4 359 8060 - 34C C000 - 35E 4000 - 354 2700 - 2000:001:03:05:05.000 AAC1CCSC 4 358 8060 - 34D C000 - 35E 4000 - 354 2700 - 2000:001:03:05:50.000 AAC1CCSC 4 35A 4060 - 34C 3FE0 - 35E 4000 - 354 2700 - 2000:001:03:06:35.000 AAC1CCSC 4 359 4060 - 34D 3FE0 - 35E 4000 - 354 2700 - 2000:001:03:07:20.000 AAC1CCSC 4 352 6060 - 34C C000 - 35E 4000 - 354 4E00 - 2000:001:03:08:50.000 AAC1CCSC 4 351 6060 - 34D C000 - 35E 4000 - 354 4E00 - 2000:001:03:10:20.000 AAC1CCSC 4 353 2060 - 34C 3FE0 - 35E 4000 - 354 4E00 - 2000:001:03:11:50.000 AAC1CCSC 4 352 2060 - 34D 3FE0 - 35E 4000 - 354 4E00 - 2000:001:03:13:20.000 AAC1CCSC 4 35B 2060 - 34D 3FE0 - 35E 0000 - 354 0580 - 2000:001:03:13:50.000 CIMODESL 4 7C0 67A0 - 2000:001:03:14:20.000 AOFUNCEN 4 803 0303 - 2000:001:03:14:30.000 AOSETINT 4 813 2B01 - 8A3 0001 - A06 A000 diff --git a/starcheck/data/tlr.cfg b/starcheck/data/tlr.cfg deleted file mode 100644 index 0bb1da81..00000000 --- a/starcheck/data/tlr.cfg +++ /dev/null @@ -1,231 +0,0 @@ -# Config file for ACA Dark Cal Checker -# Presently used by DarkCalChecker.pm - -# Designed for use for Config::General.pm - -# First section specifies the format of the TLR file -# Here's the "header" from within the file - - -# _____________________ ________ ______________ _ ____________________________________ ________ ______________ ________ ___ ________ -#| GMT | Orbit | Command |C| Command | Command| Trace | OBC |OBC|SCS|Step| -#| (extended) | /DSN | Mnemonic |r| Description | Data | ID | Clock |ID | | -#| | Event | |t| | (Hex) | | | | | -#|_____________________|________|______________|_|____________________________________|________|______________|________|___|________| -# 2005:311:06:14:17.003 COSATDLY NA//NA//-2//0 97C 80AF 16548015 A 130| 1 - -# Format of the TLR where start and stop specify the range of text -# columns of the field - - - - start 2 - stop 22 - - - start 24 - stop 31 - - - start 33 - stop 46 - - - start 48 - stop 48 - - - start 50 - stop 85 - - - start 96 - stop 109 - - - start 111 - stop 118 - - - start 120 - stop 122 - - - start 124 - stop 126 - - - start 128 - stop 131 - - - start 87 - stop 94 - - - -# Format of the template files - - - - start 2 - stop 22 - - - start 24 - stop 31 - - - start 35 - stop 36 - - - start 39 - stop 46 - - - -# Names of the template files, one for each transponder - - - A A.tlr - B B.tlr - - -# List of command mnemonics found within the template files - - - - - - - - - -# Transponder-independent commands -# Dither enable, Dither disable, set Dither Parameters -# The checker will search for, and match, these commands - - - -# Command sequence to enable the A transponder - - - - -# Details about the maneuvers, to be compared against the -# maneuver summary - - - - - - - - - -# hash to hold expected number of times that we maneuver to or from replicas - - - -# defined times (that are slightly arbitrary - - diff --git a/starcheck/src/dark_regress b/starcheck/src/dark_regress deleted file mode 100755 index fa6bd20a..00000000 --- a/starcheck/src/dark_regress +++ /dev/null @@ -1,199 +0,0 @@ -#! /bin/sh - -# Comprehensive regression tests for starcheck - -RunRegression() -# Run regression tests. -# Arg 1 is the AGASC version (e.g. 1p5) -# Arg 2 is the fid characteristics name (e.g. fid_CHARACTERIS_FEB07) -{ - echo "" - echo "***** Running starcheck on load $load *****" - - agasc=${1} - fid_char=${2} - - test=$regtestdir/$load - release=$home/test_regress/release/$load - - # Make sure we have a clean test directory - if [ -d $test ] - then - echo "rm -r $test" - rm -r $test - fi - - echo "mkdir -p $test" - mkdir -p $test - - # Vehicle Block - - if [ -d $mphome/$load/vehicle ] - then - echo "cd $test" - cd $test - - - # Run test version. Use the 'starcheck' launcher to activate the dev environment - # - echo "Running: ${home}/sandbox_starcheck -vehicle -agasc $agasc -fid_char $fid_char -dir $mphome/$load" - echo "******************** (TEST VEHICLE) $load *******************" >> $vlog - ${home}/sandbox_starcheck -vehicle -agasc $agasc -fid_char $fid_char -dir $mphome/$load 2>&1| tee -a $vlog - # cut first 4 lines and replace test ska with release to make cleaner diffs - perl -n -i.bak -e 'print if $. > 3' $test/v_starcheck.txt - perl -p -i -e "s{$SKA}{$RELEASE}" $test/v_starcheck.txt - perl -p -i -e "s{$local_data}{$release_data}" $test/v_starcheck.txt - - # Now run current release version if not already there - # - if [ ! -r $release/v_starcheck.txt ] - then - echo "mkdir -p $release" - mkdir -p $release - - echo "cd $release" - cd $release - - echo "Running: $RELEASE/bin/starcheck -vehicle -agasc $agasc -fid_char $fid_char -dir $mphome/$load" - echo "**** (RELEASE VEHICLE) $load ****" >> $vlog - env SKA=$RELEASE PERL5LIB='' SYBASE='' SYBASE_OCS='' $RELEASE/bin/starcheck -vehicle -agasc $agasc -fid_char $fid_char -dir $mphome/$load 2>&1| tee -a $vlog - perl -n -i.bak -e 'print if $. > 3' $release/v_starcheck.txt - fi - - - # Now compare with release version - - echo "diff -u $release/v_starcheck.txt $test/v_starcheck.txt >> $vdiffs" - echo "********************* $load vehicle ********************" >> $vdiffs - diff -u $release/v_starcheck.txt $test/v_starcheck.txt >> $vdiffs - fi - - echo "cd $test" - cd $test - - # Run test version. Use the 'starcheck' launcher to activate the dev environment - # - echo "Running: ${home}/sandbox_starcheck -agasc $agasc -fid_char $fid_char -dir $mphome/$load" - echo "******************** (TEST) $load *******************" >> $log - ${home}/sandbox_starcheck -agasc $agasc -fid_char $fid_char -dir $mphome/$load 2>&1| tee -a $log - # cut first 4 lines and replace test ska with release to make cleaner diffs - perl -n -i.bak -e 'print if $. > 3' $test/starcheck.txt - perl -p -i -e "s{$SKA}{$RELEASE}" $test/starcheck.txt - perl -p -i -e "s{$local_data}{$release_data}" $test/starcheck.txt - - # Now run current release version if not already there - # - if [ ! -r $release/starcheck.txt ] - then - echo "mkdir -p $release" - mkdir -p $release - - echo "cd $release" - cd $release - - echo "Running: $RELEASE/bin/starcheck -agasc $agasc -fid_char $fid_char -dir $mphome/$load" - echo "**** (RELEASE) $load ****" >> $log - env SKA=$RELEASE PERL5LIB='' SYBASE='' SYBASE_OCS='' $RELEASE/bin/starcheck -agasc $agasc -fid_char $fid_char -dir $mphome/$load 2>&1| tee -a $log - perl -n -i.bak -e 'print if $. > 3' $release/starcheck.txt - fi - - - # Now compare with release version - - echo "diff -u $release/starcheck.txt $test/starcheck.txt >> $diffs" - echo "********************* $load ********************" >> $diffs - diff -u $release/starcheck.txt $test/starcheck.txt >> $diffs - - - cd $home -} - - -# Define the files and directories -home=$PWD -sha=${1} -regtestdir=$home/test_regress/${sha} - - -mphome=/data/mpcrit1/mplogs -vlog=$home/vehicle_regress_log -log=$home/regress_log -vdiffs=$home/vehicle_regress_diffs -diffs=$home/regress_diffs - -RELEASE=/proj/sot/ska -local_data=$home/starcheck_data -release_data=$RELEASE/data/starcheck - -if [ -d $regtestdir ] -then - echo "*****************************************" - echo "Regression test output for this code already exists." - echo " Delete to rerun regression tests:" - echo " rm -r $regtestdir" - echo "*****************************************" - exit 1 -fi - -# Make a file to store the file SHA and the current git commit -if [ -w $regtestdir/version ] -then - echo "rm ${regtestdir}/version" - rm ${regtestdir}/version -fi -mkdir -p $regtestdir -echo "echo 'file SHA: $sha' > ${regtestdir}/version" -echo "file SHA: $sha" >> ${regtestdir}/version -echo "echo -n git commit SHA: >> ${regtestdir}/version" -echo -n "git commit SHA: " >> ${regtestdir}/version -echo "git rev-parse --short HEAD >> ${regtestdir}/version" -git rev-parse --short HEAD >> ${regtestdir}/version -echo "echo -n skare_version: >> ${regtestdir}/version" -echo -n "skare_version: " >> ${regtestdir}/version -echo "ska_version >> ${regtestdir}/version" -ska_version >> ${regtestdir}/version -echo "echo -n SKA: $SKA > ${regtestdir}/version" -echo "SKA: $SKA" >> ${regtestdir}/version - - - -# Remove existing log and diffs files -for file in $log $diffs $vlog $vdiffs -do - if [ -w $file ] - then - echo "rm $file" - rm $file - fi -done - -# Then, a bunch of agasc 1.6 loads with the updated fid characteristics - -# Go through specified loads and run test and release starcheck versions -for load in \ - 2010/OCT2510/oflsb \ - 2015/MAR2315/oflsb \ - 2015/SEP2315/oflsa \ - 2016/FEB0816/oflsb \ - 2016/MAY0216/oflsb \ - 2016/JUL0216/oflsb \ - 2016/OCT0316/oflsb \ - OFLS_testing/2016/OCT0316/oflsy \ - ofls_regression_testing/2011/JUN2711/oflst \ - ofls_regression_testing/2016/JUN2716/oflsv \ - ofls_regression_testing/2016/JUL0816/oflsu \ - 2017/JAN0917/oflsb \ - 2017/APR0217/oflsb -do - RunRegression 1p6 fid_CHARACTERIS_FEB07 -done - -# Copy log and diffs to version directory -for file in $log $diffs $vlog $vdiffs -do - if [ -r $file ] - then - echo "cp $file $regtestdir" - cp $file $regtestdir - fi -done diff --git a/starcheck/src/lib/Ska/Parse_CM_File.pm b/starcheck/src/lib/Ska/Parse_CM_File.pm index e9bceb94..e7d0779e 100644 --- a/starcheck/src/lib/Ska/Parse_CM_File.pm +++ b/starcheck/src/lib/Ska/Parse_CM_File.pm @@ -13,14 +13,17 @@ package Ska::Parse_CM_File; use strict; use warnings; use POSIX qw( ceil); -use Ska::Convert qw(date2time time2date); -use Time::JulianDay; -use Time::DayOfYear; -use Time::Local; use IO::All; use Carp; + +use Inline Python => q{ + +from starcheck.utils import date2time, time2date + +}; + my $VERSION = '$Id$'; # ' 1; @@ -33,6 +36,19 @@ our @EXPORT = qw(); our @EXPORT_OK = qw( ); %EXPORT_TAGS = ( all => \@EXPORT_OK ); +############################################################### +sub rel_date2time{ +############################################################### + + # Return seconds when suppled a "relative datetime" of the + # format 000:00:00:00.000 (DOY:HH:MM:SS.sss). + my $date = shift; + + # The old code here uses reverse to just ignore a year if + # included in the string. + my ($sec, $min, $hr, $doy) = reverse split ":", $date; + return ($doy*86400 + $hr*3600 + $min*60 + $sec); +} ############################################################### sub TLR_load_segments{ @@ -479,8 +495,11 @@ sub DOT { foreach (keys %command) { %{$dot{$_}} = parse_params($command{$_}); - $dot{$_}{time} = date2time($dot{$_}{TIME}) if ($dot{$_}{TIME}); - $dot{$_}{time} += date2time($dot{$_}{MANSTART}) if ($dot{$_}{TIME} && $dot{$_}{MANSTART}); + $dot{$_}{time} = date2time($dot{$_}{TIME}) if ($dot{$_}{TIME}); + + # MANSTART is in the dot as a "relative" time like "000:00:00:00.000", so just pass it + # to the rel_date2time routine designed to handle that. + $dot{$_}{time} += rel_date2time($dot{$_}{MANSTART}) if ($dot{$_}{TIME} && $dot{$_}{MANSTART}); $dot{$_}{cmd_identifier} = "$dot{$_}{anon_param1}_$dot{$_}{anon_param2}" if ($dot{$_}{anon_param1} and $dot{$_}{anon_param2}); $dot{$_}{linenum} = $linenum{$_}; @@ -957,31 +976,6 @@ sub odb { } -##*************************************************************************** -sub local_date2time { -##*************************************************************************** -# Date format: 1999:260:03:30:01.542 - - my $date = shift; - my ($sec, $min, $hr, $doy, $yr) = reverse split ":", $date; - - return ($doy*86400 + $hr*3600 + $min*60 + $sec) unless ($yr); - - my ($mon, $day) = ydoy2md($yr, $doy); - $sec =~ s/\..+//; - - return timegm($sec,$min,$hr,$day,$mon-1,$yr); -} - -##*************************************************************************** -sub rel_date2time { -##*************************************************************************** -# Date format: 1999:260:03:30:01.542 - - my $date = shift; - my ($yr, $doy, $hr, $min, $sec) = split ":", $date; -} - ##*************************************************************************** sub parse_params{ diff --git a/starcheck/src/lib/Ska/Starcheck/Dark_Cal_Checker.pm b/starcheck/src/lib/Ska/Starcheck/Dark_Cal_Checker.pm deleted file mode 100644 index 62abd647..00000000 --- a/starcheck/src/lib/Ska/Starcheck/Dark_Cal_Checker.pm +++ /dev/null @@ -1,2192 +0,0 @@ -package Ska::Starcheck::Dark_Cal_Checker; - -# part of aca_dark_cal_checker project - -use strict; -use warnings; -use Carp; -use IO::All; -use Ska::Convert qw(date2time time2date); -use Quat; -use Config::General qw( ParseConfig ); -use Math::Trig; -use Data::Dumper; - -use Ska::Parse_CM_File; - -# Add a module-wide hash to store a mapping of Obsid/OFLSIDs to dark cal -# labels (DFC_?/DC_T?) -my %dc_oflsid; - -sub new{ - my $class = shift; - my $par_ref = shift; - - # Set Defaults - my $SKA = $ENV{SKA} || '/proj/sot/ska'; - my $DarkCal_Data = "${SKA}/data/starcheck"; - - my %par = ( - dir => '.', - app_data => "${DarkCal_Data}", - config => 'tlr.cfg', - tlr => 'CR*.tlr', - mm => '/mps/mm*.sum', - backstop => 'CR*.backstop', - dot => "/mps/md*.dot", - %{$par_ref}, - ); - - - my @checks = (qw( - aca_init_command - trans_replica_0 - dither_disable_0 - tnc_replica_0 - trans_replica_1 - dither_disable_1 - tnc_replica_1 - trans_replica_2 - dither_disable_2 - tnc_replica_2 - trans_replica_3 - dither_disable_3 - tnc_replica_3 - trans_replica_4 - dither_disable_4 - tnc_replica_4 - check_manvr - check_dwell - check_manvr_point - check_momentum_unloads - check_dither_enable_at_end - check_dither_param_at_end - )); - - -# Create a hash to store all information about the checks as they are performed - my %feedback = ( - input_files => [], - dark_cal_present => 1, - checks => \@checks, - ); - - - -# %Input files is used by get_file() - - my %config = ParseConfig(-ConfigFile => "$par{app_data}/$par{config}"); - $feedback{oflsids} = $config{template}->{manvr}->{point_order}->{oflsid}; - fix_config_hex(\%config); - - my $tlr_file = get_file("$par{dir}/$par{tlr}", 'tlr', 'required', \@{$feedback{input_files}}); - my $tlr = TLR->new($tlr_file, 'tlr', \%config); - $feedback{tlr} = $tlr; - #my $mm_file = get_file("$par{dir}/$par{mm}", 'Maneuver Management', 'required', \@{$feedback{input_files}}); - my $dot_file = get_file("$par{dir}/$par{dot}", 'DOT', 'required', \@{$feedback{input_files}}); - #my @mm = Ska::Parse_CM_File::MM({file => $mm_file, ret_type => 'array'}); - my ($dot_href, $s_touched, $dot_aref) = Ska::Parse_CM_File::DOT($dot_file); - my $bs_file = get_file("$par{dir}/$par{backstop}", 'Backstop', 'required', \@{$feedback{input_files}}); - my @bs = Ska::Parse_CM_File::backstop($bs_file); - - # load A and B templates - my %templates = map { $_ => TLR->new(get_file("$par{app_data}/$config{file}{template}{$_}", - 'template', - 'required', - \@{$feedback{input_files}} ), 'template', \%config) } (qw(A B)); - - my $manvrs = maneuver_parse($dot_aref); - my $dwells = calc_dwells($manvrs); - my $timelines = iu_timeline($tlr); - my @trim_tlr = @{ trim_tlr( $tlr, \%config )}; - - $feedback{aca_init_command} = compare_timingncommanding( [$tlr->{first_aca_hw_cmd}], [$templates{A}->{entries}[0]], \%config, - "First ACA command is the template-independent init command"); - %feedback = (%feedback, %{replicas($tlr, \%templates, $timelines, \%config)}); - - $feedback{check_dither_enable_at_end} = check_dither_enable_at_end($tlr, $manvrs, \%config); - $feedback{check_dither_param_at_end} = check_dither_param_at_end($tlr, $manvrs, \%config); - $feedback{check_manvr} = check_manvr( \%config, $manvrs); - $feedback{check_dwell} = check_dwell(\%config, $manvrs, $dwells); - $feedback{check_manvr_point} = check_manvr_point( \%config, \@bs, $manvrs); - $feedback{check_momentum_unloads} = check_momentum_unloads(\%config, \@bs, $manvrs, $dwells); - $feedback{dc_oflsid} = \%dc_oflsid; - - bless \%feedback, $class; - return \%feedback; - -} - -##*************************************************************************** -sub maneuver_parse{ -##*************************************************************************** -# use the DOT entries to create an array of maneuver (hashes) each with -# a defined initial and final oflsid, tstart, tstop, and duration - - my $dot = shift; - - my @raw_manvrs; - - my %is_replica; - my $curr_obsid = 'INIT'; - # Get the obsids/oflsids at the time of the replica commands - for my $dot_entry (@{$dot}){ - if ($dot_entry->{cmd_identifier} eq 'ATS_OBSID'){ - $curr_obsid = $dot_entry->{ID}; - } - if ($dot_entry->{cmd_identifier} eq 'ATS_A_P1ADC'){ - $is_replica{$curr_obsid} = 1; - } - } - - for my $dot_entry (@{$dot}){ - if ($dot_entry->{cmd_identifier} =~ /ATS_MANVR/){ - push @raw_manvrs, $dot_entry; - } - } - - # mock initial starting attitude - my $init = 'dcIAT'; - my @manvrs; - my $n_replica = 0; - # for each maneuver, make a hash and push it - # saving the new attitude as the initial oflsid for the next maneuver - for my $manvr (@raw_manvrs){ - my %man = ( init => $init, - final => $manvr->{oflsid}, - tstart => $manvr->{time} + timestring_to_secs($manvr->{MANSTART}), - tstop => $manvr->{time} - + timestring_to_secs($manvr->{MANSTART}) - + timestring_to_secs($manvr->{DURATION}), - duration => timestring_to_mins($manvr->{DURATION}), - ); - # Mark each maneuver to a replica. If oflsid already has "DC_T" use that - # otherwise use %is_replica hash as defined by the commanded obsid at - # the time of the replica commanding in the DOT - if (($manvr->{oflsid} =~ /DC_T/) or (defined $is_replica{$manvr->{oflsid}})){ - $man{DC} = $n_replica; - $n_replica++; - } - push @manvrs, \%man; - $init = $manvr->{oflsid}; - - } - for my $man_idx (0 .. $#manvrs){ - if (not defined $manvrs[$man_idx]->{DC}){ - next; - } - # For each maneuver to a replica, update the oflsid of the 'final' label to match - # the DC_T? convention, update the 'init' label to be "DFC_?", - # update the final label of the previous maneuver to that same "DFC_?" - # and update the initial label of the next maneuver to the DC_T? value - my $replica = $manvrs[$man_idx]->{DC}; - $dc_oflsid{"DC_T" . $replica} = $manvrs[$man_idx]->{final}; - $manvrs[$man_idx]->{final} = "DC_T" . $replica; - # Use the convention of labeling first DFC DFC_I - my $dfc = ($replica == 0) ? "DFC_I" : - "DFC_" . ($replica - 1); - $manvrs[$man_idx]->{init} = $dfc; - if ($man_idx > 0){ - $dc_oflsid{$dfc} = $manvrs[$man_idx - 1]->{final}; - $manvrs[$man_idx - 1]->{final} = $dfc; - } - if ($man_idx < $#manvrs){ - $manvrs[$man_idx + 1]->{init} = "DC_T" . $replica; - } - - } - # Do another pass through the maneuvers and relabel anything after a replica a DFC - # if it isn't a "DFC_?" already. The idea here is to make it easier to check that all attitudes - # after replicas are also at the DFC attitude. Relabeling any such atts as them as "DFC_P?" - # (which will be true for at least one attitude in a split dark cal), - # just means that the attitudes will be explicitly checked against the DFC_I attitude - # in check_manvr_point. - for my $man_idx (0 .. $#manvrs){ - if (not defined $manvrs[$man_idx]->{DC}){ - next; - } - my $replica = $manvrs[$man_idx]->{DC}; - my $dfc_p = ($replica == 0) ? "DFC_PI" : - "DFC_P" . $replica; - if ($man_idx < $#manvrs){ - if (not $manvrs[$man_idx + 1]->{final} =~ /DFC/){ - $dc_oflsid{$dfc_p} = $manvrs[$man_idx + 1]->{final}; - $manvrs[$man_idx + 1]->{final} = $dfc_p; - } - } - } - - - return \@manvrs; - -} - -##*************************************************************************** -sub calc_dwells{ -##*************************************************************************** -# From the parsed DOT maneuvers, generate an hash of dwells keyed off of -# oflsid. This will not be robust for obsids without maneuvers, but -# that should not be a problem for any of the oflsids we'll be checking -# (specifically, the dark cal ones). - - my $manvrs = shift; - my %dwell; - my $dwell_start; - for my $manvr (@{$manvrs}){ - if (defined $dwell_start){ - $dwell{$manvr->{init}} = { duration => $manvr->{tstart} - $dwell_start, - tstart => $dwell_start, - tstop => $manvr->{tstart}, - oflsid => $manvr->{init}, - }; - } - $dwell_start = $manvr->{tstop}; - } - return \%dwell; -} - - -##*************************************************************************** -sub replicas{ -##*************************************************************************** -# perform dither, transponder selection, and complete command/timing checks on -# each of the dark cal replicas - - my $tlr = shift; - my $templates = shift; - my $timelines = shift; - my $config = shift; - my @trim_tlr = @{ trim_tlr( $tlr, $config )}; - my %feedback; - # for each replica - for my $r_idx (0 .. 4){ - # find the indexes in the real tlr and trim to a reduced set of commands to check - # note that begin_replica and end_replica use trace_ids from the TLR - my $r_start = $tlr->begin_replica($r_idx)->index(); - my $r_end = $tlr->end_replica($r_idx)->index(); - my @replica_tlr; - for my $entry (@trim_tlr){ - if (($entry->index() >= $r_start) and ($entry->index() <= $r_end)){ - push @replica_tlr, $entry; - } - } - # run the command checks on each transponder and store the results in the %per_trans hash - my %per_trans; - my $best_guess; - for my $trans (qw( A B )){ - my $template = $templates->{$trans}; - my @replica_templ; - for my $entry (@{$template->{entries}}){ - if ((defined $entry->replica()) and ($entry->replica() == $r_idx )){ - push @replica_templ, $entry; - } - } - $per_trans{$trans} = compare_timingncommanding( \@replica_tlr, \@replica_templ, $config, - "Strict Timing Checks: Timing and Hex Commanding for replica $r_idx transponder $trans"); - $per_trans{$trans}->{transponder} = $trans; - } - # for the transponder version with fewest errors, assign the output, and - # assign a transponder - if ($per_trans{A}->{n_fails} < $per_trans{B}->{n_fails}){ - $best_guess = 'A'; - $feedback{"tnc_replica_${r_idx}"} = $per_trans{A}; - } - else{ - $best_guess = 'B'; - $feedback{"tnc_replica_${r_idx}"} = $per_trans{B}; - } - # for the given transponder and replica, check that the transponder state is correct - $feedback{"trans_replica_${r_idx}"} = check_iu({ replica => $r_idx, - r_tstart => $replica_tlr[0]->time(), - r_tstop => $replica_tlr[-1]->time(), - r_datestart => $replica_tlr[0]->datestamp(), - r_datestop => $replica_tlr[-1]->datestamp(), - transponder => $best_guess, - timelines => $timelines, - config => $config}); - # also confirm that dither is disabled before the start of the replica - $feedback{"dither_disable_${r_idx}"} = check_dither_disable_before_replica( $tlr, $config, $r_idx); - } - - return \%feedback; - -} - -##*************************************************************************** -sub check_iu{ -##*************************************************************************** - my $check_cfg = shift; - my ($replica, $r_datestart, $transponder, $timelines, $config) = - @{$check_cfg}{(qw(replica r_datestart transponder timelines config))}; - - #my $r_tstart $r_tstop, $transponder, $timelines, $config) = @_; - my %output = ( - comment => ["Checking IU/transponder state before replica $replica"], - criteria => ["Find the commanded IU state before $r_datestart, looking for", - 'all CIMODESL, CPX???, CPA??? commands', - "Compares current CTX/CPA state with desired state for transponder $transponder", - "The transponder is predetermined by the hex checks against each template", - "if both fail, a 'best guess' based on the smaller number of errors is used", - ], - status => 1, - transponder => $transponder, - ); - - my %tmpl = ( A => $config->{template}->{A}->{transponder}, - B => $config->{template}->{B}->{transponder}); - - - my $state; - for my $t (reverse @{$timelines}){ - next unless $t->{time} < $check_cfg->{r_tstart}; - $state = $t; - last; - } - if (not defined $state->{iu}){ - push @{$output{info}}, { text => "IU config not set (should be CIU512X or CIU512T)", type => 'error' }; - $output{status} = 0; - } - else{ - my $want_iu = ($transponder eq 'A') ? 'CIU512T' : 'CIU512X'; - if ($state->{iu} eq $want_iu){ - push @{$output{info}}, { text => "IU config set to $want_iu at ". $state->{datestart}, type => 'info' }; - } - else{ - push @{$output{info}}, { text => "IU config set to '" . $state->{iu} ."', should be $want_iu", type => 'error' }; - $output{status} = 0; - } - } - - # check for changes during the replica - if ($state->{tstop} < $check_cfg->{r_tstop}){ - push @{$output{info}}, { text => "Transponder state change during replica at $state->{datestop}", type => 'error' }; - } - else{ - push @{$output{info}}, { text => "Transponder state unchanged through replica end at $check_cfg->{r_datestop}", type => 'info' }; - } - - - my %want = %{$tmpl{$transponder}}; - my @tinfo; - my $t_select = 1; - for my $cm (keys %want){ - push @tinfo, { text => "transponder state $cm set to " . $state->{$cm} . ", should be " . $want{$cm} - , type => $state->{$cm} ne $want{$cm} ? 'error' : 'info'}; - $t_select = 0 if ($state->{$cm} ne $want{$cm}); - } - push @{$output{info}}, { text => "Checking against config for intended transponder $transponder", type => 'info'}; - push @{$output{info}}, @tinfo; - if ($t_select == 0){ - $output{status} = 0; - push @{$output{info}}, { text => "Transponder not correctly set for $transponder", type => 'error' }; - } - else{ - push @{$output{info}}, { text => "Transponder correctly set to $transponder", type => 'info' }; - } - - return \%output; - -} - - -##*************************************************************************** -sub iu_timeline{ -##*************************************************************************** -# Step through the TLR and generate/clock out an array of timeline "states" for -# the CPA, CTX, and CIMODESL options. - - my $tlr = shift; - my @timelines; - my %timeline; - my %cimodesl = ('7C0 6360' => 'CIU128T', - '7C0 6380' => 'CIU256T', - '7C0 63A0' => 'CIU512T', - '7C0 63C0' => 'CIU1024T', - '7C0 6780' => 'CIU256X', - '7C0 67A0' => 'CIU512X', - '7C0 67C0' => 'CIU1024X', - '7C0 6BA0' => 'CIMODESL', - '7C0 6FA0' => 'CIMODESL'); - - my %tog = ( 'ON' => 'ON', - 'OF' => 'OFF'); - - for my $entry (@{$tlr->{entries}}){ - if (defined $entry->comm_mnem()){ - if ($entry->comm_mnem() eq 'CIMODESL'){ - my $iu = $cimodesl{$entry->hex()->[0]}; - if (((not defined $timeline{iu}) or ($iu ne $timeline{iu})) - and ($iu ne 'CIMODESL')){ - $timeline{iu} = $iu; - $timeline{datestart} = $entry->datestamp(); - $timeline{time} = $entry->time(); - $timeline{tstart} = $entry->time(); - if (scalar(@timelines)){ - $timelines[-1]->{datestop} = $entry->datestamp(); - $timelines[-1]->{tstop} = $entry->time(); - } - push @timelines, {%timeline}; - } - } - if ($entry->comm_mnem() =~ /^(C(TX|PA))(A|B)(ON|OF)/){ - my $tkey = "$1$3"; - my $tval = $tog{$4}; - if ((not defined $timeline{$tkey}) or ($timeline{$tkey} ne $tval)){ - $timeline{$tkey} = $tval; - $timeline{datestart} = $entry->datestamp(); - $timeline{time} = $entry->time(); - $timeline{tstart} = $entry->time(); - if (scalar(@timelines)){ - $timelines[-1]->{datestop} = $entry->datestamp(); - $timelines[-1]->{tstop} = $entry->time(); - } - push @timelines, {%timeline}; - } - } - } - } - - return \@timelines; - -} - - - - - -##*************************************************************************** -sub check_dither_disable_before_replica{ -##*************************************************************************** - - my ($tlr, $config, $replica) = @_; - - my %output = ( - comment => ["Dither disable before Dark Cal replica $replica"], - ); - - my @tlr_arr = @{$tlr->{entries}}; - - my %cmd_list = map { $_ => $config->{template}{independent}{$_}} (qw( dither_enable dither_disable )); - - my $index_0 = $tlr->begin_replica($replica)->index(); - - my $time_before_replica_0 = $config->{template}{time}{dtime_dither_disable_repl_0}; - - push @{$output{criteria}}, sprintf("Steps back through the TLR from the replica start time"); - push @{$output{criteria}}, sprintf("where replica $replica starts at " . $tlr->begin_replica($replica)->datestamp() ); - push @{$output{criteria}}, sprintf("and looks for any dither enable or disable command mnemonics :"); - - my $string_cmd_list; - for my $comm_mnem (map {@$_} @{cmd_list{'dither_enable','dither_disable'}}){ - $string_cmd_list .= " " . $comm_mnem->{comm_mnem}; - } - push @{$output{criteria}}, $string_cmd_list; - - - # find the last dither commanding before the first replica - # create an array of those commands (even if just one command) - - my @last_dith_cmd; - - for my $tlr_entry (reverse @tlr_arr[0 .. $index_0]){ - next unless ( grep { $tlr_entry->comm_mnem() eq $_->{comm_mnem} } (map {@$_} @{cmd_list{'dither_enable','dither_disable'}}) ); - push @last_dith_cmd, $tlr_entry; - last; - } - - if (scalar(@last_dith_cmd) == 0){ - push @{$output{info}}, { text => "No Dither Commands found before replica $replica", - type => 'error'}; - $output{status} = 0; - return \%output; - } - - push @{$output{criteria}}, "Compares discovered dither command to correct dither disable command"; - # confirm that the most recent dither command is correct - my $match = entry_arrays_match( \@last_dith_cmd, $cmd_list{dither_disable} ); - $output{status} = $match->{status}; - for my $data (qw(info criteria)){ - if ($match->{$data}){ - push @{$output{$data}}, @{$match->{$data}}; - } - } - return \%output; - - -} - - - -##*************************************************************************** -sub check_dither_enable_at_end{ -##*************************************************************************** - - my %output = ( - comment => ['Dither enabled after Dark Cal'], - ); - - my ($tlr, $manvrs, $config) = @_; - - my @tlr_arr = @{$tlr->{entries}}; - - my %cmd_list = map { $_ => $config->{template}{independent}{$_}} (qw( dither_enable dither_disable )); - - my $manvr_away_from_dfc; - for my $man_idx (0 .. $#{$manvrs}){ - if ($manvrs->[$man_idx]->{tstart} > $tlr->end_replica(4)->time()){ - # The maneuver to DFC after replica 4 is the first manvr after end_replica(4)->time - # The maneuver *from* DFC should be the next one [$man_idx + 1] - $manvr_away_from_dfc = $manvrs->[$man_idx + 1]; - last; - } - } - my $manvr_datestop = time2date($manvr_away_from_dfc->{'tstop'}); - - push @{$output{criteria}}, sprintf("Steps through the TLR from the last hw command at replica 4"); - push @{$output{criteria}}, sprintf("to the end of the maneuver from DFC to ADJCT, where"); - push @{$output{criteria}}, sprintf("end replica 4 at " . $tlr->end_replica(4)->datestamp() ); - push @{$output{criteria}}, sprintf("maneuver away from dfc ends at " . $manvr_datestop); - push @{$output{criteria}}, sprintf("looks for any dither enable or disable command mnemonics :"); - - my $string_cmd_list; - for my $comm_mnem (map {@$_} @{cmd_list{'dither_enable','dither_disable'}}){ - $string_cmd_list .= " " . $comm_mnem->{comm_mnem}; - } - push @{$output{criteria}}, $string_cmd_list; - - - # find the first dither command after the end of replica 4 - # and before the end of the maneuver away from dark field center at the end of the calibration - - my @dith_cmd; - - my $index_end = $tlr->end_replica(4)->index(); - for my $tlr_entry (@tlr_arr[$index_end .. $#tlr_arr]){ - next unless ( grep { $tlr_entry->comm_mnem() eq $_->{comm_mnem} } (map {@$_} @{cmd_list{'dither_enable','dither_disable'}}) ); - last if ($tlr_entry->time() > ($manvr_away_from_dfc->{tstop})); - push @dith_cmd, $tlr_entry; - } - - push @{$output{criteria}}, "Throws error on 0 or more than 1 dither enable command in the interval"; - - if (scalar(@dith_cmd) == 0 or scalar(@dith_cmd) > 1){ - if (scalar(@dith_cmd) > 1){ - push @{$output{info}}, { text => "Extra dither commands at end", type => 'error'}; - for my $entry (@dith_cmd){ - push @{$output{info}}, { text => sprintf($entry->datestamp(). "\t". $entry->comm_mnem()), type => 'error'}; - } - } - else{ - push @{$output{info}}, { text => "Dither not enabled at end", type => 'error'}; - } - - $output{status} = 0; - return \%output; - } - - push @{$output{criteria}}, "Compares discovered dither command to correct dither enable command"; - # confirm that the most recent dither command is correct - my $match = entry_arrays_match( \@dith_cmd, $cmd_list{dither_enable} ); - $output{status} = $match->{status}; - for my $data (qw(info criteria)){ - if ($match->{$data}){ - push @{$output{$data}}, @{$match->{$data}}; - } - } - return \%output; - - - -} - -##*************************************************************************** -sub check_dither_param_before_replica{ -##*************************************************************************** - - my ($tlr, $config, $replica) = @_; - - my %output = ( - comment => ['Dither param before Dark Cal'], - ); - - my @tlr_arr = @{$tlr->{entries}}; - - my $dither_null_param = $config->{template}{independent}{dither_null_param}; - - my %cmd_list; - - for my $cmd (@{$dither_null_param}){ - $cmd_list{$cmd->{comm_mnem}} = 1; - } - - - push @{$output{criteria}}, sprintf("Steps back through the TLR from the replica $replica"); - push @{$output{criteria}}, sprintf("where replica $replica at " . $tlr->begin_replica($replica)->datestamp() ); - push @{$output{criteria}}, sprintf("looks for any dither parameter command mnemonics :"); - - my $string_cmd_list; - for my $comm_mnem (keys %cmd_list){ - $string_cmd_list .= " " . $comm_mnem; - } - push @{$output{criteria}}, $string_cmd_list; - - - my $index_0 = $tlr->begin_replica($replica)->index(); - - my $time_before_replica_0 = $config->{template}{time}{dtime_dither_disable_repl_0}; - - # find the last dither commanding before replica 0 - # create an array of those commands (even if just one command) - - my @last_dith_param; - - for my $tlr_entry (reverse @tlr_arr[0 .. $index_0]){ - next unless (defined $cmd_list{$tlr_entry->comm_mnem}); - push @last_dith_param, $tlr_entry; - last; - } - - push @{$output{criteria}}, "If no commands are found, generates an error."; - - if (scalar(@last_dith_param) == 0 ){ - - push @{$output{info}}, { text => "Dither parameters not set before replica $replica", type => 'error'}; - $output{status} = 0; - return \%output; - } - - push @{$output{criteria}}, "Otherwise, goes on and compares dither parameter command to correct dither parameter command"; - - # confirm that the most recent dither command is correct - my $match = entry_arrays_match( \@last_dith_param, $dither_null_param ); - $output{status} = $match->{status}; - for my $data (qw(info criteria)){ - if ($match->{$data}){ - push @{$output{$data}}, @{$match->{$data}}; - } - } - return \%output; - - -} - - - -##*************************************************************************** -sub check_dither_param_at_end{ -##*************************************************************************** - - my ($tlr, $manvrs, $config) = @_; - - my %output = ( - comment => ['Dither param set to default at end'], - ); - - my @tlr_arr = @{$tlr->{entries}}; - - my $dither_default_param = $config->{template}{independent}{dither_default_param}; - - my %cmd_list; - - for my $cmd (@{$dither_default_param}){ - $cmd_list{$cmd->{comm_mnem}} = 1; - } - - my $manvr_away_from_dfc; - for my $man_idx (0 .. $#{$manvrs}){ - if ($manvrs->[$man_idx]->{tstart} > $tlr->end_replica(4)->time()){ - # The maneuver to DFC after replica 4 is the first manvr after end_replica(4)->time - # The maneuver *from* DFC should be the next one [$man_idx + 1] - $manvr_away_from_dfc = $manvrs->[$man_idx + 1]; - last; - } - } - my $manvr_datestop = time2date($manvr_away_from_dfc->{'tstop'}); - - push @{$output{criteria}}, sprintf("Steps through the TLR from the last command at the end of replica 4"); - push @{$output{criteria}}, sprintf("to the end of the maneuver away from DFC to ADJCT"); - push @{$output{criteria}}, sprintf( "end of replica 4 at " . $tlr->end_replica(4)->datestamp() ); - push @{$output{criteria}}, sprintf( "end of maneuver away from dfc at " . $manvr_datestop); - push @{$output{criteria}}, sprintf("looks for any dither parameter command mnemonics :"); - - my $string_cmd_list; - for my $comm_mnem (keys %cmd_list){ - $string_cmd_list .= " " . $comm_mnem; - } - push @{$output{criteria}}, $string_cmd_list; - - - - # find the last dither commanding before that "start time" - # create an array of those commands (even if just one command) - - my @dith_param; - my $index_end = $tlr->end_replica(4)->index(); - for my $tlr_entry (@tlr_arr[$index_end .. $#tlr_arr]){ - next unless (defined $cmd_list{$tlr_entry->comm_mnem}); - last if ($tlr_entry->time() > $manvr_away_from_dfc->{'tstop'}); - push @dith_param, $tlr_entry; - } - - push @{$output{criteria}}, "Throws error on 0 or more than 1 dither parameter command in the interval"; - - if (scalar(@dith_param) == 0 or scalar(@dith_param) > 1){ - - $output{status} = 0; - - if (scalar(@dith_param) > 1){ - push @{$output{info}}, { text => "Extra dither params set at end", type => 'error'}; - for my $entry (@dith_param){ - push @{$output{info}}, { text => sprintf($entry->datestamp() . "\t" . $entry->comm_mnem()), - type => 'info'}; - } - } - else{ - push @{$output{info}}, { text => "Default dither params not set at end", type => 'error' }; - } - - return \%output; - } - - push @{$output{criteria}}, "Otherwise, goes on and compares dither parameter command to correct dither parameter command"; - - # confirm that the most recent dither command is correct - my $match = entry_arrays_match( \@dith_param, $dither_default_param ); - $output{status} = $match->{status}; - for my $data (qw(info criteria)){ - if ($match->{$data}){ - push @{$output{$data}}, @{$match->{$data}}; - } - } - return \%output; - - -} - - - -##*************************************************************************** -sub check_manvr { -##*************************************************************************** -# Check that the maneuver timing is consistent with the template for maneuvers to and from replicas - - my ($config, $manvrs) = @_; - - my %maneuver_times = %{$config->{template}{maneuver}}; - my %init = %{$config->{template}{replica_targ}}; - my %final = %{$config->{template}{replica_targ}}; - - my %output = ( - status => 1, - comment => ['Maneuver Timing'], - ); - - push @{$output{criteria}}, "Compares the DC maneuver times to and from replicas to the config file times"; - - - for my $manvr (@{$manvrs}){ - - # if to or from a replica - if (($manvr->{init} =~ /DC_T/) or ($manvr->{final} =~ /DC_T/)){ - my $expected_time; - # to a replica - if (($manvr->{init} =~ /DFC/) and ($manvr->{final} =~ /DC_T/)){ - $expected_time = $maneuver_times{center_to_replica}; - $final{$manvr->{final}} += 1; - } - # from a replica - if (($manvr->{init} =~ /DC_T/)){ - $expected_time = $maneuver_times{replica_to_center}; - $init{$manvr->{init}} += 1; - } - # if unexpected (as in, oflsid for DFC doesn't match /DFC/) - if (not defined $expected_time){ - push @{$output{info}}, { text => "Illegal Dark Cal Maneuver. Unexpected maneuver from " - . "$manvr->{init} to $manvr->{final} ", - type => 'error' }; - $output{status} = 0; - next; - } - my $t_manvr_min = sprintf("%.1f", $manvr->{duration}); - # Add actual oflsid in parenthesis if label does not match oflsid - my ($a, $b) = ($manvr->{init}, $manvr->{final}); - if ((defined $dc_oflsid{$manvr->{init}}) and ($dc_oflsid{$manvr->{init}} ne $manvr->{init})){ - $a .= " ($dc_oflsid{$manvr->{init}})"; - } - if ((defined $dc_oflsid{$manvr->{final}}) and ($dc_oflsid{$manvr->{final}} ne $manvr->{final})){ - $b .= " ($dc_oflsid{$manvr->{final}})"; - } - push @{$output{info}}, { text => "Maneuver from $a to $b: " - . "time = $t_manvr_min min ; " - . "expected time = $expected_time", - type => 'info' }; - if ($expected_time != $t_manvr_min){ - $output{status} = 0; - push @{$output{info}}, { text => "Maneuver Time Incorrect", - type => "error" }; - } - - } - } - - # confirm that we have one maneuver to each replica, and one maneuver - # away from each replica. - if ((grep {!/1/} values %init) or (grep {!/1/} values %final)){ - push @{$output{info}}, { text => "Extra maneuvering to or from replicas... check manually.", - type => "error" }; - $output{status} = 0; - } - - return \%output; -} - - -##*************************************************************************** -sub check_dwell{ -##*************************************************************************** - - my ($config, $manvrs, $dwells) = @_; - - my %template_dwell = %{$config->{template}{dwell}}; - my %replica_targ = %{$config->{template}{replica_targ}}; - - my %output = ( - status => 1, - comment => ['Dwell Timing'], - ); - - push @{$output{criteria}}, "Checks the dwell time at every replica and at every Dark Field Center just before a replica."; - - # find ids of dfcs before replicas - my @check_ids; - for my $manvr (@{$manvrs}){ - if ($manvr->{final} =~ /DC_T/){ - push @check_ids, $manvr->{init}; - } - } - # and the replicas themselves - push @check_ids, sort keys %replica_targ; - - # check - for my $id (@check_ids){ - if (not defined $dwells->{$id}){ - push @{$output{info}}, { text => "No dwell found for $id from DOT maneuvers", - type => "error"}; - $output{status} = 0; - } - my $template_type = ($id =~ /DFC/) ? 'center' : 'replica'; - my ($outputs, $status) = single_dwell_check( $id, - $dwells->{$id}->{duration}, - $template_dwell{$template_type} * 60); - push @{$output{info}}, @{$outputs}; - $output{status} = 0 if ($status == 0); - - } - return \%output; -} - -##*************************************************************************** -sub single_dwell_check{ -##*************************************************************************** - my ($oflsid, $dwell, $expected_dwell) = @_; - - my $dwell_tolerance = 1; # second - my @outputs; - my $status = 1; - - push @outputs, { text => "Dwell at $oflsid : time = $dwell secs ; expected time = $expected_dwell secs", - type => 'info' }; - - if (abs($dwell - $expected_dwell) > $dwell_tolerance ){ - if ($dwell < $expected_dwell){ - push @outputs, { text => "Dwell Time incorrect", type => 'error' }; - $status = 0; - } - else{ - push @outputs, { text => "Dwell Time too long (probably OK)", type => 'warn' }; - $status = 0; - } - } - return \@outputs, $status; -} - -##*************************************************************************** -sub timestring_to_secs { -##*************************************************************************** - my $timestring = shift; - my %timehash; - ($timehash{days}, $timehash{hours}, $timehash{min}, $timehash{sec}) = split(":", $timestring); - my $secs = 0; - $secs += $timehash{days} * 24 * 60 * 60; # secs per day - $secs += $timehash{hours} * 60 * 60; # secs per hour - $secs += $timehash{min} * 60; # secs per minute - $secs += $timehash{sec}; - return $secs; - -} - -##*************************************************************************** -sub timestring_to_mins { -##*************************************************************************** - my $timestring = shift; - my %timehash; - ($timehash{days}, $timehash{hours}, $timehash{min}, $timehash{sec}) = split(":", $timestring); - my $mins = 0; - $mins += $timehash{days} * 24 * 60; # minutes per day - $mins += $timehash{hours} * 60; # minutes per hour - $mins += $timehash{min}; - $mins += $timehash{sec} / 60.; # minutes per second - return $mins; -} - - -##*************************************************************************** -sub check_momentum_unloads { -##*************************************************************************** - - my ($config, $bs, $manvrs, $dwells) = @_; - - # first, look for any unloads - my @unloads = (); - for my $entry (@{$bs}){ - if ((defined $entry->{command}) and (defined $entry->{command}->{TLMSID})){ - if ($entry->{command}->{TLMSID} =~ /AOMUNLGR/){ - push @unloads, $entry->{date}; - } - } - } - - my %output = ( - status => 1, - comment => ['Check for Momentum Unloads'], - ); - - - push @{$output{criteria}}, "Confirms no momentum dumps at DFC or at replicas or during manvr to or from replicas"; - - # not worth doing much if there aren't any unloads - if (scalar(@unloads) == 0){ - return \%output; - } - - - for my $manvr (@{$manvrs}){ - # maneuver to or from a replica - if (($manvr->{init} =~ /DC_T/) or ($manvr->{final} =~ /DC_T/)){ - push @{$output{info}}, { text => sprintf("Checking for momentum dumps during maneuver from %s to %s", - $manvr->{init}, - $manvr->{final}), - type => 'info'}; - - for my $unload (@unloads){ - if ((date2time($unload) >= $manvr->{tstart}) - and (date2time($unload) <= $manvr->{tstop})){ - $output{status} = 0; - push @{$output{info}}, { text => sprintf("Momentum dump at %s during maneuver from %s to %s", - $unload, - $manvr->{init}, - $manvr->{final}), - type => 'error'}; - } - } - } - - } - - # find ids of dfcs before replicas - my @oflsids; - for my $manvr (@{$manvrs}){ - if ($manvr->{final} =~ /DC_T/){ - push @oflsids, $manvr->{init}; - } - } - # and add the replicas - my %replica_targ = %{$config->{template}{replica_targ}}; - push @oflsids, sort keys %replica_targ; - - # check all these dwells - for my $id (@oflsids){ - my ($outputs, $status) = single_unload_check( $dwells->{$id}, \@unloads); - push @{$output{info}}, @{$outputs}; - $output{status} = 0 if ($status == 0); - } - - return \%output; - - -} - -##*************************************************************************** -sub single_unload_check{ -##*************************************************************************** - my ($dwell, $unloads) = @_; - - my @outputs; - my $status = 1; - - push @outputs, { text => sprintf("Checking for unloads during $dwell->{oflsid} " - . ": %s to %s ", - time2date($dwell->{tstart}), - time2date($dwell->{tstop})), - type => 'info' }; - - for my $unload (@{$unloads}){ - if ((date2time($unload) >= $dwell->{tstart}) - and (date2time($unload) <= $dwell->{tstop})){ - $status = 0; - push @outputs, { text => sprintf("Momentum dump at %s during dwell at %s", - $unload, - $dwell->{oflsid}), - type => 'error'}; - } - } - - return \@outputs, $status; -} - -##*************************************************************************** -sub check_manvr_point{ -##*************************************************************************** - - my ($config, $bs, $manvrs) = @_; - - my %output = ( - comment => ['Maneuver Pointing'], - status => 1, - ); - - push @{$output{criteria}}, "Confirms that the delta positions for each of the dark cal pointings", - "match the expected delta positions listed in the config file"; - - my %replica_targ = %{$config->{template}{replica_targ}}; - my %pointings = %{$config->{template}{point}{replicas}}; - my $as_slop = $config->{template}{point}{arcsec_slop}; - - my $center_quat; - - for my $manvr (@{$manvrs}){ - - my $dest_obsid = $manvr->{final}; - # find maneuvers to a DFC or to a replica - next unless ($dest_obsid =~ /DFC/ or $dest_obsid =~ /DC_T/); - - # find the first matching backstop target quaternion after the maneuver command - # time - my $bs_match; - for my $bs_entry (@{$bs}) { - next unless ($bs_entry->{time} > $manvr->{tstart}); - next unless ($bs_entry->{cmd} =~ /MP_TARGQUAT/); - $bs_match = $bs_entry; - last; - } - - my $targ_quat = Quat->new($bs_match->{command}->{Q1}, - $bs_match->{command}->{Q2}, - $bs_match->{command}->{Q3}, - $bs_match->{command}->{Q4}); - - my %target = ( - obsid => $dest_obsid, - quat => $targ_quat, - ); - - # store the quaternion for the field center - if ($dest_obsid =~ /DFC_I/){ - $center_quat = $targ_quat; - } - next unless defined $center_quat; - - - my $delta = ($target{quat})->divide($center_quat); - my $x = sprintf( "%5.2f", rad_to_arcsec($delta->{q}[1]*2)); - my $y = sprintf( "%5.2f", rad_to_arcsec($delta->{q}[2]*2)); - - my $pred_point; - # make a throw-away delta quaternion and then fill in the x and y for the targets - # DFC/DC_T that are being checked. - my $temp_delta = ($target{quat})->divide($center_quat); - if ($dest_obsid =~ /DFC/){ - $temp_delta->{q}[1] = 0; - $temp_delta->{q}[2] = 0; - $pred_point = $temp_delta->multiply($center_quat); - } - if ($dest_obsid =~ /DC_T/){ - $temp_delta->{q}[1] = arcsec_to_rad($pointings{$dest_obsid}->{dx})/2; - $temp_delta->{q}[2] = arcsec_to_rad($pointings{$dest_obsid}->{dy})/2; - $pred_point = $temp_delta->multiply($center_quat); - } - - if ( !quat_near($target{quat}, $pred_point, $as_slop) ){ - push @{$output{info}}, { text => sprintf("Delta position of " . $target{obsid} - . " relative to DFC of ($x, $y) is incorrect"), - type => 'error' }; - $output{status} = 0; - } - else{ - push @{$output{info}}, { text => sprintf("Delta position of " . $target{obsid} - . " relative to DFC_I is (% 7.2f, % 7.2f) : Correct", $x, $y), - type => 'info' }; - } - } - return \%output; - -} - - -##*************************************************************************** -sub quat_near{ -##*************************************************************************** - #radius in arcseconds - my ($quat1, $quat2, $radius) = @_; - my $delta = $quat2->divide($quat1); - my ($d_pitch, $d_yaw) = ($delta->{q}[1]*2, $delta->{q}[2]*2); - my $dist = rad_to_arcsec(sph_dist($d_pitch, $d_yaw)); - return ( $dist <= $radius); - -} - -##*************************************************************************** -sub sph_dist{ -##*************************************************************************** -# in radians - my ($a2, $d2)= @_; - my ($a1, $d1) = (0, 0); - - return(0.0) if ($a1==$a2 && $d1==$d2); - - return acos( cos($d1)*cos($d2) * cos(($a1-$a2)) + - sin($d1)*sin($d2)); -} - -##*************************************************************************** -sub rad_to_arcsec{ -##*************************************************************************** - my $rad = shift; - my $r2d = 180./3.14159265358979; - return $rad*60*60*$r2d; -} - -##*************************************************************************** -sub arcsec_to_rad{ -##*************************************************************************** - my $arcsec = shift; - my $r2d = 180./3.14159265358979; - return $arcsec/( 60*60*$r2d ); -} - - - - -##*************************************************************************** -sub entry_arrays_match{ -##*************************************************************************** - - my %output = ( - status => 1, - ); - - - my ($entries, $config_entries ) = @_; - - if (scalar(@{$entries}) != scalar(@{$config_entries})){ - $output{status} = 0; - $output{info} = [{ text => "Mismatch in number of commands", type => 'error'}]; - return \%output; - } - - for my $i (0 .. scalar(@{$entries})-1){ - - my $config_entry = TLREntry->new(%{$config_entries->[$i]}); - my $match = $entries->[$i]->loose_match($config_entry); - if (defined $match->{info}){ - push @{$output{info}}, @{$match->{info}}; - } - - unless ( $match->{status} ){ - $output{status} = 0; - } - } - - return \%output; -} - -##*************************************************************************** -sub trim_tlr{ -##*************************************************************************** - - my $tlr = shift; - my $config = shift; - my %command_dict = %{$config->{dict}{TLR}{comm_mnem}}; - - my @trim_tlr; - - for my $entry (@{$tlr->{entries}}){ - next unless( defined $entry->rel_time() ); - next unless( $entry->rel_time() >= 0 ); - next unless( defined $command_dict{$entry->comm_mnem()}); - if (scalar(@trim_tlr)){ - $entry->previous_entry($trim_tlr[-1]); - } - push @trim_tlr, $entry; - } - - return \@trim_tlr; -} - - -##*************************************************************************** -sub compare_timingncommanding{ -##*************************************************************************** - - my $tlr_arr = shift; - my $templ_arr = shift; - my $config = shift; - my $comment = shift; - - my %output = ( - status => 1, - comment => ["$comment"], - n_checks => 0, - n_fails => 0, - ); - - - - my %command_dict = %{$config->{dict}{TLR}{comm_mnem}}; - - my @match_tlr_arr = @{$tlr_arr}; - - push @{$output{criteria}}, "Compares TLR entries to template TLR entries"; - my $string_cmd_dict = join(" ", (keys %command_dict)); - push @{$output{criteria}}, $string_cmd_dict; - - push @{$output{criteria}}, "Checks each entry against template entry for matching timing, comm_mnem, and hex."; - for my $i (0 .. scalar(@match_tlr_arr)-1){ - if ((defined $match_tlr_arr[$i]) and (defined $templ_arr->[$i])){ - my $match = $match_tlr_arr[$i]->matches_entry($templ_arr->[$i]); - push @{$output{info}}, @{$match->{info}}; - $output{n_checks}++; - if ( $match->{status} ){ - next; - } - else{ - $output{status} = 0; - $output{n_fails}++; - next; - } - } - else{ - push @{$output{error}}, "Mismatch in number of entries" ; - $output{status} = 0; - } - } - - - push @{$output{criteria}}, "Error if wrong number of commands found"; - if (scalar(@match_tlr_arr) < scalar(@{$templ_arr})){ - push @{$output{info}} , { text => "Not enough entries in the ACA commanding section", type => 'error'} ; - $output{status} = 0; - } - - return \%output; - -} - - -##*************************************************************************** -sub fix_config_hex{ -##*************************************************************************** - - my $config = shift; - -# Config::General doesn't seem to have a method to create single element -# arrays. Here I push single hex command strings into arrays. I should get -# the list from the config instead of specifying it here - - my @transponders = ( 'independent' ); - - for my $transponder (@transponders){ - - my $template = $config->{template}{$transponder}; - - for my $command (keys %{$template}){ - - if (ref($template->{$command}) ne 'ARRAY'){ - $template->{$command} = [$template->{$command}]; - } - - for my $entry (@{$template->{$command}}){ - if ( grep 'hex', (keys %{$entry})){ - if (ref($entry->{hex}) ne 'ARRAY'){ - $entry->{hex} = [$entry->{hex}]; - } - - } - } - - - } - } - - -} - - -##*************************************************************************** -sub get_file { -##*************************************************************************** - my $glob = shift; - my $name = shift; - my $required = shift; - my $input_files = shift; - my $warning = ($required ? "ERROR" : "WARNING"); - - my @files = glob("$glob"); - if (@files != 1) { - if (scalar(@files) == 0){ - croak("$warning: No $name file matching $glob\n"); - } - else{ - croak("$warning: Found more than one file matching $glob, using none\n"); - } - } -# $input_files->{$name}=$files[0]; - push @{$input_files}, "Using $name file $files[0]"; - return $files[0]; -} - - -##*************************************************************************** -sub print{ -##*************************************************************************** - - my $dark_cal_checker = shift; - my $opt = shift; - my $out; - - for my $file (@{$dark_cal_checker->{input_files}}){ - $out .= "$file \n"; - } - $out .= "\n"; - - - for my $check (@{$dark_cal_checker->{checks}}){ - $out .= $dark_cal_checker->format_dark_cal_check($check, $opt); - if ($opt->{html_standalone}){ - $out .= "\n"; - } - } - - $out .= "\n\n"; - $out .= "ACA Dark Cal Checker Report:\n"; - $out .= sprintf( "[" . is_ok($dark_cal_checker->{trans_replica_0}->{status} - and $dark_cal_checker->{trans_replica_1}->{status} - and $dark_cal_checker->{trans_replica_2}->{status} - and $dark_cal_checker->{trans_replica_3}->{status} - and $dark_cal_checker->{trans_replica_4}->{status}) . "]\ttransponder correctly selected before each replica\n"); - $out .= sprintf("[" . is_ok($dark_cal_checker->{tnc_replica_0}->{status} - and $dark_cal_checker->{tnc_replica_1}->{status} - and $dark_cal_checker->{tnc_replica_2}->{status} - and $dark_cal_checker->{tnc_replica_3}->{status} - and $dark_cal_checker->{tnc_replica_4}->{status}) . "]\tACA Calibration Commanding (hex, sequence, and timing of ACA/OBC commands).\n"); - $out .= sprintf("[". is_ok($dark_cal_checker->{check_manvr}->{status} and $dark_cal_checker->{check_dwell}->{status}) . "]\tManeuver and Dwell timing.\n"); - $out .= sprintf("[" . is_ok($dark_cal_checker->{check_manvr_point}->{status}) . "]\tManeuver targets.\n"); - $out .= sprintf("[" . is_ok($dark_cal_checker->{dither_disable_0}->{status} - and $dark_cal_checker->{dither_disable_1}->{status} - and $dark_cal_checker->{dither_disable_2}->{status} - and $dark_cal_checker->{dither_disable_3}->{status} - and $dark_cal_checker->{dither_disable_4}->{status} - and $dark_cal_checker->{check_dither_enable_at_end}->{status} - and $dark_cal_checker->{check_dither_param_at_end}->{status}) . "]\tDither enable/disable and parameter commands\n"); - - $out .= "\n"; - - $out .= $dark_cal_checker->transponder_timing(); - - - if ($opt->{html_standalone}){ - my $html = "
" . $out . "
" ; - return $html; - } - - return $out; -} - -##*************************************************************************** -sub transponder_timing{ -##*************************************************************************** - my $self = shift; - my $trans = ''; - my $text = "For dark current operations, transponder should be set to:\n"; - for my $t (0 .. 4){ - if ($trans ne $self->{"tnc_replica_$t"}->{'transponder'}){ - $trans = $self->{"tnc_replica_$t"}->{'transponder'}; - $text .= "Transponder " . $trans; - if ($t > 0){ - $text .= "\tafter " . $self->{'tlr'}->end_replica($t-1)->datestamp() . "\n\t"; - } - $text .= "\tbefore " . $self->{'tlr'}->begin_replica($t)->datestamp() . "\n"; - if ($self->{"trans_replica_$t"}->{status} == 1){ - $text .= "\t\t(Commanding already included in Loads)\n"; - } - else{ - $text .= "\t\tRequires real time commanding\n"; - } - } - } - - return $text; -} - -##*************************************************************************** -sub is_ok{ -##*************************************************************************** - my $check = shift; - my $red_font_start = qq{}; - my $font_stop = qq{}; - if ($check){ - return "ok"; - } - else{ - return "${red_font_start}NO${font_stop}"; - } -} - - - -##*************************************************************************** -sub format_dark_cal_check{ -# Run check controls the printing of all information passed back from the -# checking subroutines -##*************************************************************************** - - my $self = shift; - my $check_name = shift; - # if anything left, use the options, else set defaults - my $opt = 1 == @_ ? pop @_ : { 'criteria' => 0, 'verbose' => 0, 'html_standalone' => 0 }; - - my $feedback = $self->{$check_name}; - - my $red_font_start = qq{}; - my $yellow_font_start = qq{}; - my $blue_font_start = qq{}; - my $font_stop = qq{}; - - my $return_string; - - if ($opt->{criteria}){ - # add a ref to get here from the starcheck page - $return_string .= "\n"; - } - - $return_string .= "[" . is_ok($feedback->{status}). "]\t"; - - if (!$opt->{criteria} & !$opt->{verbose} & !$opt->{html_standalone} & defined $opt->{link_to}){ - $return_string .= "{link_to}#$check_name\">"; - } - - $return_string .= $feedback->{comment}[0] . "\n"; - - if (!$opt->{criteria} & !$opt->{verbose} & !$opt->{html_standalone} & defined $opt->{link_to}){ - $return_string .= ""; - } - - # if verbose or there's an error - if ($opt->{criteria}){ - for my $line (@{$feedback->{criteria}}){ - $return_string .= "$blue_font_start $line${font_stop}\n"; - } - } - if ($opt->{verbose}){ - for my $entry (@{$feedback->{info}}){ - my $line = $entry->{text}; - my $type = $entry->{type}; - if ($type eq 'info'){ - $return_string .= " \t$line \n"; - } - if ($type eq 'error'){ - $return_string .= "${red_font_start} --->>> $line${font_stop}\n"; - } - if ($type eq 'warn'){ - $return_string .= "${yellow_font_start} --->>> $line${font_stop}\n"; - } - } - - } - - return $return_string; - -} - - - - - -package TLR; - -use strict; -use warnings; -use IO::All; -use Data::Dumper; -use Carp; - - -##*************************************************************************** -sub new { -##*************************************************************************** - my ($class, $file, $type, $config) = @_; - my @tlr_lines = io($file)->slurp; - my @tlr_entries; - my $self; - $self->{n_entries} = 0; - $self->{entries} = []; - - bless $self, $class; - - if ($type eq 'tlr'){ - @tlr_entries = get_tlr_array(\@tlr_lines, $config, $self); - } - if ($type eq 'template'){ - @tlr_entries = get_templ_array(\@tlr_lines, $config, $self); - } - - for my $entry (@tlr_entries){ - $self->add_entry($entry); - } - - - return $self; - -} - -##*************************************************************************** -sub add_entry{ -##*************************************************************************** - my $self = shift; - my $entry = shift; - $entry->set_index($self->{n_entries}); - $self->{n_entries}++; - push @{$self->{entries}}, $entry; - return 1; -} - - -##*************************************************************************** -sub first_aca_hw_cmd{ -##*************************************************************************** - my $self = shift; - return $self->{first_aca_hw_cmd} if (defined $self->{first_aca_hw_cmd}); - - for my $entry (@{$self->{entries}}){ - if (defined $entry->{comm_mnem}){ - if ($entry->{comm_mnem} eq 'AAC1CCSC'){ - $self->{first_aca_hw_cmd} = $entry; - last; - } - } - } - - croak("No ACA commanding found.") unless defined $self->{first_aca_hw_cmd}; - - - return $self->{first_aca_hw_cmd}; - -} - -##*************************************************************************** -sub begin_replica{ -##*************************************************************************** - my $self = shift; - my $replica = shift; - return $self->{begin_replica}->{$replica} if (defined $self->{begin_replica}->{$replica}); - - my @aca_hw_cmds; - - for my $entry (@{$self->{entries}}){ - if (defined $entry->trace_id()){ - #print $entry->trace_id(), "\n"; - } - if ((defined $entry->trace_id()) and ($entry->trace_id() =~ /ADC_R$replica/)){ - $self->{begin_replica}->{$replica} = $entry; - last; - } - - } - - croak( "Could not find replica $replica beginning") - unless defined $self->{begin_replica}->{$replica}; - return $self->{begin_replica}->{$replica}; - -} - -##*************************************************************************** -sub end_replica{ -##*************************************************************************** - my $self = shift; - my $replica = shift; - return $self->{end_replica}->{$replica} if (defined $self->{end_replica}->{$replica}); - - for my $entry (reverse @{$self->{entries}}){ - if ((defined $entry->trace_id()) and ( $entry->trace_id() =~ /ADC_R$replica/)) { - $self->{end_replica}->{$replica} = $entry; - last; - } - } - - - croak("Could not find replica $replica end") - unless defined $self->{end_replica}->{$replica}; - - return $self->{end_replica}->{$replica}; - -} - -##*************************************************************************** -sub last_aca_hw_cmd{ -##*************************************************************************** - my $self = shift; - return $self->{last_aca_hw_cmd} if (defined $self->{last_aca_hw_cmd}); - - $self->{last_aca_hw_cmd} = $self->end_replica(4); - - - croak("No ACA commanding found. Could not define reference entry") - unless defined $self->{last_aca_hw_cmd}; - - - return $self->{last_aca_hw_cmd}; - -} - -##*************************************************************************** -sub manvr_away_from_dfc{ -##*************************************************************************** - my $self = shift; - return $self->{manvr_away_from_dfc} if (defined $self->{manvr_away_from_dfc}); - - # I want the maneuver away from dfc, which should be the 2nd maneuver - # after the last aca hw cmd - my $manvr_cnt = 0; - my @manvr_list; - - - for my $entry (@{$self->{entries}}){ - next unless (defined $entry->{comm_mnem}); - next unless ($entry->time() > $self->last_aca_hw_cmd()->time()); -# print $entry->datestamp, "\t", $entry->time(), "\t", ref($entry), "\n"; - next unless ($entry->comm_mnem() eq 'AOMANUVR'); - last if $manvr_cnt == 2; - push @manvr_list, $entry; - $manvr_cnt++; - } - - croak("Error finding maneuver away from DFC. ") - unless scalar(@manvr_list) == 2; - - $self->{manvr_away_from_dfc} = $manvr_list[1]; - - return $self->{manvr_away_from_dfc}; - -} - - -##*************************************************************************** -sub get_tlr_array { -##*************************************************************************** - - my $raw_tlr = shift; - my $config = shift; - my $parent = shift; - my $arr_field = $config->{format}{TLR}{arr_field}; - my $field = $config->{format}{TLR}{field}; - my @tlr; - my @raw_tlr_array = @{$raw_tlr}; - - for my $line_index (0 .. $#raw_tlr_array){ - - my $timestamp = tlr_substr($raw_tlr_array[$line_index], $field->{datestamp}); - - if (has_timestamp($timestamp)){ - - my $hex = tlr_substr($raw_tlr_array[$line_index], $arr_field->{hex}); - - if (has_hex($hex)){ - - my %linehash = ( - type => 'command', - parent => $parent, - ); - - for my $key (keys %{$field}){ - $linehash{$key} = tlr_substr($raw_tlr_array[$line_index], $field->{$key}); - } - - # clean up the hash - %linehash = remove_nullsnspaces(\%linehash); - - # print Dumper %linehash; - my $entry = CandidateTLREntry->new(%linehash); - $entry->add_hex($hex); - - push @tlr, $entry; - - } - # if there is no hex, store the line as info - else{ - my %linehash = ( - type => 'entry', - parent => $parent, - datestamp => $timestamp, - string => $raw_tlr_array[$line_index] =~ s/\s$timestamp//, - ); - my $entry = CandidateTLREntry->new(%linehash); - push @tlr, $entry; - } - } - # if no timestamp but there is hex - else{ - my $hex = tlr_substr($raw_tlr_array[$line_index], $arr_field->{hex}); - if (defined $hex && $hex =~ /\S\S\S\s\S\S\S\S/){ - my $last_entry = $tlr[-1]; -# print Dumper $last_entry; - $last_entry->add_hex($hex); - } - } - - } - - return @tlr; - -} - -##*************************************************************************** -sub remove_nullsnspaces{ -##*************************************************************************** - my $hashref = shift; - my %newhash = %{$hashref}; - - #don't bother with nulls and strip off spaces - while (my ($key, $value) = each(%newhash)){ - if ($value =~ /^\s+$/){ - delete($newhash{$key}); - } - else{ - $newhash{$key} =~ s/^\s+//; - $newhash{$key} =~ s/\s+$//; - } - } - - return %newhash; -} - -##*************************************************************************** -sub has_hex{ -##*************************************************************************** - my $field = shift; - if (not defined $field){ - return 0; - } - if ($field =~ /\S\S\S\s\S\S\S\S/){ - return 1; - } - else{ - return 0; - } - -} - - -##*************************************************************************** -sub has_timestamp{ -##*************************************************************************** - my $field = shift; - if ( not defined $field){ - return 0; - } - if ( $field =~ /\d\d\d\d:\d\d\d:\d\d:\d\d:\d\d\.\d\d\d/ ){ - return 1; - } - else{ - return 0; - } - -} - -##*************************************************************************** -sub get_templ_array { -##*************************************************************************** - - my $raw_tlr = shift; - my $config = shift; - my $parent = shift; - my $field = $config->{format}{Template}{field}; - - my $arr_field = $config->{format}{Template}{arr_field}; - - my @template; - my @raw_tlr_array = @{$raw_tlr}; - - for my $line_index (0 .. $#raw_tlr_array ){ - - my $timestamp_area = tlr_substr($raw_tlr_array[$line_index], $field->{datestamp}); - - if (has_timestamp($timestamp_area)){ - my $hex_area = tlr_substr($raw_tlr_array[$line_index], $arr_field->{hex}); - - if (has_hex($hex_area)){ - my %linehash = ( - type => 'command', - parent => $parent, - ); - - for my $key (keys %{$field}){ - $linehash{$key} = tlr_substr($raw_tlr_array[$line_index], $field->{$key}); - } - - #don't bother with nulls and strip off spaces - %linehash = remove_nullsnspaces(\%linehash); - - my $entry = TemplateTLREntry->new(%linehash); - - $entry->add_hex($hex_area); - - if (scalar(@template)){ - $entry->previous_entry($template[-1]); - } - - push @template, $entry; - } - } - # if no timestamp but there is hex - else{ - my $hex_area = tlr_substr($raw_tlr_array[$line_index], $arr_field->{hex}); - if (has_hex($hex_area)){ - my $last_entry = $template[-1]; - $last_entry->add_hex($hex_area); - } - } - - } - - - return @template; - -} - - -##*************************************************************************** -sub tlr_substr{ -##*************************************************************************** - my $line = shift; - my $loc_ref = shift; - my $string; - - if (length($line) >= $loc_ref->{stop}){ - $string = substr($line, ($loc_ref->{start}-1), ($loc_ref->{stop}-($loc_ref->{start}-1))); - } - - return $string; -} - - - -package TLREntry; - -use strict; -use Carp; -use Ska::Convert qw(date2time); - - -use Class::MakeMethods::Standard::Hash ( - scalar => [ (qw( - comm_desc - datestamp - replica - hex - index - trace_id - previous_entry - )) - ], - ); - - -##*************************************************************************** -sub new{ -##*************************************************************************** - my ($class, %data) = @_; - my $clean_hash = strip_whitespace(\%data); - bless $clean_hash, $class; - -} - -##*************************************************************************** -sub set_index{ -##*************************************************************************** - my $self = shift; - $self->{index} = shift; -} - -##*************************************************************************** -sub matches_entry{ -##*************************************************************************** - my $entry1 = shift; - my $entry2 = shift; - - my %output = ( - status => 0, - ); - - $output{info} = [{ text => sprintf($entry1->datestamp() . "\t" . $entry1->comm_mnem() . "\t" . $entry1->comm_desc()), - type => 'info'}]; - - my $comm_mnem_match = ($entry1->comm_mnem() eq $entry2->comm_mnem()); - - if ( !$comm_mnem_match ){ -# push @{$output{error}} ,sprintf($entry1->datestamp() . "\t" . $entry1->comm_mnem() . "\t" . $entry1->comm_desc()); - push @{$output{info}}, { text => sprintf($entry1->datestamp() . "\t" . $entry1->comm_mnem() . "\t" . $entry1->comm_desc()), - type => 'error'}; - - push @{$output{info}}, { text => sprintf( "\tBad comm_mnem: " . $entry1->comm_mnem() . " does not match expected " . $entry2->comm_mnem()), - type => 'error' }; - } - - my $REL_TIME_TOL = 1e-6; # seconds - my $step_rel_time_match = (abs($entry1->step_rel_time_replica() - $entry2->step_rel_time_replica()) < $REL_TIME_TOL); - if ( !$step_rel_time_match ){ -# push @{$output{error}} ,sprintf($entry1->datestamp() . "\t" . $entry1->comm_mnem() . "\t" . $entry1->comm_desc()); -# push @{$output{error}}, sprintf("step relative time mismatch: " . $entry1->step_rel_time_replica() . " secs tlr, " . $entry2->step_rel_time_replica() . " secs template "); - push @{$output{info}}, { text => sprintf($entry1->datestamp() . "\t" . $entry1->comm_mnem() . "\t" . $entry1->comm_desc()), - type => 'error'}; - - push @{$output{info}}, { text => sprintf("step relative time mismatch: " - . $entry1->step_rel_time_replica() . " secs tlr, " - . $entry2->step_rel_time_replica() . " secs template "), - type => 'error'}; - } - else{ - push @{$output{info}}, { text => sprintf("step relative time match : " . $entry1->step_rel_time_replica() . " secs "), - type => 'info' }; - } - -# my $rel_time_match = ($entry1->rel_time() == $entry2->rel_time()); -# -# if ( !$rel_time_match ){ -## push @{$output{info}} ,sprintf($entry1->datestamp() . "\t" . $entry1->comm_mnem() . "\t" . $entry1->comm_desc()); -## push @{$output{info}}, { text => sprintf($entry1->datestamp() . "\t" . $entry1->comm_mnem() . "\t" . $entry1->comm_desc()), -## type => 'error'}; -# -# push @{$output{info}}, { text => sprintf( "Bad rel time from start: " . $entry1->rel_time() . " does not match expected " . $entry2->rel_time()), -# type => 'info'}; -#} -# else{ -# push @{$output{info}}, { text => sprintf("Good rel time from start: " . $entry1->rel_time() . " secs "), -# type => 'info'}; -# } - - my $hex_equal = check_hex_equal($entry1->hex(), $entry2->hex()); - if (defined $hex_equal->{info}){ - push @{$output{info}}, @{$hex_equal->{info}}; - } - if (($entry1->comm_mnem() eq $entry2->comm_mnem()) and - ($step_rel_time_match) and - ($hex_equal->{status})){ - $output{status} = 1; - } - - return \%output; - -} - -##*************************************************************************** -sub loose_match{ - - my $entry1 = shift; - my $entry2 = shift; - - my %output; - - $output{status} = 0; - - $output{info} = [{ text => sprintf($entry1->datestamp() . "\t" . $entry1->comm_mnem() . "\t" . $entry1->comm_desc()), - type => 'info', - }]; - - my $comm_mnem_match = ($entry1->comm_mnem() eq $entry2->comm_mnem()); - - if ( !$comm_mnem_match ){ - - push @{$output{info}}, { text => sprintf($entry1->datestamp() . "\t" . $entry1->comm_mnem() . "\t" . $entry1->comm_desc()), - type => 'error', - }; - - push @{$output{info}}, { text => sprintf( "\tBad comm_mnem: " . $entry1->comm_mnem() . " does not match expected " . $entry2->comm_mnem()), - type => 'error', - }; - } - - my $hex_equal = check_hex_equal($entry1->hex(), $entry2->hex()); - - if (defined $hex_equal->{info}){ - push @{$output{info}}, @{$hex_equal->{info}}; - } -# if (defined $hex_equal->{error}){ -# push @{$output{error}}, sprintf($entry1->datestamp() . "\t" . $entry1->comm_mnem() . "\t" . $entry1->comm_desc()); -# push @{$output{error}}, @{$hex_equal->{error}}; -# } - - - if (($comm_mnem_match) and - ($hex_equal->{status})){ - $output{status} = 1; - } - - return \%output; - -} - - - - -##*************************************************************************** -sub check_hex_equal { -##*************************************************************************** - - my %output; - $output{status} = 1; - - my ($hex_a, $hex_b) = @_; - - if ( scalar(@{$hex_a}) != scalar(@{$hex_b}) ){ - $output{info} = [{ text => "hex commands have different number of entries", - type => 'error'}]; - $output{status} = 0; - return \%output; - } - - for my $i (0 .. scalar(@{$hex_a})-1){ - if ($hex_a->[$i] ne $hex_b->[$i]){ - $output{info} = [{ text => "\tBad hex: $hex_a->[$i] does not match expected $hex_b->[$i]", - type => 'error'}]; - $output{status} = 0; - return \%output; - } - push @{$output{info}}, { text => "\thex ok: $hex_a->[$i] matches expected $hex_b->[$i]", - type => 'info'}; - } - - return \%output; - - -} - - - -##*************************************************************************** -sub strip_whitespace{ -##*************************************************************************** - my $hash = shift; - my %clean_hash; - - while ( my ($key, $value) = each (%{$hash})){ - $value =~ s/\s+$//; - $value =~ s/^\s+//; - $clean_hash{$key} = $value; - } - return \%clean_hash; -} - -##*************************************************************************** -sub time{ -##*************************************************************************** - my $entry = shift; - - if (@_){ - $entry->{time} = $_[0]; - } elsif (not defined $entry->{time}){ - $entry->{time} = date2time($entry->datestamp); - } - return $entry->{time}; -} - -##*************************************************************************** -sub comm_mnem{ -# return empty string instead of undef if undefined! -##*************************************************************************** - my $entry = shift; - if (defined $entry->{comm_mnem}){ - return $entry->{comm_mnem}; - } - return qq(); -} - -sub step_rel_time_replica{ - # reset to give replica relative times... - my $entry = shift; - if ((defined $entry->previous_entry()) - and (defined $entry->replica()) - and (defined $entry->previous_entry()->replica()) - and ($entry->previous_entry()->replica() == $entry->replica())){ - return ( $entry->time() - $entry->previous_entry()->time()); - } - return 0; -} - - -##*************************************************************************** -sub rel_time{ -##*************************************************************************** - my $entry = shift; - return ($entry->time() - $entry->{parent}->first_aca_hw_cmd->time()); - -} - - -##*************************************************************************** -sub add_hex{ -##*************************************************************************** - my ($entry, $hex) = @_; - push @{$entry->{hex}}, $hex; -} -1; - - -package TemplateTLREntry; - -use strict; -use warnings; -use Carp; - -use base 'TLREntry'; - -our @ISA = qw( TLREntry ); -1; - - -package CandidateTLREntry; -use strict; -use warnings; -use Carp; - -use base 'TLREntry'; - -our @ISA = qw( TLREntry ); - -sub replica{ - my $self = shift; - return $self->{replica} if (defined $self->{replica}); - for my $r_idx (0 .. 4){ - # find the indexes in the real tlr and trim to a reduced set of commands to check - my $r_start = $self->{parent}->begin_replica($r_idx)->index(); - my $r_end = $self->{parent}->end_replica($r_idx)->index(); - if (($self->index() >= $r_start) and ($self->index() <= $r_end)){ - $self->{replica} = $r_idx; - return $self->{replica}; - } - } - return undef; -} - -1; - - diff --git a/starcheck/src/lib/Ska/Starcheck/Obsid.pm b/starcheck/src/lib/Ska/Starcheck/Obsid.pm index 8cea3ea1..deb2c815 100644 --- a/starcheck/src/lib/Ska/Starcheck/Obsid.pm +++ b/starcheck/src/lib/Ska/Starcheck/Obsid.pm @@ -25,9 +25,11 @@ use Inline Python => q{ import numpy as np from astropy.table import Table +from starcheck.utils import time2date, date2time, de_bytestr from mica.archive import aca_dark from chandra_aca.star_probs import guide_count -from chandra_aca.transform import yagzag_to_pixels, count_rate_to_mag, mag_to_count_rate +from chandra_aca.transform import (yagzag_to_pixels, pixels_to_yagzag, + count_rate_to_mag, mag_to_count_rate) import Quaternion from Ska.quatutil import radec2yagzag import agasc @@ -43,6 +45,20 @@ ACQS = mica.stats.acq_stats.get_stats() GUIDES = mica.stats.guide_stats.get_stats() +def _pixels_to_yagzag(i, j): + """ + Call chandra_aca.transform.pixels_to_yagzag. + This wrapper is set to pass allow_bad=True, as exceptions from the Python side + in this case would not be helpful, and the very small bad pixel list should be + on the CCD. + :params i: pixel row + :params j: pixel col + :returns tuple: yag, zag as floats + """ + yag, zag = pixels_to_yagzag(i, j, allow_bad=True) + return float(yag), float(zag) + + def _yagzag_to_pixels(yag, zag): """ Call chandra_aca.transform.yagzag_to_pixels. @@ -212,12 +228,10 @@ def get_mica_star_stats(agasc_id, time): use List::Util qw(min max); use Quat; -use Ska::ACACoordConvert; use File::Basename; use POSIX qw(floor); use English; use IO::All; -use Ska::Convert qw(date2time time2date); use RDB; @@ -334,7 +348,7 @@ sub set_ACA_bad_pixels { foreach my $j ($line[2]..$line[3]) { my $pixel = {'row' => $i, 'col' => $j}; - my ($yag,$zag) = Ska::ACACoordConvert::toAngle($i,$j); + my ($yag,$zag) = _pixels_to_yagzag($i, $j); $pixel->{yag} = $yag; $pixel->{zag} = $zag; push @bad_pixels, $pixel; diff --git a/starcheck/src/starcheck b/starcheck/src/starcheck index 1d48e9a6..a2a8f70b 100755 --- a/starcheck/src/starcheck +++ b/starcheck/src/starcheck @@ -20,7 +20,7 @@ then exit 1 fi # Check for perl deps -perl -e "use IO::All; use Time::DayOfYear;" +perl -e "use IO::All;" if [[ $? -ne 0 ]]; then echo "****" diff --git a/starcheck/src/starcheck.pl b/starcheck/src/starcheck.pl index 010b09eb..4af6740c 100755 --- a/starcheck/src/starcheck.pl +++ b/starcheck/src/starcheck.pl @@ -21,22 +21,14 @@ use File::Copy; use Scalar::Util qw(looks_like_number); -use Time::JulianDay; -use Time::DayOfYear; -use Time::Local; use PoorTextFormat; -#use lib '/proj/axaf/simul/lib/perl'; -#use GrabEnv qw( grabenv ); -#use Shell::GetEnv; - use Ska::Starcheck::Obsid; use Ska::Parse_CM_File; use Carp; use YAML; use JSON (); -use Ska::Convert qw( date2time ); use Cwd qw( abs_path ); use HTML::TableExtract; @@ -50,107 +42,15 @@ import os import traceback -from Chandra.Time import DateTime from chandra_aca.star_probs import set_acq_model_ms_filter -import starcheck -from starcheck.pcad_att_check import make_pcad_attitude_check_report, check_characteristics_date -from starcheck.calc_ccd_temps import get_ccd_temps -from starcheck import __version__ as version -from kadi.commands import states - -# Borrowed from https://stackoverflow.com/a/33160507 -def de_bytestr(data): - if isinstance(data, bytes): - return data.decode() - if isinstance(data, dict): - return dict(map(de_bytestr, data.items())) - if isinstance(data, tuple): - return tuple(map(de_bytestr, data)) - if isinstance(data, list): - return list(map(de_bytestr, data)) - if isinstance(data, set): - return set(map(de_bytestr, data)) - return data - -def ccd_temp_wrapper(kwargs): - try: - return get_ccd_temps(**de_bytestr(kwargs)) - except Exception: - import traceback - traceback.print_exc() - raise - -def plot_cat_wrapper(kwargs): - try: - from starcheck.plot import make_plots_for_obsid - except ImportError as err: - # write errors to starcheck's global warnings and STDERR - perl.warning("Error with Inline::Python imports {}\n".format(err)) - return make_plots_for_obsid(**de_bytestr(kwargs)) - -def starcheck_version(): - return version - -def get_data_dir(): - sc_data = os.path.join(os.path.dirname(starcheck.__file__), 'data') - return sc_data if os.path.exists(sc_data) else "" - -def _make_pcad_attitude_check_report(kwargs): - try: - return make_pcad_attitude_check_report(**de_bytestr(kwargs)) - except Exception as err: - perl.warning("Error running dynamic attitude checks {}\n".format(err)) - - -def get_dither_kadi_state(date): - date = date.decode('ascii') - cols = ['dither', 'dither_ampl_pitch', 'dither_ampl_yaw', 'dither_period_pitch', 'dither_period_yaw'] - state = states.get_continuity(date, cols) - # Cast the numpy floats as plain floats - for key in ['dither_ampl_pitch', 'dither_ampl_yaw', 'dither_period_pitch', 'dither_period_yaw']: - state[key] = float(state[key]) - # get most recent change time - state['time'] = float(np.max([DateTime(state['__dates__'][key]).secs for key in cols])) - return state - - -def get_run_start_time(run_start_time, backstop_start): - """ - Determine a reasonable reference run start time based on the supplied - run start time and the time of the first backstop command. This - code uses a small hack so that a negative number is interpreted - as the desired "days back" from the backstop start time. All other - Chandra.Time compatible formats for run start are used as absolute - times (which will then be passed to the thermal model code as the - time before which telemetry should be found for an initial state). - Note that the logic to determine the initial state will not allow - that state to be after backstop start time. - - :param run_start_time: supplied run start time in a Chandra.Time format, - empty string interpreted as "now" as expected, - negative numbers special cased to be interpreted as - "days back" relative to first backstop command. - :param backstop_start: time of first backstop command - :returns: YYYY:DOY string of reference run start time - """ - - run_start_time = de_bytestr(run_start_time) - backstop_start = de_bytestr(backstop_start) - - # For the special case where run_start_time casts as a float - # check to see if it is negative and if so, set the reference - # time to be a time run_start_time days back from backstop start - try: - run_start_time = float(run_start_time) - # Handle nominal errors if run_start_time None or non-float Chandra.Time OK string. - except (TypeError, ValueError): - ref_time = DateTime(run_start_time) - else: - if run_start_time < 0: - ref_time = DateTime(backstop_start) + run_start_time - else: - raise ValueError("Float run_start_time should be negative") - return ref_time.date +from starcheck.pcad_att_check import check_characteristics_date +from starcheck.utils import (_make_pcad_attitude_check_report, + plot_cat_wrapper, + date2time, time2date, + ccd_temp_wrapper, + starcheck_version, get_data_dir, + get_dither_kadi_state, + get_run_start_time) }; @@ -158,10 +58,6 @@ my $version = starcheck_version(); -# cheat to get the OS (major) -my $OS = `uname`; -chomp($OS); - # Set some global vars with directory locations my $SKA = $ENV{SKA} || '/proj/sot/ska'; @@ -341,26 +237,6 @@ my ($fid_time_violation, $error, $fidsel) = Ska::Parse_CM_File::fidsel($fidsel_file, \@bs) ; map { warning("$_\n") } @{$error}; -## Warn if we are on Solaris -if ($OS eq 'SunOS'){ - warning("uname == SunOS; starcheck is only approved on Linux \n"); -} - - -# Dark Cal Checker Section -use Ska::Starcheck::Dark_Cal_Checker; -my $dark_cal_checker; -eval{ - $dark_cal_checker = Ska::Starcheck::Dark_Cal_Checker->new({ dir => $par{dir}, - app_data => $Starcheck_Data}); -}; -if ($@){ - unless ($@ =~ /No ACA commanding found/){ - warning("Dark Cal Checker Failed $@ \n"); - } -} - - # Now that global_warn exists, if the DOT wasn't made/modified by SAUSAGE # throw an error @@ -381,16 +257,6 @@ Ska::Starcheck::Obsid::set_config($config_ref); -# If there is a dark current, add the obsids of the dark cal replicas -# (which have keys beginning with "DC_T") to the set of obsids/oflsids -# that are "ok" to not have star catalogs -if ($dark_cal_checker->{dark_cal_present}){ - foreach my $key (keys %{$dark_cal_checker->{dc_oflsid}}){ - if ($key =~ /DC_T/){ - push @{$config_ref->{no_starcat_oflsid}}, $dark_cal_checker->{dc_oflsid}->{$key}; - } - } -} # Set the multple star filter disabled in the model if after this date my $MSF_ENABLED = $bs[0]->{date} lt '2016:102:00:00:00.000'; @@ -803,18 +669,6 @@ sub json_obsids{ } } -# Dark Cal Checker -if ($dark_cal_checker->{dark_cal_present}){ - $out .= "------------ DARK CURRENT CALIBRATION CHECKS -----------------\n\n"; - # Add a link to the comm summary if we've figured out a mission planning week name for these products - if ($mp_top_link){ - my $url = sprintf("https://occweb.cfa.harvard.edu/occweb/FOT/mission_planning/Backstop/%s/output/%s_CommSum.html", $mp_top_link->{week}, $mp_top_link->{week}); - $out .= sprintf("Comm Summary: %s\n\n", $url, $mp_top_link->{week}); - } - $out .= dark_cal_print($dark_cal_checker, $STARCHECK); - $out .= "\n"; -} - # CCD temperature plot if ($obsid_temps){ $out .= "------------ CCD TEMPERATURE PREDICTION -----------------\n\n"; @@ -1025,35 +879,7 @@ sub json_obsids{ print STDERR "Wrote text report to $STARCHECK.txt\n"; } - -##*************************************************************************** -sub dark_cal_print{ -##*************************************************************************** - - my $dark_cal_checker = shift; - my $out_dir = shift; - - io("${out_dir}/dark_cal_verbose.html")->print($dark_cal_checker->print({ verbose => 1, - criteria => 0, - html_standalone => 1})); - - - io("${out_dir}/dark_cal_super_verbose.html")->print($dark_cal_checker->print({verbose => 1, - criteria => 1, - html_standalone => 1})); - - my $out; - $out .= "VERBOSE "; - $out .= "SUPERVERBOSE\n"; - $out .= $dark_cal_checker->print({verbose => 0, - criteria => 0, - html => 0, - link_to => "${out_dir}/dark_cal_super_verbose.html", - }); - - return $out; -} ##*************************************************************************** sub guess_mp_toplevel{ diff --git a/starcheck/utils.py b/starcheck/utils.py new file mode 100644 index 00000000..04d0b520 --- /dev/null +++ b/starcheck/utils.py @@ -0,0 +1,117 @@ +import os +import numpy as np + +from Chandra.Time import DateTime +from Chandra.Time import secs2date as time2date, date2secs as pydate2secs +from chandra_aca.star_probs import set_acq_model_ms_filter +import starcheck +from starcheck.pcad_att_check import make_pcad_attitude_check_report, check_characteristics_date +from starcheck.calc_ccd_temps import get_ccd_temps +from starcheck import __version__ as version +from kadi.commands import states + + +# Borrowed from https://stackoverflow.com/a/33160507 +def de_bytestr(data): + if isinstance(data, bytes): + return data.decode() + if isinstance(data, dict): + return dict(map(de_bytestr, data.items())) + if isinstance(data, tuple): + return tuple(map(de_bytestr, data)) + if isinstance(data, list): + return list(map(de_bytestr, data)) + if isinstance(data, set): + return set(map(de_bytestr, data)) + return data + + +def date2time(date): + return pydate2secs(de_bytestr(date)) + + +def ccd_temp_wrapper(kwargs): + try: + return get_ccd_temps(**de_bytestr(kwargs)) + except Exception: + import traceback + traceback.print_exc() + raise + + +def plot_cat_wrapper(kwargs): + try: + from starcheck.plot import make_plots_for_obsid + except ImportError as err: + # write errors to starcheck's global warnings and STDERR + perl.warning("Error with Inline::Python imports {}\n".format(err)) + return make_plots_for_obsid(**de_bytestr(kwargs)) + + +def starcheck_version(): + return version + + +def get_data_dir(): + sc_data = os.path.join(os.path.dirname(starcheck.__file__), 'data') + return sc_data if os.path.exists(sc_data) else "" + + +def _make_pcad_attitude_check_report(kwargs): + try: + return make_pcad_attitude_check_report(**de_bytestr(kwargs)) + except Exception as err: + perl.warning("Error running dynamic attitude checks {}\n".format(err)) + + +def get_dither_kadi_state(date): + date = date.decode('ascii') + cols = ['dither', 'dither_ampl_pitch', 'dither_ampl_yaw', + 'dither_period_pitch', 'dither_period_yaw'] + state = states.get_continuity(date, cols) + # Cast the numpy floats as plain floats + for key in ['dither_ampl_pitch', 'dither_ampl_yaw', + 'dither_period_pitch', 'dither_period_yaw']: + state[key] = float(state[key]) + # get most recent change time + state['time'] = float(np.max([DateTime(state['__dates__'][key]).secs for key in cols])) + return state + + +def get_run_start_time(run_start_time, backstop_start): + """ + Determine a reasonable reference run start time based on the supplied + run start time and the time of the first backstop command. This + code uses a small hack so that a negative number is interpreted + as the desired "days back" from the backstop start time. All other + Chandra.Time compatible formats for run start are used as absolute + times (which will then be passed to the thermal model code as the + time before which telemetry should be found for an initial state). + Note that the logic to determine the initial state will not allow + that state to be after backstop start time. + + :param run_start_time: supplied run start time in a Chandra.Time format, + empty string interpreted as "now" as expected, + negative numbers special cased to be interpreted as + "days back" relative to first backstop command. + :param backstop_start: time of first backstop command + :returns: YYYY:DOY string of reference run start time + """ + + run_start_time = de_bytestr(run_start_time) + backstop_start = de_bytestr(backstop_start) + + # For the special case where run_start_time casts as a float + # check to see if it is negative and if so, set the reference + # time to be a time run_start_time days back from backstop start + try: + run_start_time = float(run_start_time) + # Handle nominal errors if run_start_time None or non-float Chandra.Time OK string. + except (TypeError, ValueError): + ref_time = DateTime(run_start_time) + else: + if run_start_time < 0: + ref_time = DateTime(backstop_start) + run_start_time + else: + raise ValueError("Float run_start_time should be negative") + return ref_time.date