diff --git a/starcheck/src/StarcheckParser.pm b/starcheck/src/StarcheckParser.pm index 844aa1f9..ef655820 100755 --- a/starcheck/src/StarcheckParser.pm +++ b/starcheck/src/StarcheckParser.pm @@ -1,6 +1,6 @@ -##Starcheck parsing utilities -##Brett Unks -##Jan 2003 +##Starcheck parsing utilities +##Brett Unks +##Jan 2003 # Used by /proj/sot/ska/bin/new_obs.pl - which is no longer running # Used by /proj/sot/ska/database/star_parse.pl @@ -47,19 +47,18 @@ sub get_obsdata { my @tmp = split /\={50}\=+\s*\n/, $$starcheck; my @tmp1 = grep /OBSID:\s+0*$obsid(\s|\n)/, @tmp; my $obs_data; - if (scalar(@tmp1) == 1){ - $obs_data = shift @tmp1; - return ObsidParser->new_obsid($obs_data); + if (scalar(@tmp1) == 1) { + $obs_data = shift @tmp1; + return ObsidParser->new_obsid($obs_data); } - else{ - croak("Error. Obsid not found in starcheck file for load.\n"); + else { + croak("Error. Obsid not found in starcheck file for load.\n"); } - } ##*************************************************************************** -sub get_load_record{ +sub get_load_record { ##*************************************************************************** my $starcheck = shift; my $mp_path = shift; @@ -68,7 +67,7 @@ sub get_load_record{ } ##*************************************************************************** -sub get_header_lines{ +sub get_header_lines { ##*************************************************************************** my $starcheck = shift; my @tmp = split /\={84}\n\n/, $$starcheck; @@ -80,56 +79,56 @@ sub get_header_lines{ my @tmp1 = split /PARSEBREAK\n/, $header_text; my @top_match = grep /Starcheck/, @tmp1; - if ( scalar(@top_match) == 1){ - my $very_top = $top_match[0]; - my @top_lines = split /\n/, $very_top; - $header{very_top} = \@top_lines; + if (scalar(@top_match) == 1) { + my $very_top = $top_match[0]; + my @top_lines = split /\n/, $very_top; + $header{very_top} = \@top_lines; } my @proc_match = grep /PROCESSING\sWARNINGS\s/, @tmp1; - if (scalar(@proc_match) == 1){ - my $processing_warnings = $proc_match[0]; - #remove header - $processing_warnings =~ s/^------------.*\n//g; - # remove blank lines - $processing_warnings =~ s/^\n//g; - my @warning_lines = split /\n/, $processing_warnings; - $header{processing_warnings} = \@warning_lines; + if (scalar(@proc_match) == 1) { + my $processing_warnings = $proc_match[0]; + + #remove header + $processing_warnings =~ s/^------------.*\n//g; + + # remove blank lines + $processing_warnings =~ s/^\n//g; + my @warning_lines = split /\n/, $processing_warnings; + $header{processing_warnings} = \@warning_lines; } my @file_match = grep /PROCESSING\sFILES/, @tmp1; - if (scalar(@file_match) == 1){ - my $proc_files = $file_match[0]; - #remove header + if (scalar(@file_match) == 1) { + my $proc_files = $file_match[0]; + + #remove header $proc_files =~ s/^------------.*\n//g; + #remove blank lines $proc_files =~ s/^\n//g; - my @file_lines = split /\n/, $proc_files; - $header{processing_files} = \@file_lines; + my @file_lines = split /\n/, $proc_files; + $header{processing_files} = \@file_lines; } - my @summ_match = grep /SUMMARY\sOF\sOBSIDS\s/, @tmp1; - if (scalar(@summ_match) == 1){ - my $obsid_summary = $summ_match[0]; - #remove header - $obsid_summary =~ s/^------------.*\n//g; - #remove blank lines - $obsid_summary =~ s/^\n//g; - my @summary_lines = split /\n/, $obsid_summary; - $header{obsid_summary} = \@summary_lines; - } + if (scalar(@summ_match) == 1) { + my $obsid_summary = $summ_match[0]; + #remove header + $obsid_summary =~ s/^------------.*\n//g; + + #remove blank lines + $obsid_summary =~ s/^\n//g; + my @summary_lines = split /\n/, $obsid_summary; + $header{obsid_summary} = \@summary_lines; + } - return %header; } ##*************************************************************************** - - - ##*************************************************************************** ##*************************************************************************** package ObsidParser; @@ -140,6 +139,7 @@ use strict; use Carp; 1; + #@EXPORT = qw(new_obsid # get_full_record # get_target @@ -161,57 +161,64 @@ sub new_obsid { } ##*************************************************************************** -sub get_full_record{ +sub get_full_record { ##*************************************************************************** my $obs_data = shift; my $obsid = shift; - return StarcheckRecord->new_record($obs_data,$obsid) + return StarcheckRecord->new_record($obs_data, $obsid); } ##*************************************************************************** -sub get_target{ +sub get_target { ##*************************************************************************** my $data = shift; my @block = split "\n", $$data; my $topline = $block[0]; my %target; - if ($topline =~ /^OBSID:\s(\S{5})\s*$/){ + if ($topline =~ /^OBSID:\s(\S{5})\s*$/) { } - else{ - if ($topline =~ /OBSID:\s*(\S{1,5})\s+(.*)\s+(\S+)\s+SIM\sZ\soffset:\s*(-*\d+)\s.*\sGrating:\s*(\S+)\s*/ ){ - if ($topline =~ /OBSID:\s*(\S{1,5})\s+(.*)\s+(\S+)\s+SIM\sZ\soffset:\s*(-*\d+)\s+Grating:\s*(\S+)\s*/ ){ - %target = ( - 'obsid' => $1, - 'target' => $2, - 'sci_instr' => $3, - 'sim_z_offset_steps' => $4, - 'grating' => $5 - ); - $target{'target'} =~ s/\s+$//; - - } - if ($topline =~ /OBSID:\s*(\S{1,5})\s+(.*)\s+(\S+)\s+SIM\sZ\soffset:\s*(-*\d+)\s+\((-*.+)mm\)\s+Grating:\s*(\S+)\s*/ ){ - %target = ( - 'obsid' => $1, - 'target' => $2, - 'sci_instr' => $3, - 'sim_z_offset_steps' => $4, - 'sim_z_offset_mm' => $5, - 'grating' => $6 - ); - $target{'target'} =~ s/\s+$//; - - } - } - else{ - %target = (); - } + else { + if ($topline =~ +/OBSID:\s*(\S{1,5})\s+(.*)\s+(\S+)\s+SIM\sZ\soffset:\s*(-*\d+)\s.*\sGrating:\s*(\S+)\s*/ + ) + { + if ($topline =~ +/OBSID:\s*(\S{1,5})\s+(.*)\s+(\S+)\s+SIM\sZ\soffset:\s*(-*\d+)\s+Grating:\s*(\S+)\s*/ + ) + { + %target = ( + 'obsid' => $1, + 'target' => $2, + 'sci_instr' => $3, + 'sim_z_offset_steps' => $4, + 'grating' => $5 + ); + $target{'target'} =~ s/\s+$//; + + } + if ($topline =~ +/OBSID:\s*(\S{1,5})\s+(.*)\s+(\S+)\s+SIM\sZ\soffset:\s*(-*\d+)\s+\((-*.+)mm\)\s+Grating:\s*(\S+)\s*/ + ) + { + %target = ( + 'obsid' => $1, + 'target' => $2, + 'sci_instr' => $3, + 'sim_z_offset_steps' => $4, + 'sim_z_offset_mm' => $5, + 'grating' => $6 + ); + $target{'target'} =~ s/\s+$//; + + } + } + else { + %target = (); + } } return %target; } - - ##*************************************************************************** sub get_coords { ##*************************************************************************** @@ -219,10 +226,10 @@ sub get_coords { $$data =~ /RA, Dec, Roll \(deg\):\s+(.+)\n/; my @tmp = split " ", $1; my %coords = ( - RA => $tmp[0], - DEC => $tmp[1], - ROLL => $tmp[2] - ); + RA => $tmp[0], + DEC => $tmp[1], + ROLL => $tmp[2] + ); return %coords; } @@ -235,73 +242,78 @@ sub get_quat { my @tmp = split ",", $1; my @tmp1 = split " ", $2; my %quat = ( - $tmp[0] => $tmp1[0], - $tmp[1] => $tmp1[1], - $tmp[2] => $tmp1[2], - $tmp[3] => $tmp1[3] - ); + $tmp[0] => $tmp1[0], + $tmp[1] => $tmp1[1], + $tmp[2] => $tmp1[2], + $tmp[3] => $tmp1[3] + ); return %quat; } - ##*************************************************************************** sub get_stars { ##*************************************************************************** my ($data) = @_; my @stars; + #pull out the header - if ( $$data =~ /\-+\n\s+(.+)\n\-+\n/ ){ - my $hdr_long = $1; - my @hdr = split " ", $hdr_long; - #now parse out the stars and return an array of hashes - my @block = split "\n", $$data; - my @indices = grep /^\[.+\]\s+(.+)/, @block; - map { s/^(?:\[ |\[)(.+)\]\s+(.+)/$1 $2/} @indices; - for my $i (0.. $#indices){ - my @tmp = split " ", $indices[$i]; - for my $j (0.. $#hdr) { $stars[$i]{$hdr[$j]} = $tmp[$j] if defined $tmp[$j]}; - } + if ($$data =~ /\-+\n\s+(.+)\n\-+\n/) { + my $hdr_long = $1; + my @hdr = split " ", $hdr_long; + + #now parse out the stars and return an array of hashes + my @block = split "\n", $$data; + my @indices = grep /^\[.+\]\s+(.+)/, @block; + map { s/^(?:\[ |\[)(.+)\]\s+(.+)/$1 $2/ } @indices; + for my $i (0 .. $#indices) { + my @tmp = split " ", $indices[$i]; + for my $j (0 .. $#hdr) { + $stars[$i]{ $hdr[$j] } = $tmp[$j] if defined $tmp[$j]; + } + } } return @stars; -} - - +} ##*************************************************************************** -sub get_warnings { # and INFO blocks +sub get_warnings { # and INFO blocks ##*************************************************************************** my ($data, $index) = @_; my @block = split "\n", $$data; my @tmp = grep /^\>\>\s+(WARNING|INFO)\s*:/, @block; my @warnings; - for my $i (0.. $#tmp) { - if ($tmp[$i] =~ /.*(WARNING|INFO).*\[\s?(\d+)\]([\w\s]+)\.(.*)$/){ - if ($2 == $index){ - my $type = $3; - my $warn_index = $2; - my $details = $4; - $details =~ s/^\s*//; - push @warnings, { - TYPE => $type, - INDEX => $warn_index, - DETAILS => $details, - }; - } - } - else{ - if ($tmp[$i] =~ /^\>\>\s+(WARNING|INFO)\s*:\s+(.+)\.\s+(?:\[ |\[)(\d+)\].\s(.+)/){ - if ($3 == $index){ - push @warnings, { - TYPE => $2, - INDEX => $3, - DETAILS => $4, - }; - } - } - } + for my $i (0 .. $#tmp) { + if ($tmp[$i] =~ /.*(WARNING|INFO).*\[\s?(\d+)\]([\w\s]+)\.(.*)$/) { + if ($2 == $index) { + my $type = $3; + my $warn_index = $2; + my $details = $4; + $details =~ s/^\s*//; + push @warnings, + { + TYPE => $type, + INDEX => $warn_index, + DETAILS => $details, + }; + } + } + else { + if ($tmp[$i] =~ + /^\>\>\s+(WARNING|INFO)\s*:\s+(.+)\.\s+(?:\[ |\[)(\d+)\].\s(.+)/) + { + if ($3 == $index) { + push @warnings, + { + TYPE => $2, + INDEX => $3, + DETAILS => $4, + }; + } + } + } } return @warnings; -} +} ##*************************************************************************** sub get_star_type { @@ -319,8 +331,9 @@ sub get_all_warnings { ##*************************************************************************** my $data = shift; my @block = split "\n", $$data; -# use Data::Dumper; -# print Dumper @block; + + # use Data::Dumper; + # print Dumper @block; my @warnings = grep /^\>\>\s+(WARNING|INFO)\s*:/, @block; map { s/^\>\>\s+WARNING:\s+// } @warnings; map { s/^\>\>\s+INFO\s+:\s+// } @warnings; @@ -333,104 +346,112 @@ sub get_dither_info { my $data = shift; my %dither; - if ($$data =~ /Dither:\s(\S+)\s+Y_amp=\s*(\S+)\s+Z_amp=\s*(\S+)\s+Y_period=\s*(\S+)\s+Z_period=\s*(\S+)\s*\n/){ - %dither = ( - 'state' => $1, - 'y_amp' => $2, - 'z_amp' => $3, - 'y_period' => $4, - 'z_period' => $5 - ); + if ($$data =~ +/Dither:\s(\S+)\s+Y_amp=\s*(\S+)\s+Z_amp=\s*(\S+)\s+Y_period=\s*(\S+)\s+Z_period=\s*(\S+)\s*\n/ + ) + { + %dither = ( + 'state' => $1, + 'y_amp' => $2, + 'z_amp' => $3, + 'y_period' => $4, + 'z_period' => $5 + ); } return %dither; } ##*************************************************************************** -sub get_times{ +sub get_times { ##*************************************************************************** my $data = shift; -#MP_TARGQUAT at 2006:156:06:36:46.768 (VCDU count = 3473057) + + #MP_TARGQUAT at 2006:156:06:36:46.768 (VCDU count = 3473057) my %times; -#MP_STARCAT at 2006:156:06:36:48.411 (VCDU count = 3473063) - if ($$data =~ /MP_STARCAT\sat\s(\S+)\s\(VCDU\scount\s=\s(\d+)\)\n/g){ - $times{'MP_STARCAT'} = $1; - $times{'VCDU_cnt'} = $2; + + #MP_STARCAT at 2006:156:06:36:48.411 (VCDU count = 3473063) + if ($$data =~ /MP_STARCAT\sat\s(\S+)\s\(VCDU\scount\s=\s(\d+)\)\n/g) { + $times{'MP_STARCAT'} = $1; + $times{'VCDU_cnt'} = $2; } return %times; } ##*************************************************************************** -sub get_manvr{ +sub get_manvr { ##*************************************************************************** my $data = shift; - my @data_array = split( /\n/, $$data); -# use Data::Dumper; -# print Dumper @data_array; + my @data_array = split(/\n/, $$data); + + # use Data::Dumper; + # print Dumper @data_array; my @new_man; - foreach my $i (0 .. $#data_array){ - next unless ($data_array[$i] =~ /\AMP_TARGQUAT/); - my %temp_manvr; - if ($data_array[$i] =~ /MP_TARGQUAT\sat\s(\S+)\s\(VCDU\scount\s=\s(\d+)\)/){ - $temp_manvr{'MP_TARGQUAT'} = $1; - $temp_manvr{'VCDU_cnt'} = $2; - } - if ($data_array[$i + 1] =~ /(Q1,Q2,Q3,Q4):\s+(.+)/){ - my @tmp = split ",", $1; - my @tmp1 = split " ", $2; - my %quat = ( - $tmp[0] => $tmp1[0], - $tmp[1] => $tmp1[1], - $tmp[2] => $tmp1[2], - $tmp[3] => $tmp1[3] - ); - $temp_manvr{Q1}=$quat{Q1}; - $temp_manvr{Q2}=$quat{Q2}; - $temp_manvr{Q3}=$quat{Q3}; - $temp_manvr{Q4}=$quat{Q4}; - } - if ($data_array[$i + 2] =~ /\s+MANVR:\sAngle=\s+(\S+)\sdeg\s+Duration=\s+(\S+)\ssec\s+Slew\serr=\s+(\S+)\sarcsec\s*/){ - $temp_manvr{'angle_deg'} = $1; - $temp_manvr{'duration_sec'} = $2; - $temp_manvr{'slew_err_arcsec'} = $3; - } - push @new_man, \%temp_manvr; + foreach my $i (0 .. $#data_array) { + next unless ($data_array[$i] =~ /\AMP_TARGQUAT/); + my %temp_manvr; + if ($data_array[$i] =~ /MP_TARGQUAT\sat\s(\S+)\s\(VCDU\scount\s=\s(\d+)\)/) { + $temp_manvr{'MP_TARGQUAT'} = $1; + $temp_manvr{'VCDU_cnt'} = $2; + } + if ($data_array[ $i + 1 ] =~ /(Q1,Q2,Q3,Q4):\s+(.+)/) { + my @tmp = split ",", $1; + my @tmp1 = split " ", $2; + my %quat = ( + $tmp[0] => $tmp1[0], + $tmp[1] => $tmp1[1], + $tmp[2] => $tmp1[2], + $tmp[3] => $tmp1[3] + ); + $temp_manvr{Q1} = $quat{Q1}; + $temp_manvr{Q2} = $quat{Q2}; + $temp_manvr{Q3} = $quat{Q3}; + $temp_manvr{Q4} = $quat{Q4}; + } + if ($data_array[ $i + 2 ] =~ +/\s+MANVR:\sAngle=\s+(\S+)\sdeg\s+Duration=\s+(\S+)\ssec\s+Slew\serr=\s+(\S+)\sarcsec\s*/ + ) + { + $temp_manvr{'angle_deg'} = $1; + $temp_manvr{'duration_sec'} = $2; + $temp_manvr{'slew_err_arcsec'} = $3; + } + push @new_man, \%temp_manvr; } return @new_man; -# my %manvr; + # my %manvr; ## MANVR: Angle= 91.35 deg Duration= 1878 sec Slew err= 62.7 arcsec # if ($$data =~ /\s+MANVR:\sAngle=\s+(\S+)\sdeg\s+Duration=\s+(\S+)\ssec\s+Slew\serr=\s+(\S+)\sarcsec\s*\n/){ -# %manvr = ( -# 'angle_deg' => $1, -# 'duration_sec' => $2, -# 'slew_err_arcsec' => $3 -# ); -# } -# if ($$data =~ /MP_TARGQUAT\sat\s(\S+)\s\(VCDU\scount\s=\s(\d+)\)\n/){ -# $manvr{'MP_TARGQUAT'} = $1; -# } -# -# if ($$data =~ /(Q1,Q2,Q3,Q4):\s+(.+)\n/){ -# my @tmp = split ",", $1; -# my @tmp1 = split " ", $2; -# my %quat = ( -# $tmp[0] => $tmp1[0], -# $tmp[1] => $tmp1[1], -# $tmp[2] => $tmp1[2], -# $tmp[3] => $tmp1[3] -# ); -# $manvr{Q1}=$quat{Q1}; -# $manvr{Q2}=$quat{Q2}; -# $manvr{Q3}=$quat{Q3}; -# $manvr{Q4}=$quat{Q4}; -# } -# -# -# return %manvr; + # %manvr = ( + # 'angle_deg' => $1, + # 'duration_sec' => $2, + # 'slew_err_arcsec' => $3 + # ); + # } + # if ($$data =~ /MP_TARGQUAT\sat\s(\S+)\s\(VCDU\scount\s=\s(\d+)\)\n/){ + # $manvr{'MP_TARGQUAT'} = $1; + # } + # + # if ($$data =~ /(Q1,Q2,Q3,Q4):\s+(.+)\n/){ + # my @tmp = split ",", $1; + # my @tmp1 = split " ", $2; + # my %quat = ( + # $tmp[0] => $tmp1[0], + # $tmp[1] => $tmp1[1], + # $tmp[2] => $tmp1[2], + # $tmp[3] => $tmp1[3] + # ); + # $manvr{Q1}=$quat{Q1}; + # $manvr{Q2}=$quat{Q2}; + # $manvr{Q3}=$quat{Q3}; + # $manvr{Q4}=$quat{Q4}; + # } + # + # + # return %manvr; } - ##*************************************************************************** sub print { ##*************************************************************************** @@ -438,7 +459,6 @@ sub print { print $handle $$data; } - package StarcheckRecord; use strict; @@ -449,26 +469,26 @@ use Carp; 1; ##*************************************************************************** -sub new_record{ +sub new_record { ##*************************************************************************** my $classname = shift; my $obs_data = shift; my $self = {}; - bless ($self); + bless($self); $self->{obsid} = shift; - %{$self->{coords}} = $obs_data->get_coords(); - @{$self->{warnings}} = $obs_data->get_all_warnings(); - @{$self->{stars}} = $obs_data->get_stars(); - %{$self->{dither}} = $obs_data->get_dither_info(); - %{$self->{target}} = $obs_data->get_target(); - %{$self->{times}} = $obs_data->get_times(); - @{$self->{manvr}} = $obs_data->get_manvr(); + %{ $self->{coords} } = $obs_data->get_coords(); + @{ $self->{warnings} } = $obs_data->get_all_warnings(); + @{ $self->{stars} } = $obs_data->get_stars(); + %{ $self->{dither} } = $obs_data->get_dither_info(); + %{ $self->{target} } = $obs_data->get_target(); + %{ $self->{times} } = $obs_data->get_times(); + @{ $self->{manvr} } = $obs_data->get_manvr(); return $self; - + } package LoadRecord; @@ -479,7 +499,7 @@ use Carp; 1; ##*************************************************************************** -sub new_record{ +sub new_record { ##*************************************************************************** my $classname = shift; my $starcheck_data = shift; @@ -487,12 +507,13 @@ sub new_record{ my $last_ap_date = shift; my $self = {}; - bless ($self); + bless($self); $self->{mp_path} = $mp_path; $self->{last_ap_date} = $last_ap_date; -# @{$self->{lines}} = $starcheck_data->get_header_lines(); - %{$self->{lines}}= $starcheck_data->get_header_lines(); + + # @{$self->{lines}} = $starcheck_data->get_header_lines(); + %{ $self->{lines} } = $starcheck_data->get_header_lines(); return $self; diff --git a/starcheck/src/lib/PoorTextFormat.pm b/starcheck/src/lib/PoorTextFormat.pm index d69eeadf..365992bc 100644 --- a/starcheck/src/lib/PoorTextFormat.pm +++ b/starcheck/src/lib/PoorTextFormat.pm @@ -1,7 +1,7 @@ package PoorTextFormat; ##*************************************************************************** -# +# # History: # 9-May-00 Fixed bug with linked target in 'text' # Apr-00 Created (TLA) @@ -14,59 +14,60 @@ use English; $cmd{latex} = { list_preamble => '\begin{itemize}', - list_start => '\item', - list_end => '', - list_postamble=> '\end{itemize}', + list_start => '\item', + list_end => '', + list_postamble => '\end{itemize}', }; $cmd{text} = { - line_start => '', - line_end => '', - list_start => '', - list_end => '', - item_start => ' * ', - item_end => '', - fixed_start => '', - fixed_end => '', - red_start => '', - red_end => '', - green_start => '', - green_end => '', - yellow_start => '', - yellow_end => '', + line_start => '', + line_end => '', + list_start => '', + list_end => '', + item_start => ' * ', + item_end => '', + fixed_start => '', + fixed_end => '', + red_start => '', + red_end => '', + green_start => '', + green_end => '', + yellow_start => '', + yellow_end => '', link_target_middle => '', - link_target_end => '', - page_break => "====================================================================================\n", + link_target_end => '', + page_break => +"====================================================================================\n", }; $preamble{text} = ''; $postamble{text} = ''; $cmd{html} = { - line_start => '', - line_end => '', - list_start => '', - item_start => '
  • ', - item_end => '
    • ', - fixed_start => '
    ',
-    fixed_end     => '
    ', - red_start => '', - red_end => '', - blue_start => '', - blue_end => '', - green_start => '', - green_end => '', - yellow_start => '', - yellow_end => '', - image_start => '
    ', - page_break => '
    ', - target_start => '', - link_target_start => '', + red_end => '', + blue_start => '', + blue_end => '', + green_start => '', + green_end => '', + yellow_start => '', + yellow_end => '', + image_start => '
    ', + page_break => '
    ', + target_start => '    ', + link_target_start => '', - link_target_end => '', + link_target_end => '', html_start => qq{ }, html_end => qq{ }, }; @@ -80,13 +81,13 @@ $preamble{html} = <<'END_HTML_PREAMBLE' END_HTML_PREAMBLE - ; + ; $postamble{html} = <<'END_HTML_POSTAMBLE' END_HTML_POSTAMBLE - ; + ; 1; @@ -95,7 +96,7 @@ sub new { ##************************************************************************ my $classname = shift; my $self = {}; - bless ($self); + bless($self); return $self; } @@ -104,8 +105,8 @@ sub new { sub ptf2any { ##************************************************************************ $self = shift; - $fmt = shift; # Output format - @ptf = split "\n", shift; # Input ptf text to translate + $fmt = shift; # Output format + @ptf = split "\n", shift; # Input ptf text to translate return unless (exists $cmd{$fmt}); @@ -113,65 +114,75 @@ sub ptf2any { $line_end = $cmd{$fmt}->{line_end}; my $out = $preamble{$fmt}; - + foreach (@ptf) { - chomp; - if (/\\(\S+{[^}]*})/ || /\\(\S+) ?/) { # There is a PTF command - $ptf_cmd = $1; - my $postmatch = $POSTMATCH; -# print STDERR "PTF_CMD = $ptf_cmd\n"; -# print STDERR "postmatch0 = :$POSTMATCH:\n"; - $out .= $PREMATCH; - $out .= $cmd{$fmt}->{$ptf_cmd} if (exists $cmd{$fmt}->{$ptf_cmd}); - - # Command specific special processing - if ($ptf_cmd eq 'list_start') { - $line_start = $cmd{$fmt}->{item_start}; - } - if ($ptf_cmd eq 'list_start') { - $line_end = $cmd{$fmt}->{item_end}; - } - if ($ptf_cmd eq 'list_end') { - $line_start = $cmd{$fmt}->{line_start}; - } - if ($ptf_cmd eq 'list_end') { - $line_end = $cmd{$fmt}->{line_end}; - } - if ($ptf_cmd eq 'image') { - if ($cmd{$fmt}->{image_start}) { - $out .= $cmd{$fmt}->{image_start} . $POSTMATCH . $cmd{$fmt}->{image_end} . "\n"; - } - next; # Rest of line is ignored - } - if ($ptf_cmd eq 'html') { - if ($cmd{$fmt}->{html_start}) { - $out .= $cmd{$fmt}->{html_start} . $POSTMATCH . $cmd{$fmt}->{html_end} . "\n"; - } - next; - } - - if ($ptf_cmd =~ /^target\{([^}]*)\}/) { - if ($cmd{$fmt}->{target_start}) { - $out .= $cmd{$fmt}->{target_start} . $1 . $cmd{$fmt}->{target_end}; - } - } - - if ($ptf_cmd =~ /^link_target\{[^}]*\}/) { - if (exists $cmd{$fmt}->{link_target_end}) { - my ($target, $text) = ($ptf_cmd =~ /\{([^,]+),([^,]+)\}/); - $out .= $cmd{$fmt}->{link_target_start} . $target - if ($cmd{$fmt}->{link_target_start}); - $out .= $cmd{$fmt}->{link_target_middle} - . $text - . $cmd{$fmt}->{link_target_end}; - } - } - - $_ = $postmatch; - redo; # if (/\S/ || $PREMATCH); # Redo only if there is non-trivial stuff left over - } else { - $out .= "$line_start$_$line_end\n"; - } + chomp; + if (/\\(\S+{[^}]*})/ || /\\(\S+) ?/) { # There is a PTF command + $ptf_cmd = $1; + my $postmatch = $POSTMATCH; + + # print STDERR "PTF_CMD = $ptf_cmd\n"; + # print STDERR "postmatch0 = :$POSTMATCH:\n"; + $out .= $PREMATCH; + $out .= $cmd{$fmt}->{$ptf_cmd} if (exists $cmd{$fmt}->{$ptf_cmd}); + + # Command specific special processing + if ($ptf_cmd eq 'list_start') { + $line_start = $cmd{$fmt}->{item_start}; + } + if ($ptf_cmd eq 'list_start') { + $line_end = $cmd{$fmt}->{item_end}; + } + if ($ptf_cmd eq 'list_end') { + $line_start = $cmd{$fmt}->{line_start}; + } + if ($ptf_cmd eq 'list_end') { + $line_end = $cmd{$fmt}->{line_end}; + } + if ($ptf_cmd eq 'image') { + if ($cmd{$fmt}->{image_start}) { + $out .= + $cmd{$fmt}->{image_start} + . $POSTMATCH + . $cmd{$fmt}->{image_end} . "\n"; + } + next; # Rest of line is ignored + } + if ($ptf_cmd eq 'html') { + if ($cmd{$fmt}->{html_start}) { + $out .= + $cmd{$fmt}->{html_start} + . $POSTMATCH + . $cmd{$fmt}->{html_end} . "\n"; + } + next; + } + + if ($ptf_cmd =~ /^target\{([^}]*)\}/) { + if ($cmd{$fmt}->{target_start}) { + $out .= $cmd{$fmt}->{target_start} . $1 . $cmd{$fmt}->{target_end}; + } + } + + if ($ptf_cmd =~ /^link_target\{[^}]*\}/) { + if (exists $cmd{$fmt}->{link_target_end}) { + my ($target, $text) = ($ptf_cmd =~ /\{([^,]+),([^,]+)\}/); + $out .= $cmd{$fmt}->{link_target_start} . $target + if ($cmd{$fmt}->{link_target_start}); + $out .= + $cmd{$fmt}->{link_target_middle} + . $text + . $cmd{$fmt}->{link_target_end}; + } + } + + $_ = $postmatch; + redo + ; # if (/\S/ || $PREMATCH); # Redo only if there is non-trivial stuff left over + } + else { + $out .= "$line_start$_$line_end\n"; + } } $out .= $postamble{$fmt}; diff --git a/starcheck/src/lib/Ska/Parse_CM_File.pm b/starcheck/src/lib/Ska/Parse_CM_File.pm index 2d2e80db..5afe6808 100644 --- a/starcheck/src/lib/Ska/Parse_CM_File.pm +++ b/starcheck/src/lib/Ska/Parse_CM_File.pm @@ -19,8 +19,7 @@ use Carp; use Ska::Starcheck::Python qw(date2time time2date); - -my $VERSION = '$Id$'; # ' +my $VERSION = '$Id$'; # ' 1; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); @@ -30,10 +29,10 @@ require Exporter; our @ISA = qw(Exporter); our @EXPORT = qw(); our @EXPORT_OK = qw( ); -%EXPORT_TAGS = ( all => \@EXPORT_OK ); +%EXPORT_TAGS = (all => \@EXPORT_OK); ############################################################### -sub rel_date2time{ +sub rel_date2time { ############################################################### # Return seconds when suppled a "relative datetime" of the @@ -43,11 +42,11 @@ sub rel_date2time{ # 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); + return ($doy * 86400 + $hr * 3600 + $min * 60 + $sec); } ############################################################### -sub TLR_load_segments{ +sub TLR_load_segments { ############################################################### my $tlr_file = shift; @@ -56,8 +55,11 @@ sub TLR_load_segments{ my @segment_start_lines = grep /START\sOF\sNEW\sOBC\sLOAD,\sCL\d{3}:\d{4}/, @tlr; - for my $line (@segment_start_lines){ - if ( $line =~ /(\d{4}:\d{3}:\d{2}:\d{2}:\d{2}\.\d{3})\s+START\sOF\sNEW\sOBC\sLOAD,\s(CL\d{3}\:\d{4})/ ){ + for my $line (@segment_start_lines) { + if ($line =~ +/(\d{4}:\d{3}:\d{2}:\d{2}:\d{2}\.\d{3})\s+START\sOF\sNEW\sOBC\sLOAD,\s(CL\d{3}\:\d{4})/ + ) + { my $time = $1; my $seg_id = $2; push @segment_times, { date => $time, seg_id => $seg_id }; @@ -65,38 +67,38 @@ sub TLR_load_segments{ } - return @segment_times; } - - ############################################################### sub dither { - # Takes dither history file, array of backstop commands, and a kadi dynamic states "state". - # The kadi dynamic states state is fetched/intended to be the state just before the first - # backstop command. It is a reference to a hash with keys 'time', 'dither' (ENAB/DISA), - # 'dither_ampl_pitch', 'dither_ampl_yaw', 'dither_period_pitch', 'dither_period_yaw'. + +# Takes dither history file, array of backstop commands, and a kadi dynamic states "state". +# The kadi dynamic states state is fetched/intended to be the state just before the first +# backstop command. It is a reference to a hash with keys 'time', 'dither' (ENAB/DISA), + # 'dither_ampl_pitch', 'dither_ampl_yaw', 'dither_period_pitch', 'dither_period_yaw'. # # This routine: # 1) confirms that the kadi state and the dither history file match with regard to # the dither enabled/disabled status at the very start of products. - # 2) confirms that the dither history file is readable and ends before the backstop starts - # 3) builds an array of dither states using the backstop commands, starting with the fully +# 2) confirms that the dither history file is readable and ends before the backstop starts +# 3) builds an array of dither states using the backstop commands, starting with the fully # determined state of the initial kadi dynamic state. # 4) returns a string for error status and the array of dither states ############################################################### - my $dh_file = shift; # Dither history file name - my $bs_arr = shift; # Backstop array reference + my $dh_file = shift; # Dither history file name + my $bs_arr = shift; # Backstop array reference my $kadi_dither = shift; my $dither_error; my $bs; - my %dith_enab_cmd_map = ('DSDITH' => 'DISA', - 'ENDITH' => 'ENAB', - 'DITPAR' => undef); + my %dith_enab_cmd_map = ( + 'DSDITH' => 'DISA', + 'ENDITH' => 'ENAB', + 'DITPAR' => undef + ); my @dh_state; my @dh_params; @@ -112,30 +114,33 @@ sub dither { my $dh_date; my $dh_state; while (<$dith_hist_fh>) { - if (/(\d\d\d\d)(\d\d\d)\.(\d\d)(\d\d)(\d\d) \d* \s+ \| \s+ (ENDITH|DSDITH)/x) { + if (/(\d\d\d\d)(\d\d\d)\.(\d\d)(\d\d)(\d\d) \d* \s+ \| \s+ (ENDITH|DSDITH)/x) { $dh_date = "$1:$2:$3:$4:$5"; $dh_state = $6; } } - $dith_hist_fh->close(); + $dith_hist_fh->close(); + + if (not defined $dither_error) { - if (not defined $dither_error){ # If the most recent/last entry in the dither file has a timestamp newer than # the first entry in the load, update the dither_error var. - if ($dh_date ge $bs_arr->[0]->{date}){ + if ($dh_date ge $bs_arr->[0]->{date}) { $dither_error = "Dither history runs into load\n"; } # Confirm that last state matches kadi continuity ENAB/DISA. - if ($kadi_dither->{'dither'} ne $dith_enab_cmd_map{$dh_state}){ - $dither_error .= "Dither status in kadi commands does not match DITHER history\n" - . sprintf("kadi '%s' ; History '%s' \n", - $kadi_dither->{'dither'}, - $dith_enab_cmd_map{$dh_state}); + if ($kadi_dither->{'dither'} ne $dith_enab_cmd_map{$dh_state}) { + $dither_error .= + "Dither status in kadi commands does not match DITHER history\n" + . sprintf( + "kadi '%s' ; History '%s' \n", + $kadi_dither->{'dither'}, + $dith_enab_cmd_map{$dh_state} + ); } } - # Now make an array of hashes as the final output. Keep track of where the info # came from to assist in debugging ('source' key) my @dither; @@ -143,64 +148,68 @@ sub dither { my $r2a = 3600. * 180. / 3.14159265; my $pi = 3.14159265; - my $dither_enab = $kadi_dither->{'dither'}; my $dither_ampl_p = $kadi_dither->{'dither_ampl_pitch'}; my $dither_ampl_y = $kadi_dither->{'dither_ampl_yaw'}; my $dither_period_p = $kadi_dither->{'dither_period_pitch'}; my $dither_period_y = $kadi_dither->{'dither_period_yaw'}; - push @dither, { 'time' => $kadi_dither->{'time'}, - 'state' => $dither_enab, - 'source' => 'kadi', - 'ampl_p' => $dither_ampl_p, - 'ampl_y' => $dither_ampl_y, - 'period_p' => $dither_period_p, - 'period_y' => $dither_period_y}; - - + push @dither, + { + 'time' => $kadi_dither->{'time'}, + 'state' => $dither_enab, + 'source' => 'kadi', + 'ampl_p' => $dither_ampl_p, + 'ampl_y' => $dither_ampl_y, + 'period_p' => $dither_period_p, + 'period_y' => $dither_period_y + }; # Build dither states using just kadi initial state and backstop cmds foreach $bs (@{$bs_arr}) { + # Skip all commands except ones that could be dither related - if ($bs->{cmd} =~ '(COMMAND_SW|MP_DITHER)') { - my %params = %{$bs->{command}}; - if ($params{TLMSID} =~ 'AO(DSDITH|ENDITH|DITPAR)') { + if ($bs->{cmd} =~ '(COMMAND_SW|MP_DITHER)') { + my %params = %{ $bs->{command} }; + if ($params{TLMSID} =~ 'AO(DSDITH|ENDITH|DITPAR)') { my $dith_string = $1; + # The "if defined" logic for each means that the AODITPAR does not # change the dither-enabled status, and the AOENDITH, does not change # the dither parameters... $dither_enab = $dith_enab_cmd_map{$dith_string} - if defined $dith_enab_cmd_map{$dith_string}; + if defined $dith_enab_cmd_map{$dith_string}; $dither_ampl_p = $params{COEFP} * $r2a if defined $params{COEFP}; $dither_ampl_y = $params{COEFY} * $r2a if defined $params{COEFY}; $dither_period_p = 1 / ($params{RATEP} / (2 * $pi)) - if defined $params{RATEP}; + if defined $params{RATEP}; $dither_period_y = 1 / ($params{RATEY} / (2 * $pi)) - if defined $params{RATEP}; - # If disabled, reset the amplitudes to be 0. The params may be nonzero onboard + if defined $params{RATEP}; + + # If disabled, reset the amplitudes to be 0. The params may be nonzero onboard # but we're more interested in the effective amplitudes for starcheck. - push @dither, { time => $bs->{time}, - state => $dither_enab, - source => 'backstop', - ampl_p => $dither_enab eq 'DISA' ? 0 : $dither_ampl_p, - ampl_y => $dither_enab eq 'DISA' ? 0 : $dither_ampl_y, - period_p => $dither_period_p, - period_y => $dither_period_y, - tlmsid => $params{TLMSID}, - }; + push @dither, + { + time => $bs->{time}, + state => $dither_enab, + source => 'backstop', + ampl_p => $dither_enab eq 'DISA' ? 0 : $dither_ampl_p, + ampl_y => $dither_enab eq 'DISA' ? 0 : $dither_ampl_y, + period_p => $dither_period_p, + period_y => $dither_period_y, + tlmsid => $params{TLMSID}, + }; } } } return ($dither_error, \@dither); } - ############################################################### sub radmon { ############################################################### - my $h_file = shift; # Radmon history file name - my $bs_arr = shift; # Backstop array reference + my $h_file = shift; # Radmon history file name + my $bs_arr = shift; # Backstop array reference my $bs; my @bs_state; my @bs_time; @@ -209,20 +218,23 @@ sub radmon { my @h_state; my @h_time; my @h_date; - my %cmd = ('DS' => 'DISA', - 'EN' => 'ENAB'); + my %cmd = ( + 'DS' => 'DISA', + 'EN' => 'ENAB' + ); my %obs; + # First get everything from backstop foreach $bs (@{$bs_arr}) { - if ($bs->{cmd} =~ '(COMMAND_SW)') { - my %params = %{$bs->{command}}; - if ($params{TLMSID} =~ 'OORMP(DS|EN)') { - push @bs_state, $cmd{$1}; - push @bs_time, $bs->{time}; # see comment below about timing - push @bs_date, $bs->{date}; - push @bs_params, { %params }; - } - } + if ($bs->{cmd} =~ '(COMMAND_SW)') { + my %params = %{ $bs->{command} }; + if ($params{TLMSID} =~ 'OORMP(DS|EN)') { + push @bs_state, $cmd{$1}; + push @bs_time, $bs->{time}; # see comment below about timing + push @bs_date, $bs->{date}; + push @bs_params, {%params}; + } + } } # Now get everything from RADMON.txt @@ -230,84 +242,96 @@ sub radmon { # 2012222.011426269 | ENAB OORMPEN # 2012224.051225059 | DISA OORMPDS my $hist_fh = IO::File->new($h_file, "r") or croak "Can't open $h_file: $!"; + # Get the last 1000 characters. This is guaranteed to get the most recent # entries that we care about. $hist_fh->seek(-1000, 2); - while (<$hist_fh>) { - if (/(\d\d\d\d)(\d\d\d)\.(\d\d)(\d\d)(\d\d) \d* \s+ \| \s+ (DISA|ENAB) \s+ (OORMPDS|OORMPEN)/x) { - my ($yr, $doy, $hr, $min, $sec, $state) = ($1,$2,$3,$4,$5,$6); + while (<$hist_fh>) { + if ( +/(\d\d\d\d)(\d\d\d)\.(\d\d)(\d\d)(\d\d) \d* \s+ \| \s+ (DISA|ENAB) \s+ (OORMPDS|OORMPEN)/x + ) + { + my ($yr, $doy, $hr, $min, $sec, $state) = ($1, $2, $3, $4, $5, $6); my $date = "$yr:$doy:$hr:$min:$sec"; push @h_date, $date; push @h_state, $state; } } - $hist_fh->close(); - @h_time = @{date2time(\@h_date)}; + $hist_fh->close(); + @h_time = @{ date2time(\@h_date) }; my @ok = grep { $h_time[$_] < $bs_arr->[0]->{time} } (0 .. $#h_time); my @state = (@h_state[@ok], @bs_state); - my @time = (@h_time[@ok], @bs_time); - my @date = (@h_date[@ok], @bs_date); + my @time = (@h_time[@ok], @bs_time); + my @date = (@h_date[@ok], @bs_date); # if the most recent/last entry in the dither file has a timestamp newer than # the first backstop time, set the time violation flag and return undef for # @radmon my $time_violation = ($h_time[-1] >= $bs_arr->[0]->{time}); - if ($time_violation){ - return ($time_violation, undef); + if ($time_violation) { + return ($time_violation, undef); } # Now make an array of hashes as the final output. Keep track of where the info # came from to assist in debugging my $bs_start = $bs_arr->[0]->{time}; - my @radmon = map { { time => $time[$_], - date => $date[$_], - state => $state[$_], - source => $time[$_] < $bs_start ? 'history' : 'backstop'} - } (0 .. $#state); + my @radmon = map { + { + time => $time[$_], + date => $date[$_], + state => $state[$_], + source => $time[$_] < $bs_start ? 'history' : 'backstop' + } + } (0 .. $#state); return ($time_violation, \@radmon); } - ############################################################### sub fidsel { ############################################################### - my $fidsel_file = shift; # FIDSEL file name - my $bs = shift; # Reference to backstop array + my $fidsel_file = shift; # FIDSEL file name + my $bs = shift; # Reference to backstop array my $error = []; - my %time_hash = (); # Hash of time stamps of fid cmds + my %time_hash = (); # Hash of time stamps of fid cmds my @fs = (); foreach (0 .. 14) { - $fs[$_] = []; + $fs[$_] = []; } my ($actions, $times, $fid_time_violation) = get_fid_actions($fidsel_file, $bs); # Check for duplicate commanding map { $time_hash{$_}++ } @{$times}; -# foreach (sort keys %time_hash) { -# push @{$error}, "ERROR - $time_hash{$_} fid hardware commands at time $_\n" -# if ($time_hash{$_} > 1); -# } - - for (my $i = 0; $i <= $#{$times}; $i++) { - # If command contains RESET, then turn off (i.e. set tstop) any - # fid light that is on - if ($actions->[$i] =~ /RESET/) { - foreach my $fid (1 .. 14) { - foreach my $fid_interval (@{$fs[$fid]}) { - $fid_interval->{tstop} = $times->[$i] unless ($fid_interval->{tstop}); - } - } - } - # Otherwise turn fid on by adding a new entry with tstart=time - elsif ((my $fid) = ($actions->[$i] =~ /FID\s+(\d+)\s+ON/)) { - push @{$fs[$fid]}, { tstart => $times->[$i] }; - } else { - push @{$error}, "Parse_cm_file::fidsel: WARNING - Could not parse $actions->[$i]"; - } + + # foreach (sort keys %time_hash) { + # push @{$error}, "ERROR - $time_hash{$_} fid hardware commands at time $_\n" + # if ($time_hash{$_} > 1); + # } + + for (my $i = 0 ; $i <= $#{$times} ; $i++) { + + # If command contains RESET, then turn off (i.e. set tstop) any + # fid light that is on + if ($actions->[$i] =~ /RESET/) { + foreach my $fid (1 .. 14) { + foreach my $fid_interval (@{ $fs[$fid] }) { + $fid_interval->{tstop} = $times->[$i] + unless ($fid_interval->{tstop}); + } + } + } + + # Otherwise turn fid on by adding a new entry with tstart=time + elsif ((my $fid) = ($actions->[$i] =~ /FID\s+(\d+)\s+ON/)) { + push @{ $fs[$fid] }, { tstart => $times->[$i] }; + } + else { + push @{$error}, + "Parse_cm_file::fidsel: WARNING - Could not parse $actions->[$i]"; + } } return ($fid_time_violation, $error, \@fs); @@ -316,8 +340,8 @@ sub fidsel { ############################################################### sub get_fid_actions { ############################################################### - my $fs_file = shift; # Fidsel file name - my $bs_arr = shift; # Backstop array reference + my $fs_file = shift; # Fidsel file name + my $bs_arr = shift; # Backstop array reference my $bs; my @bs_action; my @bs_time; @@ -329,55 +353,56 @@ sub get_fid_actions { # First get everything from backstop foreach $bs (@{$bs_arr}) { if ($bs->{cmd} eq 'COMMAND_HW') { - my %params = %{$bs->{command}}; + my %params = %{ $bs->{command} }; if ($params{TLMSID} eq 'AFIDP') { my $msid = $params{MSID}; push @bs_action, "$msid FID $1 ON" if ($msid =~ /AFLC(\d+)/); push @bs_action, "RESET" if ($msid =~ /AFLCRSET/); - push @bs_time, $bs->{time} - 10; # see comment below about timing + push @bs_time, $bs->{time} - 10; # see comment below about timing } } } -# printf("first bs entry at %s, last entry at %s \n", $bs_time[0], $bs_time[-1]); + # printf("first bs entry at %s, last entry at %s \n", $bs_time[0], $bs_time[-1]); # Now get everything from FIDSEL # Parse lines like: # 2001211.190730558 | AFLCRSET RESET # 2001211.190731558 | AFLC02D1 FID 02 ON - if (defined $fs_file){ + if (defined $fs_file) { my $fh = IO::File->new($fs_file, "r") or croak "Can't open $fs_file: $!"; + # Last 1000 bytes of history file is sufficient $fh->seek(-1000, 2); while (<$fh>) { if (/(\d\d\d\d)(\d\d\d)\.(\d\d)(\d\d)(\d\d)\S*\s+\|\s+(AFL.+)/) { - my ($yr, $doy, $hr, $min, $sec, $action) = ($1,$2,$3,$4,$5,$6); + my ($yr, $doy, $hr, $min, $sec, $action) = ($1, $2, $3, $4, $5, $6); if ($action =~ /(RESET|FID.+ON)/) { push @fs_action, $action; push @fs_date, "$yr:$doy:$hr:$min:$sec"; } } - } + } # Convert to time, and subtract 10 seconds so that fid lights are on # slightly before end of manuever. In actual commanding, they come on about # 1-2 seconds *after*. my $times = date2time(\@fs_date); @fs_time = map { $_ - 10 } @{$times}; - $fh->close(); + $fh->close(); } -# printf("count of fid entries is %s \n", scalar(@fs_time)); -# printf("first fs entry at %s, last entry at %s \n", $fs_time[0], $fs_time[-1]); + # printf("count of fid entries is %s \n", scalar(@fs_time)); + # printf("first fs entry at %s, last entry at %s \n", $fs_time[0], $fs_time[-1]); my @ok = grep { $fs_time[$_] < $bs_arr->[0]->{time} } (0 .. $#fs_time); my @action = (@fs_action[@ok], @bs_action); - my @time = (@fs_time[@ok], @bs_time); + my @time = (@fs_time[@ok], @bs_time); my $fid_time_violation = 0; # if the fid history extends into the current load - if ($fs_time[-1] >= $bs_arr->[0]->{time}){ + if ($fs_time[-1] >= $bs_arr->[0]->{time}) { $fid_time_violation = 1; } @@ -403,32 +428,34 @@ sub man_err { my $in_man = 0; my @me = (); my @cols; - open (my $MANERR, $man_err) - or die "Couldn't open maneuver error file $man_err for reading\n"; + open(my $MANERR, $man_err) + or die "Couldn't open maneuver error file $man_err for reading\n"; while (<$MANERR>) { chomp; - last if (/total number/i); + last if (/total number/i); next unless (/\S/); next if (/#Schedule generated/); - if ($in_man) { - my @vals = split; - if ($#vals != $#cols) { - warn "man_err: ERROR - mismatch between column names and data values\n"; - return (); # return nothing - } - my %data = map { $cols[$_], $vals[$_] } (0 .. $#cols); - $data{Seg} = 1 if ($data{Seg} == 0); # Make it easier later on to match the segment number - # with the MP_TARGQUAT commands - $data{obsid} = sprintf "%d", $data{obsid}; # Clip leading zeros - - push @me, \%data; - } - if (/^\s*obsid\s+maxerryz\s+seg/i) { - @cols = split; - $in_man = 1; - } + if ($in_man) { + my @vals = split; + if ($#vals != $#cols) { + warn "man_err: ERROR - mismatch between column names and data values\n"; + return (); # return nothing + } + my %data = map { $cols[$_], $vals[$_] } (0 .. $#cols); + $data{Seg} = 1 + if ($data{Seg} == 0) + ; # Make it easier later on to match the segment number + # with the MP_TARGQUAT commands + $data{obsid} = sprintf "%d", $data{obsid}; # Clip leading zeros + + push @me, \%data; + } + if (/^\s*obsid\s+maxerryz\s+seg/i) { + @cols = split; + $in_man = 1; + } } - close $MANERR; + close $MANERR; return @me; } @@ -439,30 +466,32 @@ sub backstop { my @bs = (); my @dates = (); - open (my $BACKSTOP, $backstop) || die "Couldn't open backstop file $backstop for reading\n"; + open(my $BACKSTOP, $backstop) + || die "Couldn't open backstop file $backstop for reading\n"; while (<$BACKSTOP>) { - my ($date, $vcdu, $cmd, $params) = split '\s*\|\s*', $_; - $vcdu =~ s/ +.*//; # Get rid of second field in vcdu - my %command = parse_params($params); - push @bs, { date => $date, - vcdu => $vcdu, - cmd => $cmd, - params => $params, - command => \%command, - }; + my ($date, $vcdu, $cmd, $params) = split '\s*\|\s*', $_; + $vcdu =~ s/ +.*//; # Get rid of second field in vcdu + my %command = parse_params($params); + push @bs, + { + date => $date, + vcdu => $vcdu, + cmd => $cmd, + params => $params, + command => \%command, + }; push @dates, $date; } close $BACKSTOP; my $times = date2time(\@dates); - for (my $i = 0; $i <= $#bs; $i++) { + for (my $i = 0 ; $i <= $#bs ; $i++) { $bs[$i]->{time} = $times->[$i]; } return @bs; } - ############################################################### sub DOT { ############################################################### @@ -476,13 +505,12 @@ sub DOT { my %linenum; my $touched_by_sausage = 0; - - open (my $DOT, $dot_file) || die "Couldn't open DOT file $dot_file\n"; - while ( <$DOT> ) { + open(my $DOT, $dot_file) || die "Couldn't open DOT file $dot_file\n"; + while (<$DOT>) { chomp; next unless (/\S/); next if (/^\!Schedule generated/); - if ( /MTLB/ or /M\d{3}$/ ){ + if (/MTLB/ or /M\d{3}$/) { $touched_by_sausage = 1; } my ($cmd, $id) = /(.+) +(\S+)....$/; @@ -490,25 +518,27 @@ sub DOT { $cmd =~ s/\s+$//; my $id_index = "$id$index{$id}"; $command{$id_index} .= $cmd; - $linenum{$id_index} = $. unless exists $linenum{$id_index}; # Perl file line number for <..> + $linenum{$id_index} = $. + unless exists $linenum{$id_index}; # Perl file line number for <..> # If there is no continuation character "," then DOT command is complete - $index{$id} = sprintf("%04d", $index{$id}+1) unless ($cmd =~ /,$/); + $index{$id} = sprintf("%04d", $index{$id} + 1) unless ($cmd =~ /,$/); } close $DOT; foreach (keys %command) { - %{$dot{$_}} = parse_params($command{$_}); - $dot{$_}{time} = date2time($dot{$_}{TIME}) if ($dot{$_}{TIME}); + %{ $dot{$_} } = parse_params($command{$_}); + $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 + # 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{$_}{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}); + if ($dot{$_}{anon_param1} and $dot{$_}{anon_param2}); $dot{$_}{linenum} = $linenum{$_}; - ($dot{$_}{oflsid}) = /^\S0*(\S+)\S{4}/; # This will always succeed + ($dot{$_}{oflsid}) = /^\S0*(\S+)\S{4}/; # This will always succeed $dot{$_}{id} = $_; $dot{$_}{command} = $command{$_}; } @@ -518,19 +548,15 @@ sub DOT { return (\%dot, $touched_by_sausage, \@ordered_dot); - } - - - ##*************************************************************************** -sub guide{ +sub guide { ##*************************************************************************** -# Take in name of guide star summary file -# return hash that contains -# target obsid, target dec, target ra, target roll -# and an array of the lines of the catalog info + # Take in name of guide star summary file + # return hash that contains + # target obsid, target dec, target ra, target roll + # and an array of the lines of the catalog info my $guide_file = shift; @@ -542,72 +568,74 @@ sub guide{ # And then, let's split that file into chunks by processing request # By chunking I can guarantee that an error parsing the ID doesn't cause the # script to blindly overwrite the RA and DEC and keep adding to the starcat.. - my @file_chunk = split /\n\n\n\*\*\*\* PROCESSING REQUEST \*\*\*\*\n/, $whole_guide_file; + my @file_chunk = split /\n\n\n\*\*\*\* PROCESSING REQUEST \*\*\*\*\n/, + $whole_guide_file; # Skip the first block in the file (which has no catalog) by using the index 1-end - for my $chunk_number (1 .. $#file_chunk){ - - # Then, for each chunk, split into a line array - my @file_chunk_lines = split /\n/, $file_chunk[$chunk_number]; - - # Now, since my loop is chunk by chunk, I can clear these for every chunk. - my ($ra, $dec, $roll); - my ($oflsid, $gsumid); - - foreach my $line (@file_chunk_lines){ - - # Look for an obsid, ra, dec, or roll - if ($line =~ /\s+ID:\s+([[:ascii:]]{5})\s+\((\S{3,5})\)/) { - my @field = ($1, $2); - ($oflsid = $field[0]) =~ s/^0*//; - ($gsumid = $field[1]) =~ s/^0*//; - $guidesumm{$oflsid}{guide_summ_obsid}= $gsumid; - } - if ($line =~ /\s+ID:\s+([[:ascii:]]{7})\s*$/) { - ($oflsid = $1) =~ s/^0*//; - $oflsid =~ s/00$//; - } - - # Skip the rest of the block for each line if - # oflsid hasn't been found/defined - - next unless (defined $oflsid); - - if ($line =~ /\s+RA:\s*([^ ]+) DEG/){ - $ra = $1; - $guidesumm{$oflsid}{ra}=$ra; - } - if ($line =~ /\s+DEC:\s*([^ ]+) DEG/){ - $dec = $1; - $guidesumm{$oflsid}{dec}=$dec; - } - if ($line =~ /ROLL \(DEG\):\s*([^ ]+)/){ - $roll = $1; - $guidesumm{$oflsid}{roll}=$roll; - } - - if ($line =~ /^(FID|ACQ|GUI|BOT)/) { - push @{$guidesumm{$oflsid}{info}}, $line; - - } - if ($line =~ /^MON/){ - my @l= split ' ', $line; - if (scalar(@l) == 8){ - push @{$guidesumm{$oflsid}{info}}, "MON --- $l[2] $l[3] --- $l[5] $l[6] $l[7]"; - } - else{ - push @{$guidesumm{$oflsid}{info}}, "MON --- $l[2] $l[3] --- $l[5] $l[6]"; - } - } - } + for my $chunk_number (1 .. $#file_chunk) { + + # Then, for each chunk, split into a line array + my @file_chunk_lines = split /\n/, $file_chunk[$chunk_number]; + + # Now, since my loop is chunk by chunk, I can clear these for every chunk. + my ($ra, $dec, $roll); + my ($oflsid, $gsumid); + + foreach my $line (@file_chunk_lines) { + + # Look for an obsid, ra, dec, or roll + if ($line =~ /\s+ID:\s+([[:ascii:]]{5})\s+\((\S{3,5})\)/) { + my @field = ($1, $2); + ($oflsid = $field[0]) =~ s/^0*//; + ($gsumid = $field[1]) =~ s/^0*//; + $guidesumm{$oflsid}{guide_summ_obsid} = $gsumid; + } + if ($line =~ /\s+ID:\s+([[:ascii:]]{7})\s*$/) { + ($oflsid = $1) =~ s/^0*//; + $oflsid =~ s/00$//; + } + + # Skip the rest of the block for each line if + # oflsid hasn't been found/defined + + next unless (defined $oflsid); + + if ($line =~ /\s+RA:\s*([^ ]+) DEG/) { + $ra = $1; + $guidesumm{$oflsid}{ra} = $ra; + } + if ($line =~ /\s+DEC:\s*([^ ]+) DEG/) { + $dec = $1; + $guidesumm{$oflsid}{dec} = $dec; + } + if ($line =~ /ROLL \(DEG\):\s*([^ ]+)/) { + $roll = $1; + $guidesumm{$oflsid}{roll} = $roll; + } + + if ($line =~ /^(FID|ACQ|GUI|BOT)/) { + push @{ $guidesumm{$oflsid}{info} }, $line; + + } + if ($line =~ /^MON/) { + my @l = split ' ', $line; + if (scalar(@l) == 8) { + push @{ $guidesumm{$oflsid}{info} }, + "MON --- $l[2] $l[3] --- $l[5] $l[6] $l[7]"; + } + else { + push @{ $guidesumm{$oflsid}{info} }, + "MON --- $l[2] $l[3] --- $l[5] $l[6]"; + } + } + } } return %guidesumm; } - ############################################################### sub OR { ############################################################### @@ -616,21 +644,20 @@ sub OR { my %obs; my $obs; - - open (my $OR, $or_file) || die "Couldn't open OR file $or_file\n"; + open(my $OR, $or_file) || die "Couldn't open OR file $or_file\n"; my $in_obs_statement = 0; while (<$OR>) { - chomp; - if ($in_obs_statement) { - $obs .= $_; - unless (/,\s*$/) { - %obs = OR_parse_obs($obs); - $or{$obs{obsid}} = { %obs }; - $in_obs_statement = 0; - $obs = ''; - } - } - $in_obs_statement = 1 if (/^\s*OBS,\s*$/); + chomp; + if ($in_obs_statement) { + $obs .= $_; + unless (/,\s*$/) { + %obs = OR_parse_obs($obs); + $or{ $obs{obsid} } = {%obs}; + $in_obs_statement = 0; + $obs = ''; + } + } + $in_obs_statement = 1 if (/^\s*OBS,\s*$/); } close $OR; return %or; @@ -640,45 +667,56 @@ sub OR { sub OR_parse_obs { ############################################################### $_ = shift; -# print STDERR "test $_ \n"; + + # print STDERR "test $_ \n"; my @obs_columns = qw(obsid TARGET_RA TARGET_DEC TARGET_NAME - SI TARGET_OFFSET_Y TARGET_OFFSET_Z - SIM_OFFSET_X SIM_OFFSET_Z GRATING MON_RA MON_DEC SS_OBJECT); + SI TARGET_OFFSET_Y TARGET_OFFSET_Z + SIM_OFFSET_X SIM_OFFSET_Z GRATING MON_RA MON_DEC SS_OBJECT); + # Init some defaults my %obs = (); -# print STDERR "In OR_Parse_obs \n"; + + # print STDERR "In OR_Parse_obs \n"; foreach (@obs_columns) { - $obs{$_} = ''; + $obs{$_} = ''; } ($obs{TARGET_RA}, $obs{TARGET_DEC}) = (0.0, 0.0); ($obs{TARGET_OFFSET_Y}, $obs{TARGET_OFFSET_Z}) = (0.0, 0.0); ($obs{SIM_OFFSET_X}, $obs{SIM_OFFSET_Z}) = (0, 0); - $obs{obsid} = 0+$1 if (/ID=(\d+),/); + $obs{obsid} = 0 + $1 if (/ID=(\d+),/); ($obs{TARGET_RA}, $obs{TARGET_DEC}) = ($1, $2) - if (/TARGET=\(([^,]+),([^,\)]+)/); + if (/TARGET=\(([^,]+),([^,\)]+)/); ($obs{MON_RA}, $obs{MON_DEC}, $obs{HAS_MON}) = ($1, $2, 1) - if (/STAR=\(([^,]+),([^,\)]+)/); + if (/STAR=\(([^,]+),([^,\)]+)/); $obs{TARGET_NAME} = $3 - if (/TARGET=\(([^,]+),([^,]+),\s*\{([^\}]+)\}\),/); + if (/TARGET=\(([^,]+),([^,]+),\s*\{([^\}]+)\}\),/); $obs{SS_OBJECT} = $1 if (/SS_OBJECT=([^,\)]+)/); $obs{SI} = $1 if (/SI=([^,]+)/); - # print STDERR "obsSI = $obs{SI} \n"; - if (/TARGET_OFFSET=\((-?[\d\.]+),(-?[\d\.]+)\)/){ + + # print STDERR "obsSI = $obs{SI} \n"; + if (/TARGET_OFFSET=\((-?[\d\.]+),(-?[\d\.]+)\)/) { ($obs{TARGET_OFFSET_Y}, $obs{TARGET_OFFSET_Z}) = ($1, $2); } - elsif (/TARGET_OFFSET=\((-?[\d\.]+)\)/){ + elsif (/TARGET_OFFSET=\((-?[\d\.]+)\)/) { $obs{TARGET_OFFSET_Y} = $1; } - ($obs{DITHER_ON}, - $obs{DITHER_Y_AMP},$obs{DITHER_Y_FREQ}, $obs{DITHER_Y_PHASE}, - $obs{DITHER_Z_AMP},$obs{DITHER_Z_FREQ}, $obs{DITHER_Z_PHASE}) = split ',', $1 - if (/DITHER=\(([^)]+)\)/); + ( + $obs{DITHER_ON}, + $obs{DITHER_Y_AMP}, + $obs{DITHER_Y_FREQ}, + $obs{DITHER_Y_PHASE}, + $obs{DITHER_Z_AMP}, + $obs{DITHER_Z_FREQ}, + $obs{DITHER_Z_PHASE} + ) + = split ',', $1 + if (/DITHER=\(([^)]+)\)/); $obs{SIM_OFFSET_Z} = $1 - if (/SIM_OFFSET=\(([^,\)]+)/); + if (/SIM_OFFSET=\(([^,\)]+)/); $obs{SIM_OFFSET_X} = $2 - if (/SIM_OFFSET=\(([^,\)]+),([^,]+)\)/); + if (/SIM_OFFSET=\(([^,\)]+),([^,]+)\)/); $obs{GRATING} = $1 if (/GRATING=([^,]+)/); return %obs; @@ -686,10 +724,11 @@ sub OR_parse_obs { ############################################################### sub PS { -# Parse processing summary -# Actually, just read in the juicy lines in the middle -# which are maneuvers or observations and store them -# to a line array + + # Parse processing summary + # Actually, just read in the juicy lines in the middle + # which are maneuvers or observations and store them + # to a line array ############################################################### my $ps_file = shift; my @ps; @@ -699,8 +738,8 @@ sub PS { my $date_re = '\d{4}:\d{3}:\d{2}:\d{2}:\d{2}\.\d{3}'; my $rel_date_re = '\d{3}:\d{2}:\d{2}:\d{2}\.\d{3}'; - for my $ps_line (@ps_all_lines){ - if ($ps_line =~ /.*${date_re}\s+${date_re}\s+${rel_date_re}.*/){ + for my $ps_line (@ps_all_lines) { + if ($ps_line =~ /.*${date_re}\s+${date_re}\s+${rel_date_re}.*/) { my @tmp = split ' ', $ps_line; if ($tmp[1] eq 'MANVR') { push @ps, $ps_line; @@ -716,61 +755,67 @@ sub PS { return @ps; } - - ############################################################### sub MM { -# Parse maneuver management (?) file -############################################################### -# This accepts a reference to a hash as the only argument -# the return type may be specified in the hash as 'hash' or 'array' -# default return is hash -# With regard to the return data: + # Parse maneuver management (?) file +############################################################### + # This accepts a reference to a hash as the only argument + # the return type may be specified in the hash as 'hash' or 'array' + # default return is hash + # With regard to the return data: my $arg_ref = shift; my $mm_file = $arg_ref->{file}; my $ret_type = 'hash'; - if ( defined $arg_ref->{ret_type} ){ + if (defined $arg_ref->{ret_type}) { $ret_type = $arg_ref->{ret_type}; } - my $manvr_offset = 10; # seconds expected from AONMMODE to AOMANUVR + my $manvr_offset = 10; # seconds expected from AONMMODE to AOMANUVR my @mm_array; my $mm_text = io($mm_file)->slurp; + # split the file into maneuvers my @sections = split(/MANEUVER\sDATA\sSUMMARY\n/, $mm_text); + # ignore pieces of the file without ATTITUDES - my @good_sect = grep {/INITIAL|FINAL/} @sections; + my @good_sect = grep { /INITIAL|FINAL/ } @sections; my $int_obsid = 'IN_IA'; - for my $entry (@good_sect){ + for my $entry (@good_sect) { + # only keep the relevant bits of each entry (before OUTPUT DATA) - my @para = split( /\n\n/, $entry); - my @attitudes = grep {/ATTITUDE/} @para; - if (scalar(@attitudes) > 2){ + my @para = split(/\n\n/, $entry); + my @attitudes = grep { /ATTITUDE/ } @para; + if (scalar(@attitudes) > 2) { croak("Maneuver Summary has too many attitudes in section\n"); } + # where final or initial attitude may be an intermediate attitude - my @output_data_match = grep {/OUTPUT\sDATA/} @para; - my $output_data = $output_data_match[0]; + my @output_data_match = grep { /OUTPUT\sDATA/ } @para; + my $output_data = $output_data_match[0]; my $initial_attitude = $attitudes[0]; my $final_attitude = $attitudes[1]; my %manvr_hash; - $manvr_hash{initial_obsid} = $1 if ($initial_attitude =~ /INITIAL ID:\s+(\S+)\S\S/); - $manvr_hash{final_obsid} = $1 if ($final_attitude =~ /FINAL ID:\s+(\S+)\S\S/); - $manvr_hash{start_date} = $1 if ($initial_attitude =~ /TIME\s*\(GMT\):\s+(\S+)/); - $manvr_hash{stop_date} = $1 if ($final_attitude =~ /TIME\s*\(GMT\):\s+(\S+)/); - $manvr_hash{ra} = $1 if ($final_attitude =~ /RA\s*\(deg\):\s+(\S+)/); - $manvr_hash{dec} = $1 if ($final_attitude =~ /DEC\s*\(deg\):\s+(\S+)/); - $manvr_hash{roll} = $1 if ($final_attitude =~ /ROLL\s*\(deg\):\s+(\S+)/); - $manvr_hash{dur} = $1 if ($output_data =~ /Duration\s*\(sec\):\s+(\S+)/); - $manvr_hash{angle} = $1 if ($output_data =~ /Maneuver Angle\s*\(deg\):\s+(\S+)/); - my @quat = ($1,$2,$3,$4) if ($final_attitude =~ /Quaternion:\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)/); + $manvr_hash{initial_obsid} = $1 + if ($initial_attitude =~ /INITIAL ID:\s+(\S+)\S\S/); + $manvr_hash{final_obsid} = $1 if ($final_attitude =~ /FINAL ID:\s+(\S+)\S\S/); + $manvr_hash{start_date} = $1 + if ($initial_attitude =~ /TIME\s*\(GMT\):\s+(\S+)/); + $manvr_hash{stop_date} = $1 if ($final_attitude =~ /TIME\s*\(GMT\):\s+(\S+)/); + $manvr_hash{ra} = $1 if ($final_attitude =~ /RA\s*\(deg\):\s+(\S+)/); + $manvr_hash{dec} = $1 if ($final_attitude =~ /DEC\s*\(deg\):\s+(\S+)/); + $manvr_hash{roll} = $1 if ($final_attitude =~ /ROLL\s*\(deg\):\s+(\S+)/); + $manvr_hash{dur} = $1 if ($output_data =~ /Duration\s*\(sec\):\s+(\S+)/); + $manvr_hash{angle} = $1 + if ($output_data =~ /Maneuver Angle\s*\(deg\):\s+(\S+)/); + my @quat = ($1, $2, $3, $4) + if ($final_attitude =~ /Quaternion:\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)/); $manvr_hash{q1} = $quat[0]; $manvr_hash{q2} = $quat[1]; $manvr_hash{q3} = $quat[2]; @@ -778,15 +823,16 @@ sub MM { $manvr_hash{tstart} = date2time($manvr_hash{start_date}); $manvr_hash{tstop} = date2time($manvr_hash{stop_date}); - # let's just add those 10 seconds to the summary tstart so it lines up with - # AOMANUVR in backstop - $manvr_hash{tstart} += $manvr_offset; - $manvr_hash{start_date} = time2date($manvr_hash{tstart}); + # let's just add those 10 seconds to the summary tstart so it lines up with + # AOMANUVR in backstop + $manvr_hash{tstart} += $manvr_offset; + $manvr_hash{start_date} = time2date($manvr_hash{tstart}); # clean up obsids (remove prepended 0s) if (defined $manvr_hash{initial_obsid}) { $manvr_hash{initial_obsid} =~ s/^0+//; } + # use a dummy or the last initial attitude if there isn't one else { $manvr_hash{initial_obsid} = $int_obsid; @@ -795,47 +841,48 @@ sub MM { if (defined $manvr_hash{final_obsid}) { $manvr_hash{final_obsid} =~ s/^0+//; } - else{ + else { $int_obsid = $manvr_hash{initial_obsid} . '_IA'; $manvr_hash{final_obsid} = $int_obsid; } - $manvr_hash{obsid} = $manvr_hash{final_obsid}; + $manvr_hash{obsid} = $manvr_hash{final_obsid}; push @mm_array, \%manvr_hash; } # create a manvr_dest key to record the eventual destination of # all manvrs. - for my $i (0 .. $#mm_array){ - # by default the destination is just the final_obsid - $mm_array[$i]->{manvr_dest} = $mm_array[$i]->{final_obsid}; - # but if the final_obsid has the string that indicates it is - # an intermediate attitude, loop through the rest of the manvrs - # until we hit one that isn't an intermediate attitude - next unless ($mm_array[$i]->{final_obsid} =~ /_IA/); - for my $j ($i .. $#mm_array){ - next if ($mm_array[$j]->{final_obsid} =~ /_IA/); - $mm_array[$i]->{manvr_dest} = $mm_array[$j]->{final_obsid}; - last; - } + for my $i (0 .. $#mm_array) { + + # by default the destination is just the final_obsid + $mm_array[$i]->{manvr_dest} = $mm_array[$i]->{final_obsid}; + + # but if the final_obsid has the string that indicates it is + # an intermediate attitude, loop through the rest of the manvrs + # until we hit one that isn't an intermediate attitude + next unless ($mm_array[$i]->{final_obsid} =~ /_IA/); + for my $j ($i .. $#mm_array) { + next if ($mm_array[$j]->{final_obsid} =~ /_IA/); + $mm_array[$i]->{manvr_dest} = $mm_array[$j]->{final_obsid}; + last; + } } - if ($ret_type eq 'array'){ + if ($ret_type eq 'array') { return @mm_array; } my %mm_hash; - for my $manvr (0 ... $#mm_array ){ + for my $manvr (0 ... $#mm_array) { my $obsid = $mm_array[$manvr]->{final_obsid}; - $mm_hash{$obsid} = $mm_array[$manvr]; + $mm_hash{$obsid} = $mm_array[$manvr]; } return %mm_hash; } - ##*************************************************************************** sub mechcheck { ##*************************************************************************** @@ -843,50 +890,55 @@ sub mechcheck { my @mc; my ($date, $time, $cmd, $dur, $text); my %evt; - my $SIM_FA_RATE = 90.0; # Steps per seconds 18steps/shaft + my $SIM_FA_RATE = 90.0; # Steps per seconds 18steps/shaft open my $MC, $mc_file or die "Couldn't open mech check file $mc_file\n"; while (<$MC>) { - chomp; - - # Make continuity statements have similar format - $_ = "$3 $1$2" if (/^(SIMTRANS|SIMFOCUS)( [-\d]+ at )(.+)/); - - next unless (/^(\d\d\d\d)(\d\d\d)\.(\d\d)(\d\d)(\d\d)(\d\d\d)(.+)/); - $date = "$1:$2:$3:$4:$5.$6"; - $text = $7; - %evt = (); - $evt{time} = date2time($date); - if ($text =~ /NO_MATCH_NOW_FOR_OBSID\s+(\d+)/) { - $evt{var} = "obsid"; - $evt{dur} = 0; - $evt{val} = $1; - } elsif ($text =~ /SIMTRANS ([-\d]+) at/) { - $evt{var} = "simtsc_continuity"; - $evt{dur} = 0; - $evt{val} = $1; - } elsif ($text =~ /SIMFOCUS ([-\d]+) at/) { - $evt{var} = "simfa_continuity"; - $evt{dur} = 0; - $evt{val} = $1; - } elsif ($text =~ /SIMTRANS from ([-\d]+) to ([-\d]+) Dur (\d+)/) { - $evt{var} = "simtsc"; - $evt{dur} = $3; - $evt{val} = $2; - $evt{from} = $1; - } elsif ($text =~ /SIMFOCUS from ([-\d]+) to ([-\d]+)/) { - $evt{var} = "simfa"; - $evt{dur} = ceil(abs($2 - $1) / $SIM_FA_RATE); - $evt{val} = $2; - $evt{from} = $1; - } elsif ($text =~ /NO_MATCH_NOW_FOR_GRATINGS (.+) to (.+)/) { - $evt{var} = "gratings"; - $evt{dur} = 160; - $evt{val} = $2; - $evt{from}= $1; - } - - push @mc, { %evt } if ($evt{var}); + chomp; + + # Make continuity statements have similar format + $_ = "$3 $1$2" if (/^(SIMTRANS|SIMFOCUS)( [-\d]+ at )(.+)/); + + next unless (/^(\d\d\d\d)(\d\d\d)\.(\d\d)(\d\d)(\d\d)(\d\d\d)(.+)/); + $date = "$1:$2:$3:$4:$5.$6"; + $text = $7; + %evt = (); + $evt{time} = date2time($date); + if ($text =~ /NO_MATCH_NOW_FOR_OBSID\s+(\d+)/) { + $evt{var} = "obsid"; + $evt{dur} = 0; + $evt{val} = $1; + } + elsif ($text =~ /SIMTRANS ([-\d]+) at/) { + $evt{var} = "simtsc_continuity"; + $evt{dur} = 0; + $evt{val} = $1; + } + elsif ($text =~ /SIMFOCUS ([-\d]+) at/) { + $evt{var} = "simfa_continuity"; + $evt{dur} = 0; + $evt{val} = $1; + } + elsif ($text =~ /SIMTRANS from ([-\d]+) to ([-\d]+) Dur (\d+)/) { + $evt{var} = "simtsc"; + $evt{dur} = $3; + $evt{val} = $2; + $evt{from} = $1; + } + elsif ($text =~ /SIMFOCUS from ([-\d]+) to ([-\d]+)/) { + $evt{var} = "simfa"; + $evt{dur} = ceil(abs($2 - $1) / $SIM_FA_RATE); + $evt{val} = $2; + $evt{from} = $1; + } + elsif ($text =~ /NO_MATCH_NOW_FOR_GRATINGS (.+) to (.+)/) { + $evt{var} = "gratings"; + $evt{dur} = 160; + $evt{val} = $2; + $evt{from} = $1; + } + + push @mc, {%evt} if ($evt{var}); } close $MC; @@ -896,56 +948,58 @@ sub mechcheck { ##*************************************************************************** sub SOE { ##*************************************************************************** - my $soe_file = shift; -# Taken from RAC's code /proj/sot/ska/ops/soe/soeA.pl + my $soe_file = shift; + + # Taken from RAC's code /proj/sot/ska/ops/soe/soeA.pl -# read the SOE record formats into the hashes of lists $fld and $len + # read the SOE record formats into the hashes of lists $fld and $len my (%fld, %len, $obsidx); my (%rlen, %templ); while () { - my ($rtype,$rfld,$rlen,$rdim1,$rdim2) = split; - for my $j (0 .. $rdim2-1) { - for my $i (0 .. $rdim1-1) { - my $idx = ''; - $idx .= "[$i]" if ($rdim1 > 1); - $idx .= "[$j]" if ($rdim2 > 1); - push @{ $fld{$rtype} },$rfld.$idx; - push @{ $len{$rtype} },$rlen; - } - } - $obsidx = $#{ $fld{OBS} } if ($rtype eq "OBS" and $rfld =~ /odb_obs_id/); - $rlen{$rtype} += $rlen * $rdim1 * $rdim2; - $templ{$rtype} .= "a$rlen" x ($rdim1 * $rdim2); + my ($rtype, $rfld, $rlen, $rdim1, $rdim2) = split; + for my $j (0 .. $rdim2 - 1) { + for my $i (0 .. $rdim1 - 1) { + my $idx = ''; + $idx .= "[$i]" if ($rdim1 > 1); + $idx .= "[$j]" if ($rdim2 > 1); + push @{ $fld{$rtype} }, $rfld . $idx; + push @{ $len{$rtype} }, $rlen; + } + } + $obsidx = $#{ $fld{OBS} } if ($rtype eq "OBS" and $rfld =~ /odb_obs_id/); + $rlen{$rtype} += $rlen * $rdim1 * $rdim2; + $templ{$rtype} .= "a$rlen" x ($rdim1 * $rdim2); } -# read the SOE file from STDIN into $soe + # read the SOE file from STDIN into $soe open my $SOE, $soe_file or die "Couldn't open SOE file '$soe_file'\n"; my $soe = (<$SOE>); my $l = length $soe; -# unpack the SOE file + # unpack the SOE file my %SOE; my $p = 0; while ($p < $l) { - my $typ = substr $soe,$p,3; - if (exists $rlen{$typ}) { - my $rec = substr $soe,$p,$rlen{$typ}; - my @rvals = unpack $templ{$typ},$rec; - my @rflds = @{ $fld{$typ} }; - my @rlens = @{ $len{$typ} }; - my $obsid = ($typ eq "OBS" or $typ eq "CAL")? "$rvals[$obsidx] " : ""; - $obsid =~ s/^0+//; - $obsid =~ s/\s//g; - if ($obsid) { - foreach my $i (0 .. $#rvals) { - $SOE{$obsid}{$rflds[$i]} = $rvals[$i]; - } - } - $p += $rlen{$typ}; - } else { - die "Parse_CM_File::SOE: Cannot identify record of type $typ\n "; - } + my $typ = substr $soe, $p, 3; + if (exists $rlen{$typ}) { + my $rec = substr $soe, $p, $rlen{$typ}; + my @rvals = unpack $templ{$typ}, $rec; + my @rflds = @{ $fld{$typ} }; + my @rlens = @{ $len{$typ} }; + my $obsid = ($typ eq "OBS" or $typ eq "CAL") ? "$rvals[$obsidx] " : ""; + $obsid =~ s/^0+//; + $obsid =~ s/\s//g; + if ($obsid) { + foreach my $i (0 .. $#rvals) { + $SOE{$obsid}{ $rflds[$i] } = $rvals[$i]; + } + } + $p += $rlen{$typ}; + } + else { + die "Parse_CM_File::SOE: Cannot identify record of type $typ\n "; + } } return %SOE; @@ -961,23 +1015,23 @@ sub odb { my @words; my %odb; - open (my $ODB, $odb_file) || die "Couldn't open $odb_file\n"; + open(my $ODB, $odb_file) || die "Couldn't open $odb_file\n"; while (<$ODB>) { - next if (/^C/ || /^\s*\$/); - next unless (/\S/); - chomp; - s/!.*//; - s/^\s+//; - s/\s+$//; - @words = &parse_line(",", 0, $_); - foreach (@words) { - next unless ($_); - if (/(\S+)\s*=\s*(\S+)/) { - $odb_var = $1; - $_ = $2; - } - push @{$odb{$odb_var}}, $_ if ($odb_var); - } + next if (/^C/ || /^\s*\$/); + next unless (/\S/); + chomp; + s/!.*//; + s/^\s+//; + s/\s+$//; + @words = &parse_line(",", 0, $_); + foreach (@words) { + next unless ($_); + if (/(\S+)\s*=\s*(\S+)/) { + $odb_var = $1; + $_ = $2; + } + push @{ $odb{$odb_var} }, $_ if ($odb_var); + } } close $ODB; @@ -985,10 +1039,8 @@ sub odb { return (%odb); } - - ##*************************************************************************** -sub parse_params{ +sub parse_params { ##*************************************************************************** my @fields = split '\s*,\s*', shift; @@ -996,12 +1048,13 @@ sub parse_params{ my $pindex = 1; foreach (@fields) { - if (/(.+)= ?(.+)/) { - $param{$1} = $2; - } else { - $param{"anon_param$pindex"} = $_; - $pindex++; - } + if (/(.+)= ?(.+)/) { + $param{$1} = $2; + } + else { + $param{"anon_param$pindex"} = $_; + $pindex++; + } } return %param; diff --git a/starcheck/src/lib/Ska/Starcheck/Obsid.pm b/starcheck/src/lib/Ska/Starcheck/Obsid.pm index 899cee2a..e5bb3810 100644 --- a/starcheck/src/lib/Ska/Starcheck/Obsid.pm +++ b/starcheck/src/lib/Ska/Starcheck/Obsid.pm @@ -35,20 +35,22 @@ use Carp; # Constants -my $VERSION = '$Id$'; # ' +my $VERSION = '$Id$'; # ' my $ER_MIN_OBSID = 38000; -my $ACA_MANERR_PAD = 20; # Maneuver error pad for ACA effects (arcsec) +my $ACA_MANERR_PAD = 20; # Maneuver error pad for ACA effects (arcsec) my $r2a = 3600. * 180. / 3.14159265; my $faint_plot_mag = 11.0; -my %Default_SIM_Z = ('ACIS-I' => 92905, - 'ACIS-S' => 75620, - 'HRC-I' => -50505, - 'HRC-S' => -99612); +my %Default_SIM_Z = ( + 'ACIS-I' => 92905, + 'ACIS-S' => 75620, + 'HRC-I' => -50505, + 'HRC-S' => -99612 +); my $font_stop = qq{}; my ($red_font_start, $blue_font_start, $orange_font_start, $yellow_font_start); -my $ID_DIST_LIMIT = 1.5; # 1.5 arcsec box for ID'ing a star +my $ID_DIST_LIMIT = 1.5; # 1.5 arcsec box for ID'ing a star my $agasc_start_date = '2000:001:00:00:00.000'; @@ -61,7 +63,6 @@ my %bad_id; my %config; my $db_handle; - 1; ################################################################################## @@ -69,19 +70,20 @@ sub new { ################################################################################## my $classname = shift; my $self = {}; - bless ($self); + bless($self); $self->{obsid} = shift; - $self->{date} = shift; + $self->{date} = shift; $self->{dot_obsid} = $self->{obsid}; - @{$self->{warn}} = (); - @{$self->{orange_warn}} = (); - @{$self->{yellow_warn}} = (); - @{$self->{fyi}} = (); + @{ $self->{warn} } = (); + @{ $self->{orange_warn} } = (); + @{ $self->{yellow_warn} } = (); + @{ $self->{fyi} } = (); $self->{n_guide_summ} = 0; - @{$self->{commands}} = (); - %{$self->{agasc_hash}} = (); -# @{$self->{agasc_stars}} = (); + @{ $self->{commands} } = (); + %{ $self->{agasc_hash} } = (); + + # @{$self->{agasc_stars}} = (); $self->{ccd_temp} = undef; $self->{config} = \%config; return $self; @@ -104,19 +106,17 @@ sub setcolors { $orange_font_start = $colorref->{orange}; } - - ################################################################################## sub add_command { ################################################################################## my $self = shift; - push @{$self->{commands}}, $_[0]; + push @{ $self->{commands} }, $_[0]; } - ################################################################################## sub set_config { -# Import characteristics from characteristics file + + # Import characteristics from characteristics file ################################################################################## my $config_ref = shift; %config = %{$config_ref}; @@ -128,12 +128,12 @@ sub set_config { ($config{'ccd_temp_red_limit'}, $config{'ccd_temp_yellow_limit'}) = @$vals; } - ################################################################################## sub set_odb { -# Import %odb variable into starcheck_obsid package + + # Import %odb variable into starcheck_obsid package ################################################################################## - %odb= @_; + %odb = @_; $odb{"ODB_TSC_STEPS"}[0] =~ s/D/E/; } @@ -144,17 +144,19 @@ sub set_ACA_bad_pixels { my @tmp = io($pixel_file)->slurp; my @lines = grep { /^\s+(\d|-)/ } @tmp; foreach (@lines) { - my @line = split /;|,/, $_; - foreach my $i ($line[0]..$line[1]) { - foreach my $j ($line[2]..$line[3]) { - my $pixel = {'row' => $i, - 'col' => $j}; + my @line = split /;|,/, $_; + foreach my $i ($line[0] .. $line[1]) { + foreach my $j ($line[2] .. $line[3]) { + my $pixel = { + 'row' => $i, + 'col' => $j + }; push @bad_pixels, $pixel; } - } + } } - print STDERR "Read ", ($#bad_pixels+1), " ACA bad pixels from $pixel_file\n"; + print STDERR "Read ", ($#bad_pixels + 1), " ACA bad pixels from $pixel_file\n"; } ################################################################################## @@ -162,76 +164,75 @@ sub set_bad_acqs { ################################################################################## my $rdb_file = shift; - if ( -r $rdb_file ){ - my $rdb = new RDB $rdb_file or warn "Problem Loading $rdb_file\n"; + if (-r $rdb_file) { + my $rdb = new RDB $rdb_file or warn "Problem Loading $rdb_file\n"; - my %data; - while($rdb && $rdb->read( \%data )) { - $bad_acqs{ $data{'agasc_id'} }{'n_noids'} = $data{'n_noids'}; - $bad_acqs{ $data{'agasc_id'} }{'n_obs'} = $data{'n_obs'}; - } + my %data; + while ($rdb && $rdb->read(\%data)) { + $bad_acqs{ $data{'agasc_id'} }{'n_noids'} = $data{'n_noids'}; + $bad_acqs{ $data{'agasc_id'} }{'n_obs'} = $data{'n_obs'}; + } - undef $rdb; - return 1; + undef $rdb; + return 1; } - else{ - return 0; + else { + return 0; } } - ################################################################################## sub set_bad_gui { ################################################################################## my $rdb_file = shift; - if ( -r $rdb_file ){ - my $rdb = new RDB $rdb_file or warn "Problem Loading $rdb_file\n"; + if (-r $rdb_file) { + my $rdb = new RDB $rdb_file or warn "Problem Loading $rdb_file\n"; - my %data; - while($rdb && $rdb->read( \%data )) { - $bad_gui{ $data{'agasc_id'} }{'n_nbad'} = $data{'n_nbad'}; - $bad_gui{ $data{'agasc_id'} }{'n_obs'} = $data{'n_obs'}; - } + my %data; + while ($rdb && $rdb->read(\%data)) { + $bad_gui{ $data{'agasc_id'} }{'n_nbad'} = $data{'n_nbad'}; + $bad_gui{ $data{'agasc_id'} }{'n_obs'} = $data{'n_obs'}; + } - undef $rdb; - return 1; + undef $rdb; + return 1; } - else{ - return 0; + else { + return 0; } } - ################################################################################## sub set_bad_agasc { -# Read bad AGASC ID file -# one object per line: numeric id followed by commentary. + + # Read bad AGASC ID file + # one object per line: numeric id followed by commentary. ################################################################################## my $bad_file = shift; my $BS = io($bad_file); while (my $line = $BS->getline()) { - $bad_id{$1} = 1 if ($line =~ (/^ \s* (\d+)/x)); + $bad_id{$1} = 1 if ($line =~ (/^ \s* (\d+)/x)); } - print STDERR "Read ",(scalar keys %bad_id) ," bad AGASC IDs from $bad_file\n"; + print STDERR "Read ", (scalar keys %bad_id), " bad AGASC IDs from $bad_file\n"; return 1; } - ################################################################################## sub set_obsid { -# Set self->{obsid} to the commanded (numeric) obsid value. -# Use the following (in order of preference): -# - Backstop command (this relies on the DOT to associate cmd with star catalog) -# - Guide summary which provides ofls_id and obsid for each star catalog -# - OFLS ID from the DOT (as a fail-thru to still get some output) + + # Set self->{obsid} to the commanded (numeric) obsid value. + # Use the following (in order of preference): + # - Backstop command (this relies on the DOT to associate cmd with star catalog) + # - Guide summary which provides ofls_id and obsid for each star catalog + # - OFLS ID from the DOT (as a fail-thru to still get some output) ################################################################################## my $self = shift; - my $gs = shift; # Guide summary + my $gs = shift; # Guide summary my $oflsid = $self->{dot_obsid}; my $gs_obsid; my $bs_obsid; @@ -239,22 +240,23 @@ sub set_obsid { $gs_obsid = $gs->{$oflsid}{guide_summ_obsid} if defined $gs->{$oflsid}; $bs_obsid = $mp_obsid_cmd->{ID} if $mp_obsid_cmd; $self->{obsid} = $bs_obsid || $gs_obsid || $oflsid; + if (defined $bs_obsid and defined $gs_obsid and $bs_obsid != $gs_obsid) { - push @{$self->{warn}}, sprintf("Obsid mismatch: guide summary %d != backstop %d\n", - $gs_obsid, $bs_obsid); + push @{ $self->{warn} }, + sprintf("Obsid mismatch: guide summary %d != backstop %d\n", + $gs_obsid, $bs_obsid); } } - ################################################################################## sub print_cmd_params { ################################################################################## my $self = shift; - foreach my $cmd (@{$self->{commands}}) { - print " CMD = $cmd->{cmd}\n"; - foreach my $param (keys %{$cmd}) { - print " $param = $cmd->{$param}\n"; - } + foreach my $cmd (@{ $self->{commands} }) { + print " CMD = $cmd->{cmd}\n"; + foreach my $param (keys %{$cmd}) { + print " $param = $cmd->{$param}\n"; + } } } @@ -262,23 +264,31 @@ sub print_cmd_params { sub set_files { ################################################################################## my $self = shift; - ($self->{STARCHECK}, $self->{backstop}, $self->{guide_summ}, $self->{or_file}, - $self->{mm_file}, $self->{dot_file}, $self->{tlr_file}) = @_; + ( + $self->{STARCHECK}, + $self->{backstop}, + $self->{guide_summ}, + $self->{or_file}, + $self->{mm_file}, + $self->{dot_file}, + $self->{tlr_file} + ) = @_; } ################################################################################## sub set_target { -# -# Set the ra, dec, roll attributes based on target -# quaternion parameters in the target_md -# + # + # Set the ra, dec, roll attributes based on target + # quaternion parameters in the target_md + # ################################################################################## my $self = shift; - my $manvr = find_command($self, "MP_TARGQUAT", -1); # Find LAST TARGQUAT cmd + my $manvr = find_command($self, "MP_TARGQUAT", -1); # Find LAST TARGQUAT cmd ($self->{ra}, $self->{dec}, $self->{roll}) = - $manvr ? quat2radecroll($manvr->{Q1}, $manvr->{Q2}, $manvr->{Q3}, $manvr->{Q4}) - : (undef, undef, undef); + $manvr + ? quat2radecroll($manvr->{Q1}, $manvr->{Q2}, $manvr->{Q3}, $manvr->{Q4}) + : (undef, undef, undef); $self->{ra} = defined $self->{ra} ? sprintf("%.6f", $self->{ra}) : undef; $self->{dec} = defined $self->{dec} ? sprintf("%.6f", $self->{dec}) : undef; @@ -291,36 +301,36 @@ sub radecroll { ################################################################################## my $self = shift; if (@_) { - my $target = shift; - ($self->{ra}, $self->{dec}, $self->{roll}) = - quat2radecroll($target->{Q1}, $target->{Q2}, $target->{Q3}, $target->{Q4}); + my $target = shift; + ($self->{ra}, $self->{dec}, $self->{roll}) = + quat2radecroll($target->{Q1}, $target->{Q2}, $target->{Q3}, $target->{Q4}); } return ($self->{ra}, $self->{dec}, $self->{roll}); } - ################################################################################## sub find_command { ################################################################################## my $self = shift; my $command = shift; my $number = shift || 1; - my @commands = ($number > 0) ? @{$self->{commands}} : reverse @{$self->{commands}}; + my @commands = + ($number > 0) ? @{ $self->{commands} } : reverse @{ $self->{commands} }; $number = abs($number); foreach (@commands) { - $number-- if ($_->{cmd} eq $command); - return ($_) if ($number == 0); + $number-- if ($_->{cmd} eq $command); + return ($_) if ($number == 0); } return undef; } ################################################################################## sub set_maneuver { -# -# Find the right obsid for each maneuver. Note that obsids in mm_file don't -# always match those in DOT, etc -# + # + # Find the right obsid for each maneuver. Note that obsids in mm_file don't + # always match those in DOT, etc + # ################################################################################## my $self = shift; my %mm = @_; @@ -328,69 +338,84 @@ sub set_maneuver { my $c; my $found; - while ($c = find_command($self, "MP_TARGQUAT", $n++)) { - $found = 0; - foreach my $m (values %mm) { - my $manvr_obsid = $m->{manvr_dest}; - # where manvr_dest is either the final_obsid of a maneuver or the eventual destination obsid - # of a segmented maneuver - if ( ($manvr_obsid eq $self->{dot_obsid}) - && abs($m->{q1} - $c->{Q1}) < 1e-7 - && abs($m->{q2} - $c->{Q2}) < 1e-7 - && abs($m->{q3} - $c->{Q3}) < 1e-7) { - $found = 1; - foreach (keys %{$m}) { - $c->{$_} = $m->{$_}; - } - # Set the default maneuver error (based on WS Davis data) and cap at 85 arcsec - $c->{man_err} = (exists $c->{angle}) ? 35 + $c->{angle}/2. : 85; - $c->{man_err} = 85 if ($c->{man_err} > 85); - # Now check for consistency between quaternion from MANUEVER summary - # file and the quat from backstop (MP_TARGQUAT cmd) - - # Get quat from MP_TARGQUAT (backstop) command. - # Compute 4th component (as only first 3 are uplinked) and renormalize. - # Intent is to match OBC Target Reference subfunction - my $q4_obc = sqrt(abs(1.0 - $c->{Q1}**2 - $c->{Q2}**2 - $c->{Q3}**2)); - my $norm = sqrt($c->{Q1}**2 + $c->{Q2}**2 + $c->{Q3}**2 + $q4_obc**2); - if (abs(1.0 - $norm) > 1e-6){ - push @{$self->{warn}}, sprintf("Uplink quaternion norm value $norm is too far from 1.0\n"); - } - my @c_quat_norm = ($c->{Q1} / $norm, - $c->{Q2} / $norm, - $c->{Q3} / $norm, - $q4_obc / $norm); - - # Get quat from MANEUVER summary file. This is correct to high precision - my $q_man = Quat->new($m->{ra}, $m->{dec}, $m->{roll}); - my $q_obc = Quat->new(@c_quat_norm); - my @q_man = @{$q_man->{q}}; - my $q_diff = $q_man->divide($q_obc); - - if (abs($q_diff->{ra0}*3600) > 1.0 || abs($q_diff->{dec}*3600) > 1.0 || abs($q_diff->{roll0}*3600) > 10.0) { - push @{$self->{warn}}, sprintf("Target uplink precision problem for MP_TARGQUAT at $c->{date}\n" - . " Error is yaw, pitch, roll (arcsec) = %.2f %.2f %.2f\n" - . " Use Q1,Q2,Q3,Q4 = %.12f %.12f %.12f %.12f\n", - $q_diff->{ra0}*3600, $q_diff->{dec}*3600, $q_diff->{roll0}*3600, - $q_man[0], $q_man[1], $q_man[2], $q_man[3]); - } - } - - - } - push @{$self->{yellow_warn}}, sprintf("Did not find match in MAN summary for MP_TARGQUAT at $c->{date}\n") - unless ($found); + $found = 0; + foreach my $m (values %mm) { + my $manvr_obsid = $m->{manvr_dest}; + +# where manvr_dest is either the final_obsid of a maneuver or the eventual destination obsid + # of a segmented maneuver + if ( ($manvr_obsid eq $self->{dot_obsid}) + && abs($m->{q1} - $c->{Q1}) < 1e-7 + && abs($m->{q2} - $c->{Q2}) < 1e-7 + && abs($m->{q3} - $c->{Q3}) < 1e-7) + { + $found = 1; + foreach (keys %{$m}) { + $c->{$_} = $m->{$_}; + } + + # Set the default maneuver error (based on WS Davis data) and cap at 85 arcsec + $c->{man_err} = (exists $c->{angle}) ? 35 + $c->{angle} / 2. : 85; + $c->{man_err} = 85 if ($c->{man_err} > 85); + + # Now check for consistency between quaternion from MANUEVER summary + # file and the quat from backstop (MP_TARGQUAT cmd) + + # Get quat from MP_TARGQUAT (backstop) command. + # Compute 4th component (as only first 3 are uplinked) and renormalize. + # Intent is to match OBC Target Reference subfunction + my $q4_obc = sqrt(abs(1.0 - $c->{Q1}**2 - $c->{Q2}**2 - $c->{Q3}**2)); + my $norm = sqrt($c->{Q1}**2 + $c->{Q2}**2 + $c->{Q3}**2 + $q4_obc**2); + if (abs(1.0 - $norm) > 1e-6) { + push @{ $self->{warn} }, + sprintf( + "Uplink quaternion norm value $norm is too far from 1.0\n"); + } + my @c_quat_norm = ( + $c->{Q1} / $norm, + $c->{Q2} / $norm, + $c->{Q3} / $norm, + $q4_obc / $norm + ); + + # Get quat from MANEUVER summary file. This is correct to high precision + my $q_man = Quat->new($m->{ra}, $m->{dec}, $m->{roll}); + my $q_obc = Quat->new(@c_quat_norm); + my @q_man = @{ $q_man->{q} }; + my $q_diff = $q_man->divide($q_obc); + + if ( abs($q_diff->{ra0} * 3600) > 1.0 + || abs($q_diff->{dec} * 3600) > 1.0 + || abs($q_diff->{roll0} * 3600) > 10.0) + { + push @{ $self->{warn} }, + sprintf( +"Target uplink precision problem for MP_TARGQUAT at $c->{date}\n" + . " Error is yaw, pitch, roll (arcsec) = %.2f %.2f %.2f\n" + . " Use Q1,Q2,Q3,Q4 = %.12f %.12f %.12f %.12f\n", + $q_diff->{ra0} * 3600, + $q_diff->{dec} * 3600, + $q_diff->{roll0} * 3600, + $q_man[0], $q_man[1], $q_man[2], $q_man[3] + ); + } + } + + } + push @{ $self->{yellow_warn} }, + sprintf("Did not find match in MAN summary for MP_TARGQUAT at $c->{date}\n") + unless ($found); } } ################################################################################## sub set_manerr { -# -# Set the maneuver error for each MP_TARGQUAT command within the obsid -# using the more accurate values from Bill Davis' code -# + # + # Set the maneuver error for each MP_TARGQUAT command within the obsid + # using the more accurate values from Bill Davis' code + # ################################################################################## my $self = shift; my @manerr = @_; @@ -398,32 +423,38 @@ sub set_manerr { my $c; while ($c = find_command($self, "MP_TARGQUAT", $n)) { - foreach my $me (@manerr) { - # There should be a one-to-one mapping between maneuver segments in the maneuver - # error file and those in the obsid records. First, find what *should* be the - # match. Then check quaternions to make sure - - if ($self->{obsid} eq $me->{obsid} && $n == $me->{Seg}) { - if ( abs($me->{finalQ1} - $c->{Q1}) < 1e-7 - && abs($me->{finalQ2} - $c->{Q2}) < 1e-7 - && abs($me->{finalQ3} - $c->{Q3}) < 1e-7) - { - $c->{man_err} = $me->{MaxErrYZ} + $ACA_MANERR_PAD; - $c->{man_err_data} = $me; # Save the whole record just in case - } else { - push @{$self->{yellow_warn}}, sprintf("Mismatch in target quaternion ($c->{date}) and maneuver error file\n"); - } - } - } - $n++; + foreach my $me (@manerr) { + + # There should be a one-to-one mapping between maneuver segments in the maneuver + # error file and those in the obsid records. First, find what *should* be the + # match. Then check quaternions to make sure + + if ($self->{obsid} eq $me->{obsid} && $n == $me->{Seg}) { + if ( abs($me->{finalQ1} - $c->{Q1}) < 1e-7 + && abs($me->{finalQ2} - $c->{Q2}) < 1e-7 + && abs($me->{finalQ3} - $c->{Q3}) < 1e-7) + { + $c->{man_err} = $me->{MaxErrYZ} + $ACA_MANERR_PAD; + $c->{man_err_data} = $me; # Save the whole record just in case + } + else { + push @{ $self->{yellow_warn} }, + sprintf( +"Mismatch in target quaternion ($c->{date}) and maneuver error file\n" + ); + } + } + } + $n++; } } ################################################################################## -sub set_ps_times{ -# Get the observation start and stop times from the processing summary -# Just planning to use the stop time on the last observation to check dither -# (that observation has no maneuver after it) +sub set_ps_times { + + # Get the observation start and stop times from the processing summary + # Just planning to use the stop time on the last observation to check dither + # (that observation has no maneuver after it) ################################################################################## my $self = shift; my @ps = @_; @@ -431,42 +462,42 @@ sub set_ps_times{ my $or_er_start; my $or_er_stop; - for my $ps_line (@ps){ - my @tmp = split ' ', $ps_line; - next unless scalar(@tmp) >= 4; - if ($tmp[1] eq 'OBS') { - my $length = length($obsid); - if (substr($tmp[0], 5-$length, $length) eq $obsid){ - $or_er_start = $tmp[2]; - $or_er_stop = $tmp[3]; - last; - } - } - if (($ps_line =~ /OBSID\s=\s(\d\d\d\d\d)/) && (scalar(@tmp) >= 8 )) { - if ( $obsid eq $1 ){ - $or_er_start = $tmp[2]; - $or_er_stop = $tmp[3]; - } - } - } - if (not defined $or_er_start or not defined $or_er_stop){ - push @{$self->{warn}}, "Could not find obsid $obsid in processing summary\n"; + for my $ps_line (@ps) { + my @tmp = split ' ', $ps_line; + next unless scalar(@tmp) >= 4; + if ($tmp[1] eq 'OBS') { + my $length = length($obsid); + if (substr($tmp[0], 5 - $length, $length) eq $obsid) { + $or_er_start = $tmp[2]; + $or_er_stop = $tmp[3]; + last; + } + } + if (($ps_line =~ /OBSID\s=\s(\d\d\d\d\d)/) && (scalar(@tmp) >= 8)) { + if ($obsid eq $1) { + $or_er_start = $tmp[2]; + $or_er_stop = $tmp[3]; + } + } + } + if (not defined $or_er_start or not defined $or_er_stop) { + push @{ $self->{warn} }, "Could not find obsid $obsid in processing summary\n"; $self->{or_er_start} = undef; $self->{or_er_stop} = undef; } - else{ + else { $self->{or_er_start} = date2time($or_er_start); $self->{or_er_stop} = date2time($or_er_stop); } - } ############################################################################################# -sub set_npm_times{ -# This needs to be run after the maneuvers for the *next* obsid have -# been set, so it can't run in the setup loop in starcheck.pl that -# calls set_maneuver(). +sub set_npm_times { + + # This needs to be run after the maneuvers for the *next* obsid have + # been set, so it can't run in the setup loop in starcheck.pl that + # calls set_maneuver(). ############################################################################################# my $self = shift; @@ -477,78 +508,83 @@ sub set_npm_times{ # as with dither, check for end of associated maneuver to this attitude # and finding none, set start time as obsid start my $manvr = find_command($self, "MP_TARGQUAT", -1); - if ((defined $manvr) and (defined $manvr->{tstop})){ + if ((defined $manvr) and (defined $manvr->{tstop})) { $obs_tstart = $manvr->{tstop}; } - else{ + else { $obs_tstart = date2time($self->{date}); } # set the observation stop as the beginning of the next maneuever # or, if last obsid in load, use the processing summary or/er observation # stop time - if (defined $self->{next}){ + if (defined $self->{next}) { my $next_manvr = find_command($self->{next}, "MP_TARGQUAT", -1); - if ((defined $next_manvr) & (defined $next_manvr->{tstart})){ - $obs_tstop = $next_manvr->{tstart}; + if ((defined $next_manvr) & (defined $next_manvr->{tstart})) { + $obs_tstop = $next_manvr->{tstart}; } - else{ + else { # if the next obsid doesn't have a maneuver (ACIS undercover or whatever) # just use next obsid start time my $next_cmd_obsid = find_command($self->{next}, "MP_OBSID", -1); - if ( (defined $next_cmd_obsid) and ( $self->{obsid} != $next_cmd_obsid->{ID}) ){ - push @{$self->{fyi}}, "Next obsid has no manvr; using next obs start date for checks (dither, momentum)\n"; + if ((defined $next_cmd_obsid) and ($self->{obsid} != $next_cmd_obsid->{ID})) + { + push @{ $self->{fyi} }, +"Next obsid has no manvr; using next obs start date for checks (dither, momentum)\n"; $obs_tstop = $next_cmd_obsid->{time}; $self->{no_following_manvr} = 1; } } } - else{ + else { $obs_tstop = $self->{or_er_stop}; } - if (not defined $obs_tstart or not defined $obs_tstop){ - push @{$self->{warn}}, "Could not determine obsid start and stop times for checks (dither, momentum)\n"; + if (not defined $obs_tstart or not defined $obs_tstop) { + push @{ $self->{warn} }, +"Could not determine obsid start and stop times for checks (dither, momentum)\n"; } - else{ + else { $self->{obs_tstart} = $obs_tstart; $self->{obs_tstop} = $obs_tstop; } } - - ################################################################################## sub set_fids { -# -# Find the commanded fids (if any) for this observation. -# always match those in DOT, etc -# + # + # Find the commanded fids (if any) for this observation. + # always match those in DOT, etc + # ################################################################################## my $self = shift; my $fidsel = shift; my $tstart; my $manvr; - $self->{fidsel} = []; # Init to know that fids have been set and should be checked + $self->{fidsel} = []; # Init to know that fids have been set and should be checked - # Return unless there is a maneuver command and associated tstop value (from manv summ) + # Return unless there is a maneuver command and associated tstop value (from manv summ) return unless ($manvr = find_command($self, "MP_TARGQUAT", -1)); - return unless ($tstart = $manvr->{tstop}); # "Start" of observation = end of manuever + return + unless ($tstart = $manvr->{tstop}); # "Start" of observation = end of manuever # Loop through fidsel commands for each fid light and find any intervals # where fid is on at time $tstart for my $fid (1 .. 14) { - foreach my $fid_interval (@{$fidsel->[$fid]}) { - if ($fid_interval->{tstart} <= $tstart && - (! exists $fid_interval->{tstop} || $tstart <= $fid_interval->{tstop}) ) { - push @{$self->{fidsel}}, $fid; - last; - } - } + foreach my $fid_interval (@{ $fidsel->[$fid] }) { + if ( + $fid_interval->{tstart} <= $tstart + && (!exists $fid_interval->{tstop} || $tstart <= $fid_interval->{tstop}) + ) + { + push @{ $self->{fidsel} }, $fid; + last; + } + } } } @@ -567,37 +603,43 @@ sub set_star_catalog { $self->{date} = $c->{date}; - @{$self->{fid}} = (); - @{$self->{gui}} = (); - @{$self->{acq}} = (); - @{$self->{mon}} = (); - - foreach my $i (1..16) { - $c->{"SIZE$i"} = $sizes[$c->{"IMGSZ$i"}]; - $c->{"MAG$i"} = ($c->{"MINMAG$i"} + $c->{"MAXMAG$i"})/2; - $c->{"TYPE$i"} = ($c->{"TYPE$i"} or $c->{"MINMAG$i"} != 0 or $c->{"MAXMAG$i"} != 0)? - $types[$c->{"TYPE$i"}] : 'NUL'; - push @{$self->{mon}},$i if ($c->{"TYPE$i"} eq 'MON'); - push @{$self->{fid}},$i if ($c->{"TYPE$i"} eq 'FID'); - push @{$self->{acq}},$i if ($c->{"TYPE$i"} eq 'ACQ' or $c->{"TYPE$i"} eq 'BOT'); - push @{$self->{gui}},$i if ($c->{"TYPE$i"} eq 'GUI' or $c->{"TYPE$i"} eq 'BOT'); - $c->{"YANG$i"} *= $r2a; - $c->{"ZANG$i"} *= $r2a; - $c->{"HALFW$i"} = ($c->{"TYPE$i"} ne 'NUL')? - ( 40 - 35*$c->{"RESTRK$i"} ) * $c->{"DIMDTS$i"} + 20 : 0; - $c->{"HALFW$i"} = $monhalfw[$c->{"IMGSZ$i"}] if ($c->{"TYPE$i"} eq 'MON'); - $c->{"YMAX$i"} = $c->{"YANG$i"} + $c->{"HALFW$i"}; - $c->{"YMIN$i"} = $c->{"YANG$i"} - $c->{"HALFW$i"}; - $c->{"ZMAX$i"} = $c->{"ZANG$i"} + $c->{"HALFW$i"}; - $c->{"ZMIN$i"} = $c->{"ZANG$i"} - $c->{"HALFW$i"}; + @{ $self->{fid} } = (); + @{ $self->{gui} } = (); + @{ $self->{acq} } = (); + @{ $self->{mon} } = (); + + foreach my $i (1 .. 16) { + $c->{"SIZE$i"} = $sizes[ $c->{"IMGSZ$i"} ]; + $c->{"MAG$i"} = ($c->{"MINMAG$i"} + $c->{"MAXMAG$i"}) / 2; + $c->{"TYPE$i"} = + ($c->{"TYPE$i"} or $c->{"MINMAG$i"} != 0 or $c->{"MAXMAG$i"} != 0) + ? $types[ $c->{"TYPE$i"} ] + : 'NUL'; + push @{ $self->{mon} }, $i if ($c->{"TYPE$i"} eq 'MON'); + push @{ $self->{fid} }, $i if ($c->{"TYPE$i"} eq 'FID'); + push @{ $self->{acq} }, $i + if ($c->{"TYPE$i"} eq 'ACQ' or $c->{"TYPE$i"} eq 'BOT'); + push @{ $self->{gui} }, $i + if ($c->{"TYPE$i"} eq 'GUI' or $c->{"TYPE$i"} eq 'BOT'); + $c->{"YANG$i"} *= $r2a; + $c->{"ZANG$i"} *= $r2a; + $c->{"HALFW$i"} = + ($c->{"TYPE$i"} ne 'NUL') + ? (40 - 35 * $c->{"RESTRK$i"}) * $c->{"DIMDTS$i"} + 20 + : 0; + $c->{"HALFW$i"} = $monhalfw[ $c->{"IMGSZ$i"} ] if ($c->{"TYPE$i"} eq 'MON'); + $c->{"YMAX$i"} = $c->{"YANG$i"} + $c->{"HALFW$i"}; + $c->{"YMIN$i"} = $c->{"YANG$i"} - $c->{"HALFW$i"}; + $c->{"ZMAX$i"} = $c->{"ZANG$i"} + $c->{"HALFW$i"}; + $c->{"ZMIN$i"} = $c->{"ZANG$i"} - $c->{"HALFW$i"}; $c->{"P_ACQ$i"} = '---'; - # Fudge in values for guide star summary, in case it isn't there - $c->{"GS_ID$i"} = '---'; - $c->{"GS_MAG$i"} = '---'; - $c->{"GS_YANG$i"} = 0; - $c->{"GS_ZANG$i"} = 0; - $c->{"GS_PASS$i"} = ''; + # Fudge in values for guide star summary, in case it isn't there + $c->{"GS_ID$i"} = '---'; + $c->{"GS_MAG$i"} = '---'; + $c->{"GS_YANG$i"} = 0; + $c->{"GS_ZANG$i"} = 0; + $c->{"GS_PASS$i"} = ''; } } @@ -606,26 +648,28 @@ sub check_dither { ############################################################################################# my $self = shift; - my $dthr = shift; # Ref to array of hashes containing dither states + my $dthr = shift; # Ref to array of hashes containing dither states - my $large_dith_thresh = 30; # Amplitude larger than this requires special checking/handling + my $large_dith_thresh = + 30; # Amplitude larger than this requires special checking/handling - my $obs_beg_pad = 8*60; # Check dither status at obs start + 8 minutes to allow - # for disabled dither because of mon star commanding - my $obs_end_pad = 3*60; + my $obs_beg_pad = 8 * 60; # Check dither status at obs start + 8 minutes to allow + # for disabled dither because of mon star commanding + my $obs_end_pad = 3 * 60; my $manvr; - unless (defined $dthr){ - push @{$self->{warn}}, "Dither states unavailable. Dither not checked\n"; - return; + unless (defined $dthr) { + push @{ $self->{warn} }, "Dither states unavailable. Dither not checked\n"; + return; } # set the observation start as the end of the maneuver my $obs_tstart = $self->{obs_tstart}; my $obs_tstop = $self->{obs_tstop}; - unless (defined $obs_tstart){ - push @{$self->{warn}}, "Cannot determine obs start time for dither, not checking.\n"; + unless (defined $obs_tstart) { + push @{ $self->{warn} }, + "Cannot determine obs start time for dither, not checking.\n"; return; } @@ -633,42 +677,47 @@ sub check_dither { # the start of observation (+ 8 minutes) my $guide_dither; foreach my $dither_state (reverse @{$dthr}) { - if ($obs_tstart + $obs_beg_pad >= $dither_state->{time}) { + if ($obs_tstart + $obs_beg_pad >= $dither_state->{time}) { $guide_dither = $dither_state; last; } } + # Determine dither at acquisition my $acq_dither; foreach my $dither_state (reverse @{$dthr}) { - if ($obs_tstart >= $dither_state->{time}) { + if ($obs_tstart >= $dither_state->{time}) { $acq_dither = $dither_state; last; } } - $self->{dither_acq} = $acq_dither; $self->{dither_guide} = $guide_dither; $self->{dither_guide}->{ampl_y_max} = $guide_dither->{ampl_y}; $self->{dither_guide}->{ampl_p_max} = $guide_dither->{ampl_p}; # Check for standard dither - if ($guide_dither->{state} eq 'ENAB'){ - if ((not standard_dither($guide_dither)) or not standard_dither($acq_dither)){ - push @{$self->{yellow_warn}}, "Non-standard dither\n"; + if ($guide_dither->{state} eq 'ENAB') { + if ((not standard_dither($guide_dither)) or not standard_dither($acq_dither)) { + push @{ $self->{yellow_warn} }, "Non-standard dither\n"; } - if (($guide_dither->{ampl_p} != $acq_dither->{ampl_p}) - or ($guide_dither->{ampl_y} != $acq_dither->{ampl_y})){ - push @{$self->{fyi}}, sprintf("Reviewed with ACQ dither Y=%.1f Z=%.1f \n", - $acq_dither->{ampl_y}, $acq_dither->{ampl_p}); + if ( ($guide_dither->{ampl_p} != $acq_dither->{ampl_p}) + or ($guide_dither->{ampl_y} != $acq_dither->{ampl_y})) + { + push @{ $self->{fyi} }, + sprintf("Reviewed with ACQ dither Y=%.1f Z=%.1f \n", + $acq_dither->{ampl_y}, $acq_dither->{ampl_p}); } } - # Check for large dither. If large dither present, run the large dither checks and set the obs_end_pad - if ($guide_dither->{state} eq 'ENAB'){ - if ($guide_dither->{ampl_y} > $large_dith_thresh or $guide_dither->{ampl_p} > $large_dith_thresh){ +# Check for large dither. If large dither present, run the large dither checks and set the obs_end_pad + if ($guide_dither->{state} eq 'ENAB') { + if ( $guide_dither->{ampl_y} > $large_dith_thresh + or $guide_dither->{ampl_p} > $large_dith_thresh) + { $self->large_dither_checks($guide_dither, $dthr); + # If this is a large dither, set a larger pad at the end, as we expect # standard dither parameters to be commanded at 5 minutes before end, # which is greater than the 3 minutes used in the "no dither changes @@ -679,101 +728,121 @@ sub check_dither { # Check for dither changes during the observation # ACA-003 - if (not defined $obs_tstop ){ - push @{$self->{warn}}, - "Unable to determine obs tstop; could not check for dither changes during obs\n"; + if (not defined $obs_tstop) { + push @{ $self->{warn} }, +"Unable to determine obs tstop; could not check for dither changes during obs\n"; } - else{ + else { foreach my $dither (reverse @{$dthr}) { - if ($dither->{time} < $obs_tstop){ - $self->{dither_guide}->{ampl_p_max} = max(($dither->{ampl_p}, $self->{dither_guide}->{ampl_p_max})); - $self->{dither_guide}->{ampl_y_max} = max(($dither->{ampl_y}, $self->{dither_guide}->{ampl_y_max})); + if ($dither->{time} < $obs_tstop) { + $self->{dither_guide}->{ampl_p_max} = + max(($dither->{ampl_p}, $self->{dither_guide}->{ampl_p_max})); + $self->{dither_guide}->{ampl_y_max} = + max(($dither->{ampl_y}, $self->{dither_guide}->{ampl_y_max})); } - if ($dither->{time} > ($obs_tstart + $obs_beg_pad) - && $dither->{time} <= $obs_tstop - $obs_end_pad) { - push @{$self->{warn}}, "Dither commanding at $dither->{time}. During observation.\n"; + if ( $dither->{time} > ($obs_tstart + $obs_beg_pad) + && $dither->{time} <= $obs_tstop - $obs_end_pad) + { + push @{ $self->{warn} }, + "Dither commanding at $dither->{time}. During observation.\n"; } - if ($dither->{time} < $obs_tstart){ + if ($dither->{time} < $obs_tstart) { last; } } } - if (($self->{dither_guide}->{ampl_y_max} != $self->{dither_guide}->{ampl_y}) - or ($self->{dither_guide}->{ampl_p_max} != $self->{dither_guide}->{ampl_p})){ - push @{$self->{fyi}}, sprintf("Max Y Z ampl during guide used for checking Y=%.1f Z=%.1f \n", - $self->{dither_guide}->{ampl_y_max} + 0.0, - $self->{dither_guide}->{ampl_p_max} + 0.0); + if ( ($self->{dither_guide}->{ampl_y_max} != $self->{dither_guide}->{ampl_y}) + or ($self->{dither_guide}->{ampl_p_max} != $self->{dither_guide}->{ampl_p})) + { + push @{ $self->{fyi} }, + sprintf( + "Max Y Z ampl during guide used for checking Y=%.1f Z=%.1f \n", + $self->{dither_guide}->{ampl_y_max} + 0.0, + $self->{dither_guide}->{ampl_p_max} + 0.0 + ); } - # For eng obs, don't have OR to specify dither, so stop before doing vs-OR comparisons - if ( $self->{obsid} =~ /^\d*$/){ - return if ($self->{obsid} >= $ER_MIN_OBSID); + # For eng obs, don't have OR to specify dither, so stop before doing vs-OR comparisons + if ($self->{obsid} =~ /^\d*$/) { + return if ($self->{obsid} >= $ER_MIN_OBSID); } # Get the OR value of dither and compare if available my $bs_val = $guide_dither->{state}; my $or_val; - if (defined $self->{DITHER_ON}){ + if (defined $self->{DITHER_ON}) { $or_val = ($self->{DITHER_ON} eq 'ON') ? 'ENAB' : 'DISA'; + # ACA-002 - push @{$self->{warn}}, "Dither mismatch - OR: $or_val != Backstop: $bs_val\n" - if ($or_val ne $bs_val); + push @{ $self->{warn} }, "Dither mismatch - OR: $or_val != Backstop: $bs_val\n" + if ($or_val ne $bs_val); } - else{ - push @{$self->{warn}}, - "Unable to determine dither from OR list\n"; + else { + push @{ $self->{warn} }, "Unable to determine dither from OR list\n"; } - # If dither is enabled according to the OR, check that parameters match OR vs Backstop - if ((defined $or_val) and ($or_val eq 'ENAB')){ + # If dither is enabled according to the OR, check that parameters match OR vs Backstop + if ((defined $or_val) and ($or_val eq 'ENAB')) { my $or_ampl_y = $self->{DITHER_Y_AMP} * 3600; my $or_ampl_p = $self->{DITHER_Z_AMP} * 3600; - if ((abs($or_ampl_y - $guide_dither->{ampl_y}) > 0.1 - or abs($or_ampl_p - $guide_dither->{ampl_p}) > 0.1)){ - my $warn = sprintf("Dither amp. mismatch - OR: (Y %.1f, Z %.1f) " - . "!= Backstop: (Y %.1f, Z %.1f)\n", - $or_ampl_y, $or_ampl_p, - $guide_dither->{ampl_y}, $guide_dither->{ampl_p}); - push @{$self->{warn}}, $warn; + if ( + ( + abs($or_ampl_y - $guide_dither->{ampl_y}) > 0.1 + or abs($or_ampl_p - $guide_dither->{ampl_p}) > 0.1 + ) + ) + { + my $warn = sprintf( + "Dither amp. mismatch - OR: (Y %.1f, Z %.1f) " + . "!= Backstop: (Y %.1f, Z %.1f)\n", + $or_ampl_y, $or_ampl_p, + $guide_dither->{ampl_y}, + $guide_dither->{ampl_p} + ); + push @{ $self->{warn} }, $warn; } } } - - ############################################################################################# -sub standard_dither{ +sub standard_dither { ############################################################################################# my $dthr = shift; - my %standard_dither_y = (20 => 1087.0, - 16 => 1414.2, - 8 => 1000.0); - my %standard_dither_p = (20 => 768.6, - 16 => 2000.0, - 8 => 707.1); + my %standard_dither_y = ( + 20 => 1087.0, + 16 => 1414.2, + 8 => 1000.0 + ); + my %standard_dither_p = ( + 20 => 768.6, + 16 => 2000.0, + 8 => 707.1 + ); my $ampl_p = int($dthr->{ampl_p} + 0.5); my $ampl_y = int($dthr->{ampl_y} + 0.5); + # If the rounded amplitude is not in the standard set, return 0 - if (not (grep $_ eq $ampl_p, (keys %standard_dither_p))){ + if (not(grep $_ eq $ampl_p, (keys %standard_dither_p))) { return 0; } - if (not (grep $_ eq $ampl_y, (keys %standard_dither_y))){ + if (not(grep $_ eq $ampl_y, (keys %standard_dither_y))) { return 0; } + # If the period is not standard for the standard amplitudes return 0 - if (abs($dthr->{period_p} - $standard_dither_p{$ampl_p}) > 10){ + if (abs($dthr->{period_p} - $standard_dither_p{$ampl_p}) > 10) { return 0; } - if (abs($dthr->{period_y} - $standard_dither_y{$ampl_y}) > 10){ + if (abs($dthr->{period_y} - $standard_dither_y{$ampl_y}) > 10) { return 0; } + # If those tests passed, the dither is standard return (($ampl_y == 20) & ($ampl_p == 20)) ? 'hrc' : 'acis'; } - ############################################################################################# sub large_dither_checks { ############################################################################################# @@ -783,10 +852,10 @@ sub large_dither_checks { my $self = shift; my $dither_state = shift; my $all_dither = shift; - my $time_tol = 11; # Commands must be within $time_tol of expectation + my $time_tol = 11; # Commands must be within $time_tol of expectation # Save the number of warnings when starting this method - my $n_warn = scalar(@{$self->{warn}}); + my $n_warn = scalar(@{ $self->{warn} }); my $obs_tstart = $self->{obs_tstart}; my $obs_tstop = $self->{obs_tstop}; @@ -797,65 +866,67 @@ sub large_dither_checks { # Dither is enabled (AOENDITH) 5 min after EOM # Dither parameters are commanded 5 min before end of observation # ACA-040 - # obs_tstart is defined as the tstop of the maneuver to this observation in set_npm_times +# obs_tstart is defined as the tstop of the maneuver to this observation in set_npm_times # obs_tstop is defined as the time of the maneuver away or the end of the schedule # Is the large dither command enabled 5 minutes after EOM? - if (abs($dither_state->{time} - $obs_tstart - 300) > $time_tol){ - push @{$self->{warn}}, - sprintf("Large Dither not enabled 5 min after EOM (%s)\n", - time2date($obs_tstart)); + if (abs($dither_state->{time} - $obs_tstart - 300) > $time_tol) { + push @{ $self->{warn} }, + sprintf("Large Dither not enabled 5 min after EOM (%s)\n", + time2date($obs_tstart)); } + # What's the dither state at EOM? my $obs_start_dither; foreach my $dither (reverse @{$all_dither}) { - if ($obs_tstart >= $dither->{time}) { + if ($obs_tstart >= $dither->{time}) { $obs_start_dither = $dither; last; } } my $det = (($self->{SI} eq 'HRC-S') or ($self->{SI} eq 'HRC-I')) ? 'hrc' : 'acis'; + # Is dither nominal for detector at EOM - if ($det ne standard_dither($obs_start_dither)){ - push @{$self->{warn}}, - sprintf("Dither should be detector nominal 1 min before obs start for Large Dither\n"); + if ($det ne standard_dither($obs_start_dither)) { + push @{ $self->{warn} }, + sprintf( +"Dither should be detector nominal 1 min before obs start for Large Dither\n" + ); } - # Find the dither state at the end of the observation my $obs_stop_dither; foreach my $dither (reverse @{$all_dither}) { - if ($obs_tstop >= $dither->{time}) { + if ($obs_tstop >= $dither->{time}) { $obs_stop_dither = $dither; last; } } + # Check that the dither state at the end of the observation started 5 minutes before - # the end (within time_tol) . obs_tstop appears not corrected by 10s so use 310 instead of 300 - if ((abs($obs_tstop - $obs_stop_dither->{time} - 310) > $time_tol)){ - push @{$self->{warn}}, - sprintf("Last dither state for Large Dither should start 5 minutes before obs end.\n"); +# the end (within time_tol) . obs_tstop appears not corrected by 10s so use 310 instead of 300 + if ((abs($obs_tstop - $obs_stop_dither->{time} - 310) > $time_tol)) { + push @{ $self->{warn} }, + sprintf( +"Last dither state for Large Dither should start 5 minutes before obs end.\n" + ); } + # Check that the dither state at the end of the observation is standard - if (not standard_dither($obs_stop_dither)){ - push @{$self->{warn}}, - sprintf("Dither parameters not set to standard values before obs end\n"); + if (not standard_dither($obs_stop_dither)) { + push @{ $self->{warn} }, + sprintf("Dither parameters not set to standard values before obs end\n"); } - # If the number of warnings has not changed during this routine, it passed all checks - if (scalar(@{$self->{warn}}) == $n_warn){ - push @{$self->{fyi}}, - sprintf("Observation passes 'big dither' checks\n"); + # If the number of warnings has not changed during this routine, it passed all checks + if (scalar(@{ $self->{warn} }) == $n_warn) { + push @{ $self->{fyi} }, sprintf("Observation passes 'big dither' checks\n"); } } - - - - ############################################################################################# -sub check_bright_perigee{ +sub check_bright_perigee { ############################################################################################# my $self = shift; my $radmon = shift; @@ -865,9 +936,10 @@ sub check_bright_perigee{ return if (($self->{obsid} =~ /^\d+$/ && $self->{obsid} < $ER_MIN_OBSID)); # if radmon is undefined, warn and return - if (not defined $radmon){ - push @{$self->{warn}}, "Perigee bright stars not being checked, no rad zone info available\n"; - return; + if (not defined $radmon) { + push @{ $self->{warn} }, + "Perigee bright stars not being checked, no rad zone info available\n"; + return; } # set the observation start as the end of the maneuver @@ -875,21 +947,22 @@ sub check_bright_perigee{ my $obs_tstop = $self->{obs_tstop}; # if observation stop time is undefined, warn and return - if (not defined $obs_tstop){ - push @{$self->{warn}}, "Perigee bright stars not being checked, no obs tstop available\n"; - return; + if (not defined $obs_tstop) { + push @{ $self->{warn} }, + "Perigee bright stars not being checked, no obs tstop available\n"; + return; } # is this obsid in perigee? assume no to start my $in_perigee = 0; - for my $rad (reverse @{$radmon}){ - next if ($rad->{time} > $obs_tstop); - if ($rad->{state} eq 'DISA'){ - $in_perigee = 1; - last; - } - last if ($rad->{time} < $obs_tstart); + for my $rad (reverse @{$radmon}) { + next if ($rad->{time} > $obs_tstop); + if ($rad->{state} eq 'DISA') { + $in_perigee = 1; + last; + } + last if ($rad->{time} < $obs_tstart); } # nothing to do if not in perigee @@ -899,82 +972,85 @@ sub check_bright_perigee{ return if (not defined $c); my @mags = (); - for my $i (1 .. 16){ - if ($c->{"TYPE$i"} =~ /GUI|BOT/){ + for my $i (1 .. 16) { + if ($c->{"TYPE$i"} =~ /GUI|BOT/) { my $mag = $c->{"GS_MAG$i"}; push @mags, $mag; - } + } } # Pass 1 to _guide_count as third arg to use the count_9th mode my $bright_count = sprintf("%.1f", - call_python("utils._guide_count", [\@mags, $self->{ccd_temp}, 1])); - if ($bright_count < $min_n_stars){ - push @{$self->{warn}}, "$bright_count star(s) brighter than scaled 9th mag. " - . "Perigee requires at least $min_n_stars\n"; + call_python("utils._guide_count", [ \@mags, $self->{ccd_temp}, 1 ])); + if ($bright_count < $min_n_stars) { + push @{ $self->{warn} }, "$bright_count star(s) brighter than scaled 9th mag. " + . "Perigee requires at least $min_n_stars\n"; } $self->{figure_of_merit}->{guide_count_9th} = $bright_count; } - ############################################################################################# -sub check_momentum_unload{ +sub check_momentum_unload { ############################################################################################# my $self = shift; my $backstop = shift; my $obs_tstart = $self->{obs_tstart}; my $obs_tstop = $self->{obs_tstop}; - if (not defined $obs_tstart or not defined $obs_tstop){ - push @{$self->{warn}}, "Momentum Unloads not checked.\n"; + if (not defined $obs_tstart or not defined $obs_tstop) { + push @{ $self->{warn} }, "Momentum Unloads not checked.\n"; return; } - for my $entry (@{$backstop}){ - if ((defined $entry->{command}) and (defined $entry->{command}->{TLMSID})){ - if ($entry->{command}->{TLMSID} =~ /AOMUNLGR/){ - if (($entry->{time} >= $obs_tstart) and ($entry->{time} <= $obs_tstop )){ - push @{$self->{fyi}}, "Momentum Unload (AOMUNLGR) in NPM at " . $entry->{date} . "\n"; + for my $entry (@{$backstop}) { + if ((defined $entry->{command}) and (defined $entry->{command}->{TLMSID})) { + if ($entry->{command}->{TLMSID} =~ /AOMUNLGR/) { + if (($entry->{time} >= $obs_tstart) and ($entry->{time} <= $obs_tstop)) + { + push @{ $self->{fyi} }, + "Momentum Unload (AOMUNLGR) in NPM at " . $entry->{date} . "\n"; } } } } } - ############################################################################################# sub check_sim_position { ############################################################################################# my $self = shift; - my @sim_trans = @_; # Remaining values are SIMTRANS backstop cmds + my @sim_trans = @_; # Remaining values are SIMTRANS backstop cmds my $manvr; return unless (exists $self->{SIM_OFFSET_Z}); unless ($manvr = find_command($self, "MP_TARGQUAT", -1)) { - push @{$self->{warn}}, "Missing MP_TARGQUAT cmd\n"; - return; + push @{ $self->{warn} }, "Missing MP_TARGQUAT cmd\n"; + return; } # Set the expected SIM Z position (steps) - my $sim_z = $Default_SIM_Z{$self->{SI}} + $self->{SIM_OFFSET_Z}; + my $sim_z = $Default_SIM_Z{ $self->{SI} } + $self->{SIM_OFFSET_Z}; foreach my $st (reverse @sim_trans) { - if (not defined $manvr->{tstop}){ - push @{$self->{warn}}, "Maneuver times not defined; SIM checking failed!\n"; - } - else{ - if ($manvr->{tstop} >= $st->{time}) { - my %par = Ska::Parse_CM_File::parse_params($st->{params}); - if (abs($par{POS} - $sim_z) > 4) { -# print STDERR "Yikes, SIM mismatch! \n"; -# print STDERR " self->{obsid} = $self->{obsid}\n"; -# print STDERR " sim_offset_z = $self->{SIM_OFFSET_Z} SI = $self->{SI}\n"; + if (not defined $manvr->{tstop}) { + push @{ $self->{warn} }, + "Maneuver times not defined; SIM checking failed!\n"; + } + else { + if ($manvr->{tstop} >= $st->{time}) { + my %par = Ska::Parse_CM_File::parse_params($st->{params}); + if (abs($par{POS} - $sim_z) > 4) { + + # print STDERR "Yikes, SIM mismatch! \n"; + # print STDERR " self->{obsid} = $self->{obsid}\n"; + # print STDERR " sim_offset_z = $self->{SIM_OFFSET_Z} SI = $self->{SI}\n"; # print STDERR " st->{POS} = $par{POS} sim_z = $sim_z delta = ", $par{POS}-$sim_z,"\n"; # ACA-001 - push @{$self->{warn}}, "SIM position mismatch: OR=$sim_z BACKSTOP=$par{POS}\n"; - } - last; - } - } + push @{ $self->{warn} }, + "SIM position mismatch: OR=$sim_z BACKSTOP=$par{POS}\n"; + } + last; + } + } } } @@ -986,11 +1062,9 @@ sub check_star_catalog { my $vehicle = shift; my $c; - ######################################################################## # Constants used in star catalog checks - # Rough angle / pixel scale for dither my $ang_per_pix = 5; @@ -999,33 +1073,30 @@ sub check_star_catalog { my $mon_expected_ymax = 480; my $mon_expected_zmax = 480; - my $min_y_side = 2500; # Minimum rectangle size for all acquisition stars + my $min_y_side = 2500; # Minimum rectangle size for all acquisition stars my $min_z_side = 2500; - my $col_sep_dist = 50; # Common column pixel separation - my $col_sep_mag = 4.5; # Common column mag separation (from ODB_MIN_COL_MAG_G) - + my $col_sep_dist = 50; # Common column pixel separation + my $col_sep_mag = 4.5; # Common column mag separation (from ODB_MIN_COL_MAG_G) my $fid_faint = 7.2; my $fid_bright = 6.8; - my $spoil_dist = 140; # Min separation of star from other star within $sep_mag mags - my $spoil_mag = 5.0; # Don't flag if mag diff is more than this + my $spoil_dist = 140; # Min separation of star from other star within $sep_mag mags + my $spoil_mag = 5.0; # Don't flag if mag diff is more than this - my $qb_dist = 20; # QB separation arcsec (3 pixels + 1 pixel of ambiguity) + my $qb_dist = 20; # QB separation arcsec (3 pixels + 1 pixel of ambiguity) - my $y0 = 33; # CCD QB coordinates (arcsec) - my $z0 = -27; + my $y0 = 33; # CCD QB coordinates (arcsec) + my $z0 = -27; my $is_science = ($self->{obsid} =~ /^\d+$/ && $self->{obsid} < $ER_MIN_OBSID); - my $is_er = ($self->{obsid} =~ /^\d+$/ && $self->{obsid} >= $ER_MIN_OBSID); - my $min_guide = $is_science ? 5 : 6; # Minimum number of each object type - my $min_acq = $is_science ? 4 : 5; - my $min_fid = 3; + my $is_er = ($self->{obsid} =~ /^\d+$/ && $self->{obsid} >= $ER_MIN_OBSID); + my $min_guide = $is_science ? 5 : 6; # Minimum number of each object type + my $min_acq = $is_science ? 4 : 5; + my $min_fid = 3; ######################################################################## - - my @warn = (); my @orange_warn = (); my @yellow_warn = (); @@ -1033,66 +1104,72 @@ sub check_star_catalog { my $oflsid = $self->{dot_obsid}; my $obsid = $self->{obsid}; - # Set slew error (arcsec) for this obsid, or 120 if not available + # Set slew error (arcsec) for this obsid, or 120 if not available my $slew_err; my $targquat; - if ($targquat = find_command($self, "MP_TARGQUAT", -1)){ - $slew_err = $targquat->{man_err}; + if ($targquat = find_command($self, "MP_TARGQUAT", -1)) { + $slew_err = $targquat->{man_err}; } - else{ - # if no target quaternion, warn and continue - push @{$self->{warn}}, "No target/maneuver for obsid $obsid ($oflsid). \n"; + else { + # if no target quaternion, warn and continue + push @{ $self->{warn} }, "No target/maneuver for obsid $obsid ($oflsid). \n"; } $slew_err = 120 if not defined $slew_err; # ACA-004 # if no starcat, warn and quit this subroutine unless ($c = find_command($self, "MP_STARCAT")) { - push @{$self->{warn}}, "No star catalog for obsid $obsid ($oflsid). \n"; - return; + push @{ $self->{warn} }, "No star catalog for obsid $obsid ($oflsid). \n"; + return; } my ($dither_acq_y, $dither_acq_z, $dither_guide_y, $dither_guide_z); - if (defined $self->{dither_acq}){ - $dither_acq_y = $self->{dither_acq}->{ampl_y}; + if (defined $self->{dither_acq}) { + $dither_acq_y = $self->{dither_acq}->{ampl_y}; $dither_acq_z = $self->{dither_acq}->{ampl_p}; - } else { - push @{$self->{yellow_warn}}, - "Acquisition dither could not be determined, using 20\"x20\" for checking.\n"; - $dither_acq_y = 20.0; - $dither_acq_z = 20.0; + } + else { + push @{ $self->{yellow_warn} }, + "Acquisition dither could not be determined, using 20\"x20\" for checking.\n"; + $dither_acq_y = 20.0; + $dither_acq_z = 20.0; } - if (defined $self->{dither_guide}->{ampl_y_max}){ - $dither_guide_y = $self->{dither_guide}->{ampl_y_max}; + if (defined $self->{dither_guide}->{ampl_y_max}) { + $dither_guide_y = $self->{dither_guide}->{ampl_y_max}; $dither_guide_z = $self->{dither_guide}->{ampl_p_max}; - } else { - push @{$self->{yellow_warn}}, - "Guide dither could not be determined, using 20\"x20\" for checking.\n"; - $dither_guide_y = 20.0; - $dither_guide_z = 20.0; } - + else { + push @{ $self->{yellow_warn} }, + "Guide dither could not be determined, using 20\"x20\" for checking.\n"; + $dither_guide_y = 20.0; + $dither_guide_z = 20.0; + } # Decrement minimum number of guide stars on ORs if a monitor window is commanded - $min_guide -= @{$self->{mon}} if $is_science; + $min_guide -= @{ $self->{mon} } if $is_science; print STDERR "Checking star catalog for obsid $self->{obsid}\n"; # Global checks on star/fid numbers # ACA-005 ACA-006 ACA-007 ACA-008 ACA-044 - push @warn,"Too Few Fid Lights\n" if (@{$self->{fid}} < $min_fid && $is_science); - push @warn,"Too Many Fid Lights\n" if ( (@{$self->{fid}} > 0 && $is_er) || - (@{$self->{fid}} > $min_fid && $is_science) ) ; - push @warn,"Too Few Acquisition Stars\n" if (@{$self->{acq}} < $min_acq); + push @warn, "Too Few Fid Lights\n" if (@{ $self->{fid} } < $min_fid && $is_science); + push @warn, "Too Many Fid Lights\n" + if ( (@{ $self->{fid} } > 0 && $is_er) + || (@{ $self->{fid} } > $min_fid && $is_science)); + push @warn, "Too Few Acquisition Stars\n" if (@{ $self->{acq} } < $min_acq); + # Red warn if fewer than the minimum number of guide stars - my $n_gui = @{$self->{gui}}; - push @yellow_warn,"Only $n_gui Guide Stars ($min_guide required)\n" if ($n_gui < $min_guide); - push @warn,"Too Many GUIDE + FID\n" if (@{$self->{gui}} + @{$self->{fid}} + @{$self->{mon}} > 8); - push @warn,"Too Many Acquisition Stars\n" if (@{$self->{acq}} > 8); - push @warn,"Too many MON\n" if ((@{$self->{mon}} > 1 && $is_science) || - (@{$self->{mon}} > 2 && $is_er)); + my $n_gui = @{ $self->{gui} }; + push @yellow_warn, "Only $n_gui Guide Stars ($min_guide required)\n" + if ($n_gui < $min_guide); + push @warn, "Too Many GUIDE + FID\n" + if (@{ $self->{gui} } + @{ $self->{fid} } + @{ $self->{mon} } > 8); + push @warn, "Too Many Acquisition Stars\n" if (@{ $self->{acq} } > 8); + push @warn, "Too many MON\n" + if ( (@{ $self->{mon} } > 1 && $is_science) + || (@{ $self->{mon} } > 2 && $is_er)); # Match positions of fids in star catalog with expected, and verify a one to one # correspondance between FIDSEL command and star catalog. @@ -1100,16 +1177,17 @@ sub check_star_catalog { check_fids($self, $c, \@warn) unless $vehicle; # store a list of the fid positions - my @fid_positions = map {{'y' => $c->{"YANG$_"}, 'z' => $c->{"ZANG$_"}}} @{$self->{fid}}; - + my @fid_positions = + map { { 'y' => $c->{"YANG$_"}, 'z' => $c->{"ZANG$_"} } } @{ $self->{fid} }; # Make arrays of the items that we need for the hot pixel region check my (@idxs, @yags, @zags, @mags, @types); - foreach my $i (1..16){ - if ($c->{"TYPE$i"} =~ /BOT|GUI|FID/){ + foreach my $i (1 .. 16) { + if ($c->{"TYPE$i"} =~ /BOT|GUI|FID/) { push @idxs, $i; push @yags, $c->{"YANG$i"}; push @zags, $c->{"ZANG$i"}; + # Add zero to get items that look more like float values in the arrays push @mags, ($c->{"GS_MAG$i"} eq '---') ? 13.94 : $c->{"GS_MAG$i"} + 0.0; push @types, $c->{"TYPE$i"}; @@ -1117,29 +1195,48 @@ sub check_star_catalog { } # Run the hot pixel region check on the Python side on FID|GUI|BOT - my @imposters = @{call_python( - "utils.check_hot_pix", - [\@idxs, \@yags, \@zags, \@mags, \@types, - $self->{ccd_temp}, $self->{date}, $dither_guide_y, $dither_guide_z]);}; + my @imposters = @{ + call_python( + "utils.check_hot_pix", + [ + \@idxs, + \@yags, + \@zags, + \@mags, + \@types, + $self->{ccd_temp}, + $self->{date}, + $dither_guide_y, + $dither_guide_z + ] + ); + }; # Assign warnings based on those hot pixel region checks IMPOSTER: - for my $imposter (@imposters){ + for my $imposter (@imposters) { + # If the check just fails on the Python side write out a warning and move on. - if ($imposter->{status} == 1){ - push @warn, sprintf("[%2d] Processing error when checking for hot pixels.\n", - $imposter->{idx}); + if ($imposter->{status} == 1) { + push @warn, + sprintf("[%2d] Processing error when checking for hot pixels.\n", + $imposter->{idx}); next IMPOSTER; } my $warn = sprintf( - "[%2d] Imposter mag %.1f centroid offset %.1f row, col (%4d, %4d) star (%4d, %4d)\n", - $imposter->{idx}, $imposter->{bad2_mag}, $imposter->{offset}, - $imposter->{bad2_row}, $imposter->{bad2_col}, - $imposter->{entry_row}, $imposter->{entry_col}); - if ($imposter->{offset} > 4.0){ +"[%2d] Imposter mag %.1f centroid offset %.1f row, col (%4d, %4d) star (%4d, %4d)\n", + $imposter->{idx}, + $imposter->{bad2_mag}, + $imposter->{offset}, + $imposter->{bad2_row}, + $imposter->{bad2_col}, + $imposter->{entry_row}, + $imposter->{entry_col} + ); + if ($imposter->{offset} > 4.0) { push @warn, $warn; } - elsif ($imposter->{offset} > 2.5){ + elsif ($imposter->{offset} > 2.5) { push @orange_warn, $warn; } } @@ -1147,20 +1244,21 @@ sub check_star_catalog { # Overlap spoiler check # The PEA will drop a readout window if it overlaps with another window. This was # noticed in obsid 45890 and 45884 in NOV2921A. - # For each 'tracked' type (GUI, BOT, FID, MON) confirm that it isn't within 60 arcsecs + # For each 'tracked' type (GUI, BOT, FID, MON) confirm that it isn't within 60 arcsecs # (Y and Z) of another tracked type. - foreach my $i (1..16){ - next if $c->{"TYPE$i"} =~ /NUL|ACQ/; - foreach my $j ($i+1..16){ - next if $c->{"TYPE$j"} =~ /NUL|ACQ/; - my $dy = $c->{"YANG${i}"} - $c->{"YANG${j}"}; - my $dz = $c->{"ZANG${i}"} - $c->{"ZANG${j}"}; - if ((abs($dy) < 60) & (abs($dz) < 60)){ - push @warn, - sprintf("Track overlap for idxs [$i] [$j]. Delta y,z (%.1f,%.1f) < 60.\n", - $dy, $dz); - } - } + foreach my $i (1 .. 16) { + next if $c->{"TYPE$i"} =~ /NUL|ACQ/; + foreach my $j ($i + 1 .. 16) { + next if $c->{"TYPE$j"} =~ /NUL|ACQ/; + my $dy = $c->{"YANG${i}"} - $c->{"YANG${j}"}; + my $dz = $c->{"ZANG${i}"} - $c->{"ZANG${j}"}; + if ((abs($dy) < 60) & (abs($dz) < 60)) { + push @warn, + sprintf( + "Track overlap for idxs [$i] [$j]. Delta y,z (%.1f,%.1f) < 60.\n", + $dy, $dz); + } + } } # Seed smallest maximums and largest minimums for guide star box @@ -1169,506 +1267,607 @@ sub check_star_catalog { my $max_z = -3000; my $min_z = 3000; - foreach my $i (1..16) { - (my $sid = $c->{"GS_ID$i"}) =~ s/[\s\*]//g; - my $type = $c->{"TYPE$i"}; - my $yag = $c->{"YANG$i"}; - my $zag = $c->{"ZANG$i"}; - my $mag = $c->{"GS_MAG$i"}; - my $maxmag = $c->{"MAXMAG$i"}; - my $halfw= $c->{"HALFW$i"}; - my $db_stats = $c->{"GS_USEDBEFORE${i}"}; - - # Search error for ACQ is the slew error, for fid, guide or mon it is about 4 arcsec - my $search_err = ( (defined $type) and ($type =~ /BOT|ACQ/)) ? $slew_err : 4.0; - - # Find position extrema for smallest rectangle check - if ( $type =~ /BOT|GUI/ ) { - $max_y = ($max_y > $yag ) ? $max_y : $yag; - $min_y = ($min_y < $yag ) ? $min_y : $yag; - $max_z = ($max_z > $zag ) ? $max_z : $zag; - $min_z = ($min_z < $zag ) ? $min_z : $zag; - } - next if ($type eq 'NUL'); - - # Warn if star not identified ACA-042 - if ( $type =~ /BOT|GUI|ACQ/ and not defined $c->{"GS_IDENTIFIED$i"}) { - push @warn, sprintf("[%2d] Missing Star. No AGASC star near search center \n", $i); - } - - # Warn if ASPQ1 is too large for nominal ACQ or GUI selection - if (($type =~ /BOT|ACQ|GUI/) and (defined $c->{"GS_ASPQ$i"})){ - if ((($type =~ /BOT|GUI/) and ($c->{"GS_ASPQ$i"} > 20)) or - (($type =~ /BOT|ACQ/) && ($c->{"GS_ASPQ$i"} > 40))){ - push @orange_warn, sprintf "[%2d] Centroid Perturbation Warning. %s: ASPQ1 = %2d\n", + foreach my $i (1 .. 16) { + (my $sid = $c->{"GS_ID$i"}) =~ s/[\s\*]//g; + my $type = $c->{"TYPE$i"}; + my $yag = $c->{"YANG$i"}; + my $zag = $c->{"ZANG$i"}; + my $mag = $c->{"GS_MAG$i"}; + my $maxmag = $c->{"MAXMAG$i"}; + my $halfw = $c->{"HALFW$i"}; + my $db_stats = $c->{"GS_USEDBEFORE${i}"}; + + # Search error for ACQ is the slew error, for fid, guide or mon it is about 4 arcsec + my $search_err = ((defined $type) and ($type =~ /BOT|ACQ/)) ? $slew_err : 4.0; + + # Find position extrema for smallest rectangle check + if ($type =~ /BOT|GUI/) { + $max_y = ($max_y > $yag) ? $max_y : $yag; + $min_y = ($min_y < $yag) ? $min_y : $yag; + $max_z = ($max_z > $zag) ? $max_z : $zag; + $min_z = ($min_z < $zag) ? $min_z : $zag; + } + next if ($type eq 'NUL'); + + # Warn if star not identified ACA-042 + if ($type =~ /BOT|GUI|ACQ/ and not defined $c->{"GS_IDENTIFIED$i"}) { + push @warn, + sprintf("[%2d] Missing Star. No AGASC star near search center \n", $i); + } + + # Warn if ASPQ1 is too large for nominal ACQ or GUI selection + if (($type =~ /BOT|ACQ|GUI/) and (defined $c->{"GS_ASPQ$i"})) { + if ( (($type =~ /BOT|GUI/) and ($c->{"GS_ASPQ$i"} > 20)) + or (($type =~ /BOT|ACQ/) && ($c->{"GS_ASPQ$i"} > 40))) + { + push @orange_warn, + sprintf "[%2d] Centroid Perturbation Warning. %s: ASPQ1 = %2d\n",; + } + } + + my $obs_min_cnt = 2; + my $obs_bad_frac = 0.3; + + # Bad Acquisition Star + if ($type =~ /BOT|ACQ|GUI/) { + my $n_obs = $bad_acqs{$sid}{n_obs}; + my $n_noids = $bad_acqs{$sid}{n_noids}; + if (defined $db_stats->{acq}) { + $n_obs = $db_stats->{acq}; + $n_noids = $db_stats->{acq_noid}; + } + if ($n_noids && $n_obs > $obs_min_cnt && $n_noids / $n_obs > $obs_bad_frac) + { + push @yellow_warn, + sprintf + "[%2d] Bad Acquisition Star. %s has %2d failed out of %2d attempts\n", + $i, $sid, $n_noids, $n_obs; } } - my $obs_min_cnt = 2; - my $obs_bad_frac = 0.3; - # Bad Acquisition Star - if ($type =~ /BOT|ACQ|GUI/){ - my $n_obs = $bad_acqs{$sid}{n_obs}; - my $n_noids = $bad_acqs{$sid}{n_noids}; - if (defined $db_stats->{acq}){ - $n_obs = $db_stats->{acq}; - $n_noids = $db_stats->{acq_noid}; - } - if ($n_noids && $n_obs > $obs_min_cnt && $n_noids/$n_obs > $obs_bad_frac){ - push @yellow_warn, sprintf - "[%2d] Bad Acquisition Star. %s has %2d failed out of %2d attempts\n", - $i, $sid, $n_noids, $n_obs; - } - } - - # Bad Guide Star - if ($type =~ /BOT|GUI/){ - my $n_obs = $bad_gui{$sid}{n_obs}; - my $n_nbad = $bad_gui{$sid}{n_nbad}; - if (defined $db_stats->{gui}){ - $n_obs = $db_stats->{gui}; - $n_nbad = $db_stats->{gui_bad}; - } - if ($n_nbad && $n_obs > $obs_min_cnt && $n_nbad/$n_obs > $obs_bad_frac){ - push @warn, sprintf - "[%2d] Bad Guide Star. %s has bad data %2d of %2d attempts\n", - $i, $sid, $n_nbad, $n_obs; - } - } - - # Bad AGASC ID ACA-031 - push @yellow_warn,sprintf "[%2d] Non-numeric AGASC ID. %s\n",$i,$sid if ($sid ne '---' && $sid =~ /\D/); - if (($type =~ /BOT|GUI|ACQ/) and (defined $bad_id{$sid})){ - push @warn, sprintf "[%2d] Bad AGASC ID. %s\n",$i,$sid; - } - # Set NOTES variable for marginal or bad star based on AGASC info - $c->{"GS_NOTES$i"} = ''; - my $note = ''; - my $marginal_note = ''; - if (defined $c->{"GS_CLASS$i"}) { - $c->{"GS_NOTES$i"} .= 'b' if ($c->{"GS_CLASS$i"} != 0); - # ignore precision errors in color - my $color = sprintf('%.7f', $c->{"GS_BV$i"}); - $c->{"GS_NOTES$i"} .= 'c' if ($color eq '0.7000000'); # ACA-033 + # Bad Guide Star + if ($type =~ /BOT|GUI/) { + my $n_obs = $bad_gui{$sid}{n_obs}; + my $n_nbad = $bad_gui{$sid}{n_nbad}; + if (defined $db_stats->{gui}) { + $n_obs = $db_stats->{gui}; + $n_nbad = $db_stats->{gui_bad}; + } + if ($n_nbad && $n_obs > $obs_min_cnt && $n_nbad / $n_obs > $obs_bad_frac) { + push @warn, + sprintf "[%2d] Bad Guide Star. %s has bad data %2d of %2d attempts\n", + $i, $sid, $n_nbad, $n_obs; + } + } + + # Bad AGASC ID ACA-031 + push @yellow_warn, sprintf "[%2d] Non-numeric AGASC ID. %s\n", $i, $sid + if ($sid ne '---' && $sid =~ /\D/); + if (($type =~ /BOT|GUI|ACQ/) and (defined $bad_id{$sid})) { + push @warn, sprintf "[%2d] Bad AGASC ID. %s\n", $i, $sid; + } + + # Set NOTES variable for marginal or bad star based on AGASC info + $c->{"GS_NOTES$i"} = ''; + my $note = ''; + my $marginal_note = ''; + if (defined $c->{"GS_CLASS$i"}) { + $c->{"GS_NOTES$i"} .= 'b' if ($c->{"GS_CLASS$i"} != 0); + + # ignore precision errors in color + my $color = sprintf('%.7f', $c->{"GS_BV$i"}); + $c->{"GS_NOTES$i"} .= 'c' if ($color eq '0.7000000'); # ACA-033 $c->{"GS_NOTES$i"} .= 'C' if ($color eq '1.5000000'); - $c->{"GS_NOTES$i"} .= 'm' if ($c->{"GS_MAGERR$i"} > 99); - $c->{"GS_NOTES$i"} .= 'p' if ($c->{"GS_POSERR$i"} > 399); + $c->{"GS_NOTES$i"} .= 'm' if ($c->{"GS_MAGERR$i"} > 99); + $c->{"GS_NOTES$i"} .= 'p' if ($c->{"GS_POSERR$i"} > 399); + # If 0.7 color or bad mag err or bad pos err, format a warning for the star. # Color 1.5 stars do not get a text warning and bad class stars are handled # separately a few lines lower. - if ($c->{"GS_NOTES$i"} =~ /[cmp]/){ - $note = sprintf("B-V = %.3f, Mag_Err = %.2f, Pos_Err = %.2f", - $c->{"GS_BV$i"}, ($c->{"GS_MAGERR$i"})/100, ($c->{"GS_POSERR$i"})/1000); - $marginal_note = sprintf("[%2d] Marginal star. %s\n",$i,$note); + if ($c->{"GS_NOTES$i"} =~ /[cmp]/) { + $note = sprintf( + "B-V = %.3f, Mag_Err = %.2f, Pos_Err = %.2f", + $c->{"GS_BV$i"}, + ($c->{"GS_MAGERR$i"}) / 100, + ($c->{"GS_POSERR$i"}) / 1000 + ); + $marginal_note = sprintf("[%2d] Marginal star. %s\n", $i, $note); } + # Assign orange warnings to catalog stars with B-V = 0.7 . - # Assign yellow warnings to catalog stars with other issues (example B-V = 1.5). + # Assign yellow warnings to catalog stars with other issues (example B-V = 1.5). if (($marginal_note) && ($type =~ /BOT|GUI|ACQ/)) { - if ($color eq '0.7000000'){ + if ($color eq '0.7000000') { push @orange_warn, $marginal_note; } - else{ + else { push @yellow_warn, $marginal_note; } } + # Print bad star warning on catalog stars with bad class. - if ($c->{"GS_CLASS$i"} != 0){ - if ($type =~ /BOT|GUI|ACQ/ ){ - push @warn, sprintf("[%2d] Bad star. Class = %s %s\n", $i,$c->{"GS_CLASS$i"},$note); + if ($c->{"GS_CLASS$i"} != 0) { + if ($type =~ /BOT|GUI|ACQ/) { + push @warn, + sprintf("[%2d] Bad star. Class = %s %s\n", + $i, $c->{"GS_CLASS$i"}, $note); } - elsif ($type eq 'MON'){ - push @{$self->{fyi}}, sprintf("[%2d] MON class= %s %s (do not convert to GUI)\n", $i,$c->{"GS_CLASS$i"},$note); + elsif ($type eq 'MON') { + push @{ $self->{fyi} }, + sprintf("[%2d] MON class= %s %s (do not convert to GUI)\n", + $i, $c->{"GS_CLASS$i"}, $note); } } - } + } - # Star/fid outside of CCD boundaries + # Star/fid outside of CCD boundaries # ACA-019 ACA-020 ACA-021 - my ($pixel_row, $pixel_col) = @{call_python("utils._yagzag_to_pixels", [$yag, $zag])}; + my ($pixel_row, $pixel_col) = + @{ call_python("utils._yagzag_to_pixels", [ $yag, $zag ]) }; # Set "acq phase" dither to acq dither or 20.0 if undefined my $dither_acq_y = $self->{dither_acq}->{ampl_y} or 20.0; my $dither_acq_p = $self->{dither_acq}->{ampl_p} or 20.0; # Set "dither" for FID to be pseudodither of 5.0 to give 1 pix margin - # Set "track phase" dither for BOT GUI to max guide dither over interval or 20.0 if undefined. - my $dither_track_y = ($type eq 'FID') ? 5.0 : $self->{dither_guide}->{ampl_y_max} or 20.0; - my $dither_track_p = ($type eq 'FID') ? 5.0 : $self->{dither_guide}->{ampl_p_max} or 20.0; - - my $pix_window_pad = 7; # half image size + point uncertainty + ? + 1 pixel of margin +# Set "track phase" dither for BOT GUI to max guide dither over interval or 20.0 if undefined. + my $dither_track_y = + ($type eq 'FID') ? 5.0 : $self->{dither_guide}->{ampl_y_max} + or 20.0; + my $dither_track_p = + ($type eq 'FID') ? 5.0 : $self->{dither_guide}->{ampl_p_max} + or 20.0; + + my $pix_window_pad = + 7; # half image size + point uncertainty + ? + 1 pixel of margin my $pix_row_pad = 8; my $pix_col_pad = 1; my $row_lim = 512.0 - ($pix_row_pad + $pix_window_pad); my $col_lim = 512.0 - ($pix_col_pad + $pix_window_pad); - my %track_limits = ('row' => $row_lim - $dither_track_y / $ang_per_pix, - 'col' => $col_lim - $dither_track_p / $ang_per_pix); - my %pixel = ('row' => $pixel_row, - 'col' => $pixel_col); - # Store the sign of the pixel row/col just to make it easier to print the corresponding limit - my %pixel_sign = ('row' => ($pixel_row < 0) ? -1 : 1, - 'col' => ($pixel_col < 0) ? -1 : 1); - - if ($type =~ /BOT|GUI|FID/){ - foreach my $axis ('row', 'col'){ + my %track_limits = ( + 'row' => $row_lim - $dither_track_y / $ang_per_pix, + 'col' => $col_lim - $dither_track_p / $ang_per_pix + ); + my %pixel = ( + 'row' => $pixel_row, + 'col' => $pixel_col + ); + +# Store the sign of the pixel row/col just to make it easier to print the corresponding limit + my %pixel_sign = ( + 'row' => ($pixel_row < 0) ? -1 : 1, + 'col' => ($pixel_col < 0) ? -1 : 1 + ); + + if ($type =~ /BOT|GUI|FID/) { + foreach my $axis ('row', 'col') { my $track_delta = abs($track_limits{$axis}) - abs($pixel{$axis}); - if ($track_delta < 2.5){ - push @warn, sprintf "[%2d] Less than 2.5 pix edge margin $axis lim %.1f val %.1f delta %.1f\n", - $i, $pixel_sign{$axis} * $track_limits{$axis}, $pixel{$axis}, $track_delta; + if ($track_delta < 2.5) { + push @warn, + sprintf +"[%2d] Less than 2.5 pix edge margin $axis lim %.1f val %.1f delta %.1f\n", + $i, $pixel_sign{$axis} * $track_limits{$axis}, $pixel{$axis}, + $track_delta; } - elsif ($track_delta < 5){ - push @orange_warn, sprintf "[%2d] Within 5 pix of CCD $axis lim %.1f val %.1f delta %.1f\n", - $i, $pixel_sign{$axis} * $track_limits{$axis}, $pixel{$axis}, $track_delta; + elsif ($track_delta < 5) { + push @orange_warn, + sprintf + "[%2d] Within 5 pix of CCD $axis lim %.1f val %.1f delta %.1f\n", + $i, $pixel_sign{$axis} * $track_limits{$axis}, $pixel{$axis}, + $track_delta; } } } + # For acq stars, the distance to the row/col padded limits are also confirmed, # but code to track which boundary is exceeded (row or column) is not present. - # Note from above that the pix_row_pad used for row_lim has 7 more pixels of padding + # Note from above that the pix_row_pad used for row_lim has 7 more pixels of padding # than the pix_col_pad used to determine col_lim. - my $acq_edge_delta = min(($row_lim - $dither_acq_y / $ang_per_pix) - abs($pixel_row), - ($col_lim - $dither_acq_p / $ang_per_pix) - abs($pixel_col)); - if (($type =~ /BOT|ACQ/) and ($acq_edge_delta < (-1 * 12))){ - push @orange_warn, sprintf "[%2d] Acq Off (padded) CCD by > 60 arcsec.\n",$i; + my $acq_edge_delta = min( + ($row_lim - $dither_acq_y / $ang_per_pix) - abs($pixel_row), + ($col_lim - $dither_acq_p / $ang_per_pix) - abs($pixel_col) + ); + if (($type =~ /BOT|ACQ/) and ($acq_edge_delta < (-1 * 12))) { + push @orange_warn, sprintf "[%2d] Acq Off (padded) CCD by > 60 arcsec.\n", + $i; } - elsif (($type =~ /BOT|ACQ/) and ($acq_edge_delta < 0)){ - push @{$self->{fyi}}, sprintf "[%2d] Acq Off (padded) CCD\n",$i; + elsif (($type =~ /BOT|ACQ/) and ($acq_edge_delta < 0)) { + push @{ $self->{fyi} }, sprintf "[%2d] Acq Off (padded) CCD\n", $i; } - # Faint and bright limits ~ACA-009 ACA-010 - if ($mag ne '---') { - if ($type eq 'GUI' or $type eq 'BOT'){ - my $guide_mag_warn = sprintf "[%2d] Magnitude. Guide star %6.3f\n", $i, $mag; - if (($mag > 10.3) or ($mag < 5.2)){ + # Faint and bright limits ~ACA-009 ACA-010 + if ($mag ne '---') { + if ($type eq 'GUI' or $type eq 'BOT') { + my $guide_mag_warn = sprintf "[%2d] Magnitude. Guide star %6.3f\n", $i, + $mag; + if (($mag > 10.3) or ($mag < 5.2)) { push @warn, $guide_mag_warn; } } - if ($type eq 'BOT' or $type eq 'ACQ'){ - my $acq_mag_warn = sprintf "[%2d] Magnitude. Acq star %6.3f\n", $i, $mag; - if ($mag < 5.2){ + if ($type eq 'BOT' or $type eq 'ACQ') { + my $acq_mag_warn = sprintf "[%2d] Magnitude. Acq star %6.3f\n", $i, + $mag; + if ($mag < 5.2) { push @warn, $acq_mag_warn; } - elsif ($mag > $self->{mag_faint_red}){ + elsif ($mag > $self->{mag_faint_red}) { push @orange_warn, $acq_mag_warn; } - elsif ($mag > $self->{mag_faint_yellow}){ + elsif ($mag > $self->{mag_faint_yellow}) { push @yellow_warn, $acq_mag_warn; } } - } + } - # FID magnitude limits ACA-011 - if ($type eq 'FID') { - if ($mag =~ /---/ or $mag < $fid_bright or $mag > $fid_faint) { - push @warn, sprintf "[%2d] Magnitude. %6.3f\n",$i, $mag =~ /---/ ? 0 : $mag; - } - } + # FID magnitude limits ACA-011 + if ($type eq 'FID') { + if ($mag =~ /---/ or $mag < $fid_bright or $mag > $fid_faint) { + push @warn, sprintf "[%2d] Magnitude. %6.3f\n", $i, + $mag =~ /---/ ? 0 : $mag; + } + } # Check for situation that occurred for obsid 14577 with a fid light # inside the search box (PR #50). - if ($type =~ /BOT|ACQ/){ + if ($type =~ /BOT|ACQ/) { + # Margin for fid spoiling the acquisition star is the search box halfwidth - # plus the uncertainty in fid position. See starcheck #251 for justification + # plus the uncertainty in fid position. See starcheck #251 for justification # of the 25 arcsec value here. my $fid_spoil_margin = $halfw + 25.0; - for my $fpos (@fid_positions){ - if (abs($fpos->{y} - $yag) < $fid_spoil_margin and - abs($fpos->{z} - $zag) < $fid_spoil_margin){ - if ($type =~ /ACQ/){ - push @yellow_warn, sprintf "[%2d] Fid light in search box\n", $i; + for my $fpos (@fid_positions) { + if ( abs($fpos->{y} - $yag) < $fid_spoil_margin + and abs($fpos->{z} - $zag) < $fid_spoil_margin) + { + if ($type =~ /ACQ/) { + push @yellow_warn, sprintf "[%2d] Fid light in search box\n", + $i; } - else{ + else { push @warn, sprintf "[%2d] Fid light in search box\n", $i; } } } } - if ($type =~ /BOT|GUI|ACQ/){ - if (( $maxmag =~ /---/) or ($mag =~ /---/)){ - push @warn, sprintf "[%2d] Magnitude. MAG or MAGMAX not defined \n",$i; - } - else{ + if ($type =~ /BOT|GUI|ACQ/) { + if (($maxmag =~ /---/) or ($mag =~ /---/)) { + push @warn, sprintf "[%2d] Magnitude. MAG or MAGMAX not defined \n", + $i; + } + else { # This is an explicit check of ACA-041 - if (($maxmag - $mag) < 0.3){ + if (($maxmag - $mag) < 0.3) { push @warn, sprintf "[%2d] Magnitude. MAXMAG - MAG < 0.3\n", $i; } + # This is a check that maxmag for each slot is as-expected. - # Note that for stars with large mag err (like color 1.5 stars) this will throw + # Note that for stars with large mag err (like color 1.5 stars) this will throw # a warning. my $rounded_maxmag = sprintf("%.2f", $maxmag); my $expected_maxmag = min($mag + 1.5, 11.2); - if (abs($expected_maxmag - $rounded_maxmag) > 0.1){ + if (abs($expected_maxmag - $rounded_maxmag) > 0.1) { push @yellow_warn, - sprintf "[%2d] Magnitude. MAXMAG %.2f not within 0.1 mag of %.2f. (MAXMAG-MAG=%.2f) \n", - $i, $rounded_maxmag, $expected_maxmag, $maxmag - $mag; - } - } - } - - # Search box too large ACA-018 - if ($type ne 'MON' and $c->{"HALFW$i"} > 200) { - push @warn, sprintf "[%2d] Search Box Size. Search Box Too Large. \n",$i; - } - - my $img_size = $ENV{PROSECO_OR_IMAGE_SIZE} || '8'; - my $or_size = "${img_size}x${img_size}"; - # Check that readout sizes are all as-requested for science observations ACA-027 - if ($is_science && $type =~ /BOT|GUI|ACQ/ && $c->{"SIZE$i"} ne $or_size){ - push @warn, sprintf("[%2d] Readout Size. %s Should be %s\n", - $i, $c->{"SIZE$i"}, $or_size); - } - - # Check that readout sizes are all 8x8 for engineering observations ACA-028 - if ($is_er && $type =~ /BOT|GUI|ACQ/ && $c->{"SIZE$i"} ne "8x8"){ - push @warn, sprintf("[%2d] Readout Size. %s Should be 8x8\n", $i, $c->{"SIZE$i"}); - } - - # Check that readout sizes are all 8x8 for FID lights ACA-029 - push @warn, sprintf("[%2d] Readout Size. %s Should be 8x8\n", $i, $c->{"SIZE$i"}) - if ($type =~ /FID/ && $c->{"SIZE$i"} ne "8x8"); - - # Check that readout size is 8x8 for monitor windows ACA-030 - push @warn, sprintf("[%2d] Readout Size. %s Should be 8x8\n", $i, $c->{"SIZE$i"}) - if ($type =~ /MON/ && $c->{"SIZE$i"} ne "8x8"); - - - # Bad Pixels ACA-025 + sprintf +"[%2d] Magnitude. MAXMAG %.2f not within 0.1 mag of %.2f. (MAXMAG-MAG=%.2f) \n", + $i, $rounded_maxmag, $expected_maxmag, $maxmag - $mag; + } + } + } + + # Search box too large ACA-018 + if ($type ne 'MON' and $c->{"HALFW$i"} > 200) { + push @warn, sprintf "[%2d] Search Box Size. Search Box Too Large. \n", $i; + } + + my $img_size = $ENV{PROSECO_OR_IMAGE_SIZE} || '8'; + my $or_size = "${img_size}x${img_size}"; + + # Check that readout sizes are all as-requested for science observations ACA-027 + if ($is_science && $type =~ /BOT|GUI|ACQ/ && $c->{"SIZE$i"} ne $or_size) { + push @warn, + sprintf("[%2d] Readout Size. %s Should be %s\n", + $i, $c->{"SIZE$i"}, $or_size); + } + + # Check that readout sizes are all 8x8 for engineering observations ACA-028 + if ($is_er && $type =~ /BOT|GUI|ACQ/ && $c->{"SIZE$i"} ne "8x8") { + push @warn, + sprintf("[%2d] Readout Size. %s Should be 8x8\n", $i, $c->{"SIZE$i"}); + } + + # Check that readout sizes are all 8x8 for FID lights ACA-029 + push @warn, + sprintf("[%2d] Readout Size. %s Should be 8x8\n", $i, $c->{"SIZE$i"}) + if ($type =~ /FID/ && $c->{"SIZE$i"} ne "8x8"); + + # Check that readout size is 8x8 for monitor windows ACA-030 + push @warn, + sprintf("[%2d] Readout Size. %s Should be 8x8\n", $i, $c->{"SIZE$i"}) + if ($type =~ /MON/ && $c->{"SIZE$i"} ne "8x8"); + + # Bad Pixels ACA-025 my @close_pixels; my @dr; - if ($type =~ /GUI|BOT/){ - foreach my $pixel (@bad_pixels) { - my $dy = abs($pixel_row-$pixel->{row}) * 5; - my $dz = abs($pixel_col-$pixel->{col}) * 5; - my $dr = sqrt($dy**2 + $dz**2); - next unless ($dz < $self->{dither_guide}->{ampl_p} + 25 and $dy < $self->{dither_guide}->{ampl_y} + 25); - push @close_pixels, sprintf(" row, col (%d, %d), dy, dz (%d, %d) \n", - $pixel->{row}, $pixel->{col}, $dy, $dz); - push @dr, $dr; - } - if ( @close_pixels > 0 ) { - my ($closest) = sort { $dr[$a] <=> $dr[$b] } (0 .. $#dr); - my $warn = sprintf("[%2d] Nearby ACA bad pixel. " - . $close_pixels[$closest], - $i); #Only warn for the closest pixel - push @warn, $warn; - } - } - - # Spoiler star (for search) and common column - - foreach my $star (values %{$self->{agasc_hash}}) { + if ($type =~ /GUI|BOT/) { + foreach my $pixel (@bad_pixels) { + my $dy = abs($pixel_row - $pixel->{row}) * 5; + my $dz = abs($pixel_col - $pixel->{col}) * 5; + my $dr = sqrt($dy**2 + $dz**2); + next + unless ($dz < $self->{dither_guide}->{ampl_p} + 25 + and $dy < $self->{dither_guide}->{ampl_y} + 25); + push @close_pixels, + sprintf(" row, col (%d, %d), dy, dz (%d, %d) \n", + $pixel->{row}, $pixel->{col}, $dy, $dz); + push @dr, $dr; + } + if (@close_pixels > 0) { + my ($closest) = sort { $dr[$a] <=> $dr[$b] } (0 .. $#dr); + my $warn = + sprintf("[%2d] Nearby ACA bad pixel. " . $close_pixels[$closest], $i) + ; #Only warn for the closest pixel + push @warn, $warn; + } + } + + # Spoiler star (for search) and common column + + foreach my $star (values %{ $self->{agasc_hash} }) { + # Skip tests if $star is the same as the catalog star - next if ( $star->{id} eq $sid || - ( abs($star->{yag} - $yag) < $ID_DIST_LIMIT - && abs($star->{zag} - $zag) < $ID_DIST_LIMIT - && abs($star->{mag_aca} - $mag) < 0.1 ) ); - my $dy = abs($yag-$star->{yag}); - my $dz = abs($zag-$star->{zag}); - my $dr = sqrt($dz**2 + $dy**2); - my $dm = $mag ne '---' ? $mag - $star->{mag_aca} : 0.0; - my $dm_string = $mag ne '---' ? sprintf("%4.1f", $mag - $star->{mag_aca}) : '?'; - - # Fid within $dither + 25 arcsec of a star (yellow) and within 4 mags (red) ACA-024 - if ($type eq 'FID' + next + if ( + $star->{id} eq $sid + || ( abs($star->{yag} - $yag) < $ID_DIST_LIMIT + && abs($star->{zag} - $zag) < $ID_DIST_LIMIT + && abs($star->{mag_aca} - $mag) < 0.1) + ); + my $dy = abs($yag - $star->{yag}); + my $dz = abs($zag - $star->{zag}); + my $dr = sqrt($dz**2 + $dy**2); + my $dm = $mag ne '---' ? $mag - $star->{mag_aca} : 0.0; + my $dm_string = + $mag ne '---' ? sprintf("%4.1f", $mag - $star->{mag_aca}) : '?'; + + # Fid within $dither + 25 arcsec of a star (yellow) and within 4 mags (red) ACA-024 + if ( $type eq 'FID' and $dz < $self->{dither_guide}->{ampl_p} + 25 and $dy < $self->{dither_guide}->{ampl_y} + 25 - and $dm > -5.0) { - my $warn = sprintf("[%2d] Fid spoiler. %10d: " . - "Y,Z,Radial,Mag seps: %3d %3d %3d %4s\n",$i,$star->{id},$dy,$dz,$dr,$dm_string); - if ($dm > -4.0) { push @warn, $warn } - else { push @yellow_warn, $warn } - } + and $dm > -5.0) + { + my $warn = + sprintf("[%2d] Fid spoiler. %10d: " + . "Y,Z,Radial,Mag seps: %3d %3d %3d %4s\n", + $i, $star->{id}, $dy, $dz, $dr, $dm_string); + if ($dm > -4.0) { push @warn, $warn } + else { push @yellow_warn, $warn } + } # Spoiler star in track box ACA-022 - if (($type =~ /BOT|GUI/) and ($dz < 25) and ($dy < 25) and ($dm > -1.0)){ - my $warn = sprintf("[%2d] Spoiler. %10d: " . - "Y,Z,Radial,Mag seps: %3d %3d %3d %4s\n",$i,$star->{id},$dy,$dz,$dr,$dm_string); - if ($dm > -0.2) { push @warn, $warn } - else { push @yellow_warn, $warn } + if (($type =~ /BOT|GUI/) and ($dz < 25) and ($dy < 25) and ($dm > -1.0)) { + my $warn = sprintf( + "[%2d] Spoiler. %10d: " . "Y,Z,Radial,Mag seps: %3d %3d %3d %4s\n", + $i, $star->{id}, $dy, $dz, $dr, $dm_string); + if ($dm > -0.2) { push @warn, $warn } + else { push @yellow_warn, $warn } } - # Search box spoiler - star within search box + search error and within 1.0 mags ACA-023 - if ($type =~ /BOT|ACQ/ and $dz < $halfw + $search_err and $dy < $halfw + $search_err and $dm > -1.0) { - my $warn = sprintf("[%2d] Search spoiler. %10d: " . - "Y,Z,Radial,Mag seps: %3d %3d %3d %4s\n",$i,$star->{id},$dy,$dz,$dr,$dm_string); - if ($dm > -0.2) { push @orange_warn, $warn } - else { push @yellow_warn, $warn } - } - - # Common column: dz within limit, spoiler is $col_sep_mag brighter than star, - # and spoiler is located between star and readout ACA-026 - if ($type ne 'MON' - and $dz < $col_sep_dist - and $dm > $col_sep_mag - and ($star->{yag}/$yag) > 1.0 - and abs($star->{yag}) < 2500) { - push @warn,sprintf("[%2d] Common Column. %10d " . - "at Y,Z,Mag: %5d %5d %5.2f\n",$i,$star->{id},$star->{yag},$star->{zag},$star->{mag_aca}); - } - } - } - - - -# Find the smallest rectangle size that all acq stars fit in - my $y_side = sprintf( "%.0f", $max_y - $min_y ); - my $z_side = sprintf( "%.0f", $max_z - $min_z ); + +# Search box spoiler - star within search box + search error and within 1.0 mags ACA-023 + if ( $type =~ /BOT|ACQ/ + and $dz < $halfw + $search_err + and $dy < $halfw + $search_err + and $dm > -1.0) + { + my $warn = + sprintf("[%2d] Search spoiler. %10d: " + . "Y,Z,Radial,Mag seps: %3d %3d %3d %4s\n", + $i, $star->{id}, $dy, $dz, $dr, $dm_string); + if ($dm > -0.2) { push @orange_warn, $warn } + else { push @yellow_warn, $warn } + } + + # Common column: dz within limit, spoiler is $col_sep_mag brighter than star, + # and spoiler is located between star and readout ACA-026 + if ( $type ne 'MON' + and $dz < $col_sep_dist + and $dm > $col_sep_mag + and ($star->{yag} / $yag) > 1.0 + and abs($star->{yag}) < 2500) + { + push @warn, + sprintf("[%2d] Common Column. %10d " . "at Y,Z,Mag: %5d %5d %5.2f\n", + $i, $star->{id}, $star->{yag}, $star->{zag}, $star->{mag_aca}); + } + } + } + + # Find the smallest rectangle size that all acq stars fit in + my $y_side = sprintf("%.0f", $max_y - $min_y); + my $z_side = sprintf("%.0f", $max_z - $min_z); push @yellow_warn, "Guide stars fit in $y_side x $z_side square arc-second box\n" - if $y_side < $min_y_side && $z_side < $min_z_side; + if $y_side < $min_y_side && $z_side < $min_z_side; # Collect warnings - push @{$self->{warn}}, @warn; - push @{$self->{orange_warn}}, @orange_warn; - push @{$self->{yellow_warn}}, @yellow_warn; + push @{ $self->{warn} }, @warn; + push @{ $self->{orange_warn} }, @orange_warn; + push @{ $self->{yellow_warn} }, @yellow_warn; } - ############################################################################################# sub check_monitor_commanding { ############################################################################################# my $self = shift; - my $backstop = shift; # Reference to array of backstop commands - my $or = shift; # Reference to OR list hash - my $time_tol = 10; # Commands must be within $time_tol of expectation + my $backstop = shift; # Reference to array of backstop commands + my $or = shift; # Reference to OR list hash + my $time_tol = 10; # Commands must be within $time_tol of expectation my $c; my $bs; my $cmd; - my $r2a = 180./3.14159265*3600; + my $r2a = 180. / 3.14159265 * 3600; # Save the number of warnings when starting this method - my $n_warn = scalar(@{$self->{warn}}); + my $n_warn = scalar(@{ $self->{warn} }); # if this is a real numeric obsid - if ( $self->{obsid} =~ /^\d*$/ ){ + if ($self->{obsid} =~ /^\d*$/) { - # Don't worry about monitor commanding for non-science observations - return if ($self->{obsid} >= $ER_MIN_OBSID); + # Don't worry about monitor commanding for non-science observations + return if ($self->{obsid} >= $ER_MIN_OBSID); } # Check for existence of a star catalog return unless ($c = find_command($self, "MP_STARCAT")); - # See if there are any monitor stars requested in the OR - my $or_has_mon = ( defined $or->{HAS_MON} ) ? 1 : 0; + my $or_has_mon = (defined $or->{HAS_MON}) ? 1 : 0; - my @mon_stars = grep { $c->{"TYPE$_"} eq 'MON' } (1..16); + my @mon_stars = grep { $c->{"TYPE$_"} eq 'MON' } (1 .. 16); # if there are no requests in the OR and there are no MON stars, exit return unless $or_has_mon or scalar(@mon_stars); - my $found_mon = scalar(@mon_stars); my $stealth_mon = 0; - if (($found_mon) and (not $or_has_mon)){ - push @{$self->{warn}}, sprintf("MON not in OR, but in catalog. Position not checked.\n"); + if (($found_mon) and (not $or_has_mon)) { + push @{ $self->{warn} }, + sprintf("MON not in OR, but in catalog. Position not checked.\n"); } # Where is the requested OR? my $q_aca = Quat->new($self->{ra}, $self->{dec}, $self->{roll}); my ($or_yang, $or_zang); - if ($or_has_mon){ - ($or_yang, $or_zang) = Quat::radec2yagzag($or->{MON_RA}, $or->{MON_DEC}, $q_aca) if ($or_has_mon) ; + if ($or_has_mon) { + ($or_yang, $or_zang) = Quat::radec2yagzag($or->{MON_RA}, $or->{MON_DEC}, $q_aca) + if ($or_has_mon); } # Check all indices IDX: - for my $idx ( 1 ... 16 ){ - my %idx_hash = (idx => $idx ); - ($idx_hash{type}, - $idx_hash{imnum}, - $idx_hash{restrk}, - $idx_hash{yang}, - $idx_hash{zang}, - $idx_hash{dimdts}, - $idx_hash{size}) - = map { $c->{"$_${idx}"} } qw( - TYPE - IMNUM - RESTRK - YANG - ZANG - DIMDTS - SIZE); - my $y_sep = $or_yang*$r2a - $idx_hash{yang}; - my $z_sep = $or_zang*$r2a - $idx_hash{zang}; - $idx_hash{sep} = sqrt($y_sep**2 + $z_sep**2); - - # if this is a plain commanded MON - if ($idx_hash{type} =~ /MON/ ){ - # if it doesn't match the requested location ACA-037 - push @{$self->{warn}}, sprintf("[%2d] Monitor Commanding. Monitor Window is %6.2f arc-seconds off of OR specification\n" - , $idx_hash{idx}, $idx_hash{sep}) - if $idx_hash{sep} > 2.5; - # if it isn't 8x8 - push @{$self->{warn}}, sprintf("[%2d] Monitor Commanding. Size is not 8x8\n", $idx_hash{idx}) - unless $idx_hash{size} eq "8x8"; - - # if it isn't in slot 7 ACA-036 - push @{$self->{warn}}, sprintf("[%2d] Monitor Commanding. Monitor Window is in slot %2d and should be in slot 7.\n" - , $idx_hash{idx}, $idx_hash{imnum}) - if $idx_hash{imnum} != 7; - # ACA-038 - push @{$self->{warn}}, sprintf("[%2d] Monitor Commanding. Monitor Window is set to Convert-to-Track\n", $idx_hash{idx}) - if $idx_hash{restrk} == 1; - - - # Verify the the designated track star is indeed a guide star. ACA-039 - my $dts_slot = $idx_hash{dimdts}; - my $dts_type = "NULL"; - foreach my $dts_index (1..16) { - next unless $c->{"IMNUM$dts_index"} == $dts_slot and $c->{"TYPE$dts_index"} =~ /GUI|BOT/; - $dts_type = $c->{"TYPE$dts_index"}; - last; - } - push @{$self->{warn}}, sprintf("[%2d] Monitor Commanding. DTS for [%2d] is set to slot %2d which does not contain a guide star.\n", - $idx_hash{idx}, $idx_hash{idx}, $dts_slot) - if $dts_type =~ /NULL/; - next IDX; - } - - if (($idx_hash{type} =~ /GUI|BOT/) and ($idx_hash{size} eq '8x8') and ($idx_hash{imnum} == 7)){ - $stealth_mon = 1; - push @{$self->{fyi}}, sprintf("[%2d] Appears to be MON used as GUI/BOT.\n", - $idx); - # if it doesn't match the requested location - push @{$self->{warn}}, sprintf("[%2d] Monitor Commanding. Guide star as MON %6.2f arc-seconds off OR specification\n" - , $idx_hash{idx}, $idx_hash{sep}) - if $idx_hash{sep} > 2.5; - - next IDX; - } - if ((not $found_mon) and ($idx_hash{sep} < 2.5)){ - # if there *should* be one there... - push @{$self->{fyi}}, sprintf("[%2d] Commanded at intended OR MON position; but not configured for MON\n", - $idx); - } - - } + for my $idx (1 ... 16) { + my %idx_hash = (idx => $idx); + ( + $idx_hash{type}, + $idx_hash{imnum}, + $idx_hash{restrk}, + $idx_hash{yang}, + $idx_hash{zang}, + $idx_hash{dimdts}, + $idx_hash{size} + ) + = map { $c->{"$_${idx}"} } + qw( + TYPE + IMNUM + RESTRK + YANG + ZANG + DIMDTS + SIZE); + my $y_sep = $or_yang * $r2a - $idx_hash{yang}; + my $z_sep = $or_zang * $r2a - $idx_hash{zang}; + $idx_hash{sep} = sqrt($y_sep**2 + $z_sep**2); + + # if this is a plain commanded MON + if ($idx_hash{type} =~ /MON/) { + + # if it doesn't match the requested location ACA-037 + push @{ $self->{warn} }, + sprintf( +"[%2d] Monitor Commanding. Monitor Window is %6.2f arc-seconds off of OR specification\n", + $idx_hash{idx}, $idx_hash{sep}) + if $idx_hash{sep} > 2.5; + + # if it isn't 8x8 + push @{ $self->{warn} }, + sprintf("[%2d] Monitor Commanding. Size is not 8x8\n", $idx_hash{idx}) + unless $idx_hash{size} eq "8x8"; + + # if it isn't in slot 7 ACA-036 + push @{ $self->{warn} }, + sprintf( +"[%2d] Monitor Commanding. Monitor Window is in slot %2d and should be in slot 7.\n", + $idx_hash{idx}, $idx_hash{imnum}) + if $idx_hash{imnum} != 7; + + # ACA-038 + push @{ $self->{warn} }, + sprintf( + "[%2d] Monitor Commanding. Monitor Window is set to Convert-to-Track\n", + $idx_hash{idx}) + if $idx_hash{restrk} == 1; + + # Verify the the designated track star is indeed a guide star. ACA-039 + my $dts_slot = $idx_hash{dimdts}; + my $dts_type = "NULL"; + foreach my $dts_index (1 .. 16) { + next + unless $c->{"IMNUM$dts_index"} == $dts_slot + and $c->{"TYPE$dts_index"} =~ /GUI|BOT/; + $dts_type = $c->{"TYPE$dts_index"}; + last; + } + push @{ $self->{warn} }, + sprintf( +"[%2d] Monitor Commanding. DTS for [%2d] is set to slot %2d which does not contain a guide star.\n", + $idx_hash{idx}, + $idx_hash{idx}, + $dts_slot + ) if $dts_type =~ /NULL/; + next IDX; + } + + if ( ($idx_hash{type} =~ /GUI|BOT/) + and ($idx_hash{size} eq '8x8') + and ($idx_hash{imnum} == 7)) + { + $stealth_mon = 1; + push @{ $self->{fyi} }, + sprintf("[%2d] Appears to be MON used as GUI/BOT.\n", $idx); + + # if it doesn't match the requested location + push @{ $self->{warn} }, + sprintf( +"[%2d] Monitor Commanding. Guide star as MON %6.2f arc-seconds off OR specification\n", + $idx_hash{idx}, $idx_hash{sep}) + if $idx_hash{sep} > 2.5; + + next IDX; + } + if ((not $found_mon) and ($idx_hash{sep} < 2.5)) { + # if there *should* be one there... + push @{ $self->{fyi} }, + sprintf( +"[%2d] Commanded at intended OR MON position; but not configured for MON\n", + $idx); + } + + } # if I don't have a plain MON or a "stealth" MON, throw a warning - push @{$self->{warn}}, sprintf("MON requested in OR, but none found in catalog\n") - unless ( $found_mon or $stealth_mon ); + push @{ $self->{warn} }, sprintf("MON requested in OR, but none found in catalog\n") + unless ($found_mon or $stealth_mon); # if we're using a guide star, we don't need the rest of the dither setup - if ($stealth_mon and not $found_mon){ - return; + if ($stealth_mon and not $found_mon) { + return; } # Find the associated maneuver command for this obsid. Need this to get the # exact time of the end of maneuver my $manv; unless ($manv = find_command($self, "MP_TARGQUAT", -1)) { - push @{$self->{warn}}, sprintf("Cannot find maneuver for checking monitor commanding\n"); - return; + push @{ $self->{warn} }, + sprintf("Cannot find maneuver for checking monitor commanding\n"); + return; } - # Now check in backstop commands for : # Dither is disabled (AODSDITH) 1 min prior to the end of the maneuver (EOM) # to the target attitude. @@ -1680,28 +1879,29 @@ sub check_monitor_commanding { my %dt = (AODSDITH => -60, AOACRSET => 180, AOENDITH => 300); my %cnt = map { $_ => 0 } keys %dt; foreach $bs (grep { $_->{cmd} eq 'COMMAND_SW' } @{$backstop}) { - my %param = Ska::Parse_CM_File::parse_params($bs->{params}); - next unless ($param{TLMSID} =~ /^AO/); - foreach $cmd (keys %dt) { - if ($cmd =~ /$param{TLMSID}/){ - if ( abs($bs->{time} - ($t_manv+$dt{$cmd})) < $time_tol){ - $cnt{$cmd}++; - } - } - } - } - - # Add warning messages unless exactly one of each command was found at the right time + my %param = Ska::Parse_CM_File::parse_params($bs->{params}); + next unless ($param{TLMSID} =~ /^AO/); + foreach $cmd (keys %dt) { + if ($cmd =~ /$param{TLMSID}/) { + if (abs($bs->{time} - ($t_manv + $dt{$cmd})) < $time_tol) { + $cnt{$cmd}++; + } + } + } + } + + # Add warning messages unless exactly one of each command was found at the right time foreach $cmd (qw (AODSDITH AOACRSET AOENDITH)) { - next if ($cnt{$cmd} == 1); - $cnt{$cmd} = 'no' if ($cnt{$cmd} == 0); - push @{$self->{warn}}, "Found $cnt{$cmd} $cmd commands near " . time2date($t_manv+$dt{$cmd}) . "\n"; + next if ($cnt{$cmd} == 1); + $cnt{$cmd} = 'no' if ($cnt{$cmd} == 0); + push @{ $self->{warn} }, "Found $cnt{$cmd} $cmd commands near " + . time2date($t_manv + $dt{$cmd}) . "\n"; } - # If the number of warnings has not changed during this routine, it passed all checks - if (scalar(@{$self->{warn}}) == $n_warn){ - push @{$self->{fyi}}, - sprintf("Monitor window special commanding meets requirements\n"); + # If the number of warnings has not changed during this routine, it passed all checks + if (scalar(@{ $self->{warn} }) == $n_warn) { + push @{ $self->{fyi} }, + sprintf("Monitor window special commanding meets requirements\n"); } } @@ -1709,79 +1909,86 @@ sub check_monitor_commanding { sub check_fids { ############################################################################################# my $self = shift; - my $c = shift; # Star catalog command - my $warn = shift; # Array ref to warnings for this obsid + my $c = shift; # Star catalog command + my $warn = shift; # Array ref to warnings for this obsid my (@fid_ok, @fidsel_ok); my ($i, $i_fid); # If no star cat fids and no commanded fids, then return - my $fid_number = @{$self->{fid}}; - return if ($fid_number == 0 && @{$self->{fidsel}} == 0); + my $fid_number = @{ $self->{fid} }; + return if ($fid_number == 0 && @{ $self->{fidsel} } == 0); # Make sure we have SI and SIM_OFFSET_Z to be able to calculate fid yang and zang unless (defined $self->{SI}) { - push @{$warn}, "Unable to check fids because SI undefined\n"; - return; + push @{$warn}, "Unable to check fids because SI undefined\n"; + return; } - unless (defined $self->{SIM_OFFSET_Z}){ - push @{$warn}, "Unable to check fids because SIM_OFFSET_Z undefined\n"; - return; + unless (defined $self->{SIM_OFFSET_Z}) { + push @{$warn}, "Unable to check fids because SIM_OFFSET_Z undefined\n"; + return; } - @fid_ok = map { 0 } @{$self->{fid}}; + @fid_ok = map { 0 } @{ $self->{fid} }; # Calculate yang and zang for each commanded fid, then cross-correlate with # all commanded fids. - foreach my $fid (@{$self->{fidsel}}) { + foreach my $fid (@{ $self->{fidsel} }) { - my ($yag, $zag, $error) = calc_fid_ang($fid, $self->{SI}, $self->{SIM_OFFSET_Z}, $self->{obsid}); + my ($yag, $zag, $error) = + calc_fid_ang($fid, $self->{SI}, $self->{SIM_OFFSET_Z}, $self->{obsid}); - if ($error) { - push @{$warn}, "$error\n"; - next; - } - my $fidsel_ok = 0; + if ($error) { + push @{$warn}, "$error\n"; + next; + } + my $fidsel_ok = 0; - # Cross-correlate with all star cat fids - for $i_fid (0 .. $#fid_ok) { - $i = $self->{fid}[$i_fid]; # Index into star catalog entries + # Cross-correlate with all star cat fids + for $i_fid (0 .. $#fid_ok) { + $i = $self->{fid}[$i_fid]; # Index into star catalog entries - # Check if starcat fid matches fidsel fid position to within 10 arcsec - if (abs($yag - $c->{"YANG$i"}) < 10.0 && abs($zag - $c->{"ZANG$i"}) < 10.0) { - $fidsel_ok = 1; - $fid_ok[$i_fid] = 1; - last; - } - } + # Check if starcat fid matches fidsel fid position to within 10 arcsec + if (abs($yag - $c->{"YANG$i"}) < 10.0 && abs($zag - $c->{"ZANG$i"}) < 10.0) + { + $fidsel_ok = 1; + $fid_ok[$i_fid] = 1; + last; + } + } # ACA-034 - push @{$warn}, sprintf("Fid $self->{SI} FIDSEL $fid not found within 10 arcsec of (%.1f, %.1f)\n", - $yag, $zag) - unless ($fidsel_ok); + push @{$warn}, + sprintf( + "Fid $self->{SI} FIDSEL $fid not found within 10 arcsec of (%.1f, %.1f)\n", + $yag, $zag) + unless ($fidsel_ok); } + # ACA-035 for $i_fid (0 .. $#fid_ok) { - push @{$warn}, "Fid with IDX=\[$self->{fid}[$i_fid]\] is in star catalog but is not turned on via FIDSEL\n" - unless ($fid_ok[$i_fid]); + push @{$warn}, +"Fid with IDX=\[$self->{fid}[$i_fid]\] is in star catalog but is not turned on via FIDSEL\n" + unless ($fid_ok[$i_fid]); } } ############################################################################## sub calc_fid_ang { -# From OFLS SDS: -# Y_ang = fid position angle measured about the ACA z-axis as shown in -# Fig. 4.3-5. In that figure, Y_ang corresponds to the ACA -# y angle, or "yag". -# Y_S = Y coordinate of fid light -# R_H = distance from SI fid light point of origin to HRMA nodal point -# X_f = Offset from nominal FA position -# -# Y_ang = -Y_s / (R_H - X_f) -# Z_ang = -(Z_s + Z_f) / (R_H - X_f) + + # From OFLS SDS: + # Y_ang = fid position angle measured about the ACA z-axis as shown in + # Fig. 4.3-5. In that figure, Y_ang corresponds to the ACA + # y angle, or "yag". + # Y_S = Y coordinate of fid light + # R_H = distance from SI fid light point of origin to HRMA nodal point + # X_f = Offset from nominal FA position + # + # Y_ang = -Y_s / (R_H - X_f) + # Z_ang = -(Z_s + Z_f) / (R_H - X_f) ############################################################################## my ($fid, $si, $sim_z_offset, $obsid) = @_; - my $r2a = 180./3.14159265*3600; + my $r2a = 180. / 3.14159265 * 3600; # Make some variables for accessing ODB elements $si =~ tr/a-z/A-Z/; @@ -1790,27 +1997,30 @@ sub calc_fid_ang { my ($si2hrma) = ($si =~ /(ACIS|HRCI|HRCS)/); # Define allowed range for $fid for each detector - my %range = (ACIS => [1,6], - HRCI => [7,10], - HRCS => [11,14]); + my %range = ( + ACIS => [ 1, 6 ], + HRCI => [ 7, 10 ], + HRCS => [ 11, 14 ] + ); # Check that the fid light (from fidsel history) is appropriate for the detector unless ($fid >= $range{$si2hrma}[0] and $fid <= $range{$si2hrma}[1]) { - return (undef, undef, "Commanded fid light $fid does not correspond to detector $si2hrma"); + return (undef, undef, + "Commanded fid light $fid does not correspond to detector $si2hrma"); } # Generate index into ODB tables. This goes from 0..5 (ACIS) or 0..3 (HRC) my $fid_id = $fid - $range{$si2hrma}[0]; # Calculate fid angles using formula in OFLS - my $y_s = $odb{"ODB_${si}_FIDPOS"}[$fid_id*2]; - my $z_s = $odb{"ODB_${si}_FIDPOS"}[$fid_id*2+1]; + my $y_s = $odb{"ODB_${si}_FIDPOS"}[ $fid_id * 2 ]; + my $z_s = $odb{"ODB_${si}_FIDPOS"}[ $fid_id * 2 + 1 ]; my $r_h = $odb{"ODB_${si2hrma}_TO_HRMA"}[$fid_id]; my $z_f = -$sim_z_offset * $odb{"ODB_TSC_STEPS"}[0]; my $x_f = 0; if (not $y_s) { - print "yagzag $obsid '$si' '$si2hrma' '$y_s' '$z_s' '$r_h' '$x_f'\n"; + print "yagzag $obsid '$si' '$si2hrma' '$y_s' '$z_s' '$r_h' '$x_f'\n"; } my $yag = -$y_s / ($r_h - $x_f) * $r2a; my $zag = -($z_s + $z_f) / ($r_h - $x_f) * $r2a; @@ -1818,332 +2028,449 @@ sub calc_fid_ang { return ($yag, $zag); } - - ############################################################################################# sub print_report { ############################################################################################# my $self = shift; my $c; - my $o = ''; # Output - - my $target_name = ( $self->{TARGET_NAME}) ? $self->{TARGET_NAME} : $self->{SS_OBJECT}; - - $o .= sprintf( "
    ", $self->{obsid});
-    $o .= sprintf ("${blue_font_start}OBSID: %-5s  ", $self->{obsid});
-    $o .= sprintf ("%-22s %-6s SIM Z offset:%-5d (%-.2fmm) Grating: %-5s", $target_name, $self->{SI},
-		   $self->{SIM_OFFSET_Z},  ($self->{SIM_OFFSET_Z})*1000*($odb{"ODB_TSC_STEPS"}[0]), $self->{GRATING}) if ($target_name);
+    my $o = '';    # Output
+
+    my $target_name =
+      ($self->{TARGET_NAME}) ? $self->{TARGET_NAME} : $self->{SS_OBJECT};
+
+    $o .= sprintf(
+"
    ",
+        $self->{obsid});
+    $o .= sprintf("${blue_font_start}OBSID: %-5s  ", $self->{obsid});
+    $o .= sprintf(
+        "%-22s %-6s SIM Z offset:%-5d (%-.2fmm) Grating: %-5s",
+        $target_name, $self->{SI}, $self->{SIM_OFFSET_Z},
+        ($self->{SIM_OFFSET_Z}) * 1000 * ($odb{"ODB_TSC_STEPS"}[0]),
+        $self->{GRATING}
+    ) if ($target_name);
     $o .= sprintf "${font_stop}\n";
-    if ( ( defined $self->{ra} ) and (defined $self->{dec}) and (defined $self->{roll})){
-	$o .= sprintf "RA, Dec, Roll (deg): %12.6f %12.6f %12.6f\n", $self->{ra}, $self->{dec}, $self->{roll};
+
+    if ((defined $self->{ra}) and (defined $self->{dec}) and (defined $self->{roll})) {
+        $o .= sprintf "RA, Dec, Roll (deg): %12.6f %12.6f %12.6f\n", $self->{ra},
+          $self->{dec}, $self->{roll};
     }
-    # This 'defined' check has been changed to be a test on the amplitude.  It looks like for the undefined
+
+# This 'defined' check has been changed to be a test on the amplitude.  It looks like for the undefined
     # case such as replan, this {dither_guide} is set but is an empty hash ref.
-    if (defined $self->{dither_guide}->{ampl_y}){
+    if (defined $self->{dither_guide}->{ampl_y}) {
         my $z_amp = int($self->{dither_guide}->{ampl_p} + .5);
         my $y_amp = int($self->{dither_guide}->{ampl_y} + .5);
-        if ($self->{dither_guide}->{state} eq 'ENAB'){
+        if ($self->{dither_guide}->{state} eq 'ENAB') {
             $o .= sprintf "Dither: ON ";
-            $o .= sprintf ("Y_amp=%4.1f  Z_amp=%4.1f  Y_period=%6.1f  Z_period=%6.1f \n",
-                           $y_amp, $z_amp, $self->{dither_guide}->{period_y}, $self->{dither_guide}->{period_p});
+            $o .= sprintf(
+                "Y_amp=%4.1f  Z_amp=%4.1f  Y_period=%6.1f  Z_period=%6.1f \n",
+                $y_amp, $z_amp,
+                $self->{dither_guide}->{period_y},
+                $self->{dither_guide}->{period_p}
+            );
         }
-        else{
+        else {
             $o .= sprintf "Dither: OFF\n";
         }
     }
 
-    $o .= sprintf("BACKSTOP ", $self->{STARCHECK}, basename($self->{backstop}), $self->{obsid});
-    $o .= sprintf("GUIDE_SUMM ", $self->{STARCHECK}, basename($self->{guide_summ}), $self->{obsid});
-    $o .= sprintf("OR ", $self->{STARCHECK}, basename($self->{or_file}), $self->{obsid})
-	if ($self->{or_file});
-    $o .= sprintf("MANVR ", $self->{STARCHECK}, basename($self->{mm_file}), $self->{dot_obsid});
-    $o .= sprintf("DOT ", $self->{STARCHECK}, basename($self->{dot_file}), $self->{obsid});
-    $o .= sprintf("TLR ", $self->{STARCHECK}, basename($self->{tlr_file}) , $self->{obsid});
+    $o .= sprintf(
+        "BACKSTOP ",
+        $self->{STARCHECK}, basename($self->{backstop}),
+        $self->{obsid}
+    );
+    $o .= sprintf(
+        "GUIDE_SUMM ",
+        $self->{STARCHECK}, basename($self->{guide_summ}),
+        $self->{obsid}
+    );
+    $o .= sprintf(
+        "OR ",
+        $self->{STARCHECK}, basename($self->{or_file}),
+        $self->{obsid}
+    ) if ($self->{or_file});
+    $o .= sprintf(
+        "MANVR ",
+        $self->{STARCHECK}, basename($self->{mm_file}),
+        $self->{dot_obsid}
+    );
+    $o .= sprintf(
+        "DOT ",
+        $self->{STARCHECK}, basename($self->{dot_file}),
+        $self->{obsid}
+    );
+    $o .= sprintf(
+        "TLR ",
+        $self->{STARCHECK}, basename($self->{tlr_file}),
+        $self->{obsid}
+    );
     $o .= sprintf "\n\n";
-    for my $n (1 .. 10) {		# Allow for multiple TARGQUAT cmds, though 2 is the typical limit
-	if ($c = find_command($self, "MP_TARGQUAT", $n)) {
-	    $o .= sprintf "MP_TARGQUAT at $c->{date} (VCDU count = $c->{vcdu})\n";
-	    $o .= sprintf("  Q1,Q2,Q3,Q4: %.8f  %.8f  %.8f  %.8f\n", $c->{Q1}, $c->{Q2}, $c->{Q3}, $c->{Q4});
-	    if (exists $c->{man_err} and exists $c->{dur} and exists $c->{angle}){
-		$o .= sprintf("  MANVR: Angle= %6.2f deg  Duration= %.0f sec  Slew err= %.1f arcsec  End= %s\n",
-			      $c->{angle}, $c->{dur}, $c->{man_err}, substr(time2date($c->{tstop}), 0, 17));
-		}
-	    $o .= "\n";
-	}
+
+    for my $n (1 .. 10)
+    {    # Allow for multiple TARGQUAT cmds, though 2 is the typical limit
+        if ($c = find_command($self, "MP_TARGQUAT", $n)) {
+            $o .= sprintf "MP_TARGQUAT at $c->{date} (VCDU count = $c->{vcdu})\n";
+            $o .= sprintf(
+                "  Q1,Q2,Q3,Q4: %.8f  %.8f  %.8f  %.8f\n",
+                $c->{Q1},
+                $c->{Q2},
+                $c->{Q3},
+                $c->{Q4}
+            );
+            if (exists $c->{man_err} and exists $c->{dur} and exists $c->{angle}) {
+                $o .= sprintf(
+"  MANVR: Angle= %6.2f deg  Duration= %.0f sec  Slew err= %.1f arcsec  End= %s\n",
+                    $c->{angle}, $c->{dur}, $c->{man_err},
+                    substr(time2date($c->{tstop}), 0, 17));
+            }
+            $o .= "\n";
+        }
     }
 
     my $star_stat_lookup = "http://kadi.cfa.harvard.edu/star_hist/?agasc_id=";
 
-
     my $table;
     if ($c = find_command($self, "MP_STARCAT")) {
 
+        my @fid_fields =
+          qw (TYPE  SIZE P_ACQ GS_MAG MAXMAG YANG ZANG DIMDTS RESTRK HALFW GS_PASS GS_NOTES);
+        my @fid_format = (
+            '%6s',
+            '%5s',
+            '%8.3f',
+            '%8s',
+            '%8.3f',
+            '%7d',
+            '%7d',
+            '%4d',
+            '%4d',
+            '%5d',
+            '%6s',
+            '%4s'
+        );
+        my @star_fields =
+          qw (   TYPE  SIZE P_ACQ GS_MAG MAXMAG YANG ZANG DIMDTS RESTRK HALFW GS_PASS GS_NOTES);
+        my @star_format = (
+            '%6s',
+            '%5s',
+            '%8.3f',
+            '%8s',
+            '%8.3f',
+            '%7d',
+            '%7d',
+            '%4d',
+            '%4d',
+            '%5d',
+            '%6s',
+            '%4s'
+        );
+
+        $table .= sprintf "MP_STARCAT at $c->{date} (VCDU count = $c->{vcdu})\n";
+        $table .= sprintf
+"---------------------------------------------------------------------------------------------\n";
+        $table .= sprintf
+" IDX SLOT        ID  TYPE   SZ   P_ACQ    MAG   MAXMAG   YANG   ZANG DIM RES HALFW PASS NOTES\n";
 
-	my @fid_fields = qw (TYPE  SIZE P_ACQ GS_MAG MAXMAG YANG ZANG DIMDTS RESTRK HALFW GS_PASS GS_NOTES);
-	my @fid_format = ( '%6s',   '%5s',  '%8.3f',    '%8s',  '%8.3f',  '%7d',  '%7d',    '%4d',    '%4d',   '%5d',     '%6s',  '%4s');
-	my @star_fields = qw (   TYPE  SIZE P_ACQ GS_MAG MAXMAG YANG ZANG DIMDTS RESTRK HALFW GS_PASS GS_NOTES);
-	my @star_format = ( '%6s',   '%5s',  '%8.3f',    '%8s',  '%8.3f',  '%7d',  '%7d',    '%4d',    '%4d',   '%5d',     '%6s',  '%4s');
-
-	$table.= sprintf "MP_STARCAT at $c->{date} (VCDU count = $c->{vcdu})\n";
-	$table.= sprintf "---------------------------------------------------------------------------------------------\n";
-	$table.= sprintf " IDX SLOT        ID  TYPE   SZ   P_ACQ    MAG   MAXMAG   YANG   ZANG DIM RES HALFW PASS NOTES\n";
 #                      [ 4]  3   971113176   GUI  6x6   1.000   7.314   8.844  -2329  -2242   1   1   25  bcmp
-	$table.= sprintf "---------------------------------------------------------------------------------------------\n";
-
-
-	foreach my $i (1..16) {
-	    my @fields = @star_fields;
-	    my @format = @star_format;
-	    next if ($c->{"TYPE$i"} eq 'NUL');
-	    if ($c->{"TYPE$i"} eq 'FID'){
-		@fields = @fid_fields;
-		@format = @fid_format;
-	    }
-	    # Define the color of output star catalog line based on NOTES:
-	    #   Yellow if NOTES is non-trivial.
-	    #   Red if NOTES has a 'b' for bad class or if a guide star has bad color.
-	    my $color = ($c->{"GS_NOTES$i"} =~ /\S/) ? 'yellow' : '';
-	    $color = 'red' if ($c->{"GS_NOTES$i"} =~ /b/ || ($c->{"GS_NOTES$i"} =~ /c/ && $c->{"TYPE$i"} =~ /GUI|BOT/));
-
-	    if ($color){
-		$table .= ( $color eq 'red') ? $red_font_start :
-		    ( $color eq 'yellow') ? $yellow_font_start : qq{};
-	    }
-	    $table.= sprintf "[%2d]",$i;
-	    # change from a map to a loop to get some conditional control, since PoorTextFormat can't seem to
-	    # take nested \link_target when the line is colored green or red
-	    $table .= sprintf('%3d', $c->{"IMNUM${i}"});
-	    my $db_stats = $c->{"GS_USEDBEFORE${i}"};
-	    my $idlength = length($c->{"GS_ID${i}"});
-	    my $idpad_n = 12 - $idlength;
-	    my $idpad;
-	    while ($idpad_n > 0 ){
-		$idpad .= " ";
-		$idpad_n --;
-	    }
+        $table .= sprintf
+"---------------------------------------------------------------------------------------------\n";
+
+        foreach my $i (1 .. 16) {
+            my @fields = @star_fields;
+            my @format = @star_format;
+            next if ($c->{"TYPE$i"} eq 'NUL');
+            if ($c->{"TYPE$i"} eq 'FID') {
+                @fields = @fid_fields;
+                @format = @fid_format;
+            }
+
+            # Define the color of output star catalog line based on NOTES:
+            #   Yellow if NOTES is non-trivial.
+            #   Red if NOTES has a 'b' for bad class or if a guide star has bad color.
+            my $color = ($c->{"GS_NOTES$i"} =~ /\S/) ? 'yellow' : '';
+            $color = 'red'
+              if ($c->{"GS_NOTES$i"} =~ /b/
+                || ($c->{"GS_NOTES$i"} =~ /c/ && $c->{"TYPE$i"} =~ /GUI|BOT/));
+
+            if ($color) {
+                $table .=
+                    ($color eq 'red') ? $red_font_start
+                  : ($color eq 'yellow') ? $yellow_font_start
+                  : qq{};
+            }
+            $table .= sprintf "[%2d]", $i;
+
+# change from a map to a loop to get some conditional control, since PoorTextFormat can't seem to
+            # take nested \link_target when the line is colored green or red
+            $table .= sprintf('%3d', $c->{"IMNUM${i}"});
+            my $db_stats = $c->{"GS_USEDBEFORE${i}"};
+            my $idlength = length($c->{"GS_ID${i}"});
+            my $idpad_n = 12 - $idlength;
+            my $idpad;
+            while ($idpad_n > 0) {
+                $idpad .= " ";
+                $idpad_n--;
+            }
 
             # Get a string for acquisition probability in the hover-over
             my $acq_prob = "";
-            if ($c->{"TYPE$i"} =~ /BOT|ACQ/){
+            if ($c->{"TYPE$i"} =~ /BOT|ACQ/) {
+
                 # Fetch this slot's acq probability for the hover-over string,
-                # but if the probability is not defined (expected for weird cases such as
+               # but if the probability is not defined (expected for weird cases such as
                 # replan/reopen) just leave $acq_prob as the initialized empty string.
-                if (defined $self->{acq_probs}->{$c->{"IMNUM${i}"}}){
+                if (defined $self->{acq_probs}->{ $c->{"IMNUM${i}"} }) {
                     $acq_prob = sprintf("Prob Acq Success %5.3f",
-                                        $self->{acq_probs}->{$c->{"IMNUM${i}"}})
+                        $self->{acq_probs}->{ $c->{"IMNUM${i}"} });
                 }
             }
+
             # Make the id a URL if there is star history or if star history could
             # not be checked (no db_handle)
             my $star_link;
-            if ($db_stats->{acq} or $db_stats->{gui}){
-                $star_link = sprintf("HREF=\"%s%s\"",$star_stat_lookup, $c->{"GS_ID${i}"});
+            if ($db_stats->{acq} or $db_stats->{gui}) {
+                $star_link =
+                  sprintf("HREF=\"%s%s\"", $star_stat_lookup, $c->{"GS_ID${i}"});
             }
-            else{
+            else {
                 $star_link = sprintf("A=\"star\"");
             }
+
             # If there is database history, add it to the blurb
             my $history_blurb = "";
-	    if ($db_stats->{acq} or $db_stats->{gui}){
-                $history_blurb = sprintf("ACQ total:%d noid:%d 
    "
-			       . "GUI total:%d bad:%d fail:%d obc_bad:%d 
    "
-			       . "Avg Mag %4.2f 
    ",
-                                         $db_stats->{acq}, $db_stats->{acq_noid},
-                                         $db_stats->{gui}, $db_stats->{gui_bad},
-                                         $db_stats->{gui_fail}, $db_stats->{gui_obc_bad},
-                                         $db_stats->{avg_mag})
+            if ($db_stats->{acq} or $db_stats->{gui}) {
+                $history_blurb = sprintf(
+                    "ACQ total:%d noid:%d 
    "
+                      . "GUI total:%d bad:%d fail:%d obc_bad:%d 
    "
+                      . "Avg Mag %4.2f 
    ",
+                    $db_stats->{acq},
+                    $db_stats->{acq_noid},
+                    $db_stats->{gui},
+                    $db_stats->{gui_bad},
+                    $db_stats->{gui_fail},
+                    $db_stats->{gui_obc_bad},
+                    $db_stats->{avg_mag}
+                );
             }
+
             # If the object has catalog information, add it to the blurb
             # for the hoverover
             my $cat_blurb = "";
-            if (defined $c->{"GS_MAGERR$i"}){
-                $cat_blurb = sprintf("mac_aca_err=%4.2f pos_err=%4.2f color1=%4.2f 
    ",
-                                     $c->{"GS_MAGERR$i"}/100., $c->{"GS_POSERR$i"}/1000., $c->{"GS_BV$i"});
+            if (defined $c->{"GS_MAGERR$i"}) {
+                $cat_blurb = sprintf(
+                    "mac_aca_err=%4.2f pos_err=%4.2f color1=%4.2f 
    ",
+                    $c->{"GS_MAGERR$i"} / 100.,
+                    $c->{"GS_POSERR$i"} / 1000.,
+                    $c->{"GS_BV$i"}
+                );
             }
 
             # If the line is a fid or "---" don't make a hoverover
-            if (($c->{"TYPE$i"} eq 'FID') or ($c->{"GS_ID$i"} eq '---')){
+            if (($c->{"TYPE$i"} eq 'FID') or ($c->{"GS_ID$i"} eq '---')) {
                 $table .= sprintf("${idpad}%s", $c->{"GS_ID${i}"});
             }
-            # Otherwise, construct a hoverover and a url as needed, using the blurbs made above
-            else{
-                $table .= sprintf("${idpad}%s",
-                                  $c->{"GS_ID${i}"});
+
+     # Otherwise, construct a hoverover and a url as needed, using the blurbs made above
+            else {
+                $table .= sprintf(
+                    "${idpad}%s",
+                    $c->{"GS_ID${i}"}
+                );
             }
-	    for my $field_idx (0 .. $#fields){
-		my $curr_format = $format[$field_idx];
+            for my $field_idx (0 .. $#fields) {
+                my $curr_format = $format[$field_idx];
                 my $field_color = 'black';
+
                 # override mag formatting if it lost its 3
                 # decimal places during JSONifying
-                if (($fields[$field_idx] eq 'GS_MAG')
-                    and ($c->{"$fields[$field_idx]$i"} ne '---')){
+                if (    ($fields[$field_idx] eq 'GS_MAG')
+                    and ($c->{"$fields[$field_idx]$i"} ne '---'))
+                {
                     $curr_format = "%8.3f";
                 }
 
                 # For P_ACQ fields, if it is a string, use that format
                 # If it is defined, and probability is less than .50, print red
                 # If it is defined, and probability is less than .75, print "yellow"
-                if (($fields[$field_idx] eq 'P_ACQ')
-                    and ($c->{"P_ACQ$i"} eq '---')){
+                if (    ($fields[$field_idx] eq 'P_ACQ')
+                    and ($c->{"P_ACQ$i"} eq '---'))
+                {
                     $curr_format = "%8s";
                 }
-                elsif (($fields[$field_idx] eq 'P_ACQ')
-                           and ($c->{"P_ACQ$i"} < .50)){
+                elsif ( ($fields[$field_idx] eq 'P_ACQ')
+                    and ($c->{"P_ACQ$i"} < .50))
+                {
                     $field_color = 'red';
                 }
-                elsif (($fields[$field_idx] eq 'P_ACQ')
-                        and ($c->{"P_ACQ$i"} < .75)){
+                elsif ( ($fields[$field_idx] eq 'P_ACQ')
+                    and ($c->{"P_ACQ$i"} < .75))
+                {
                     $field_color = 'yellow';
                 }
 
                 # For MAG fields, if the P_ACQ probability is defined and has a color,
-                # share that color.  Otherwise, if the MAG violates the yellow/red warning
+              # share that color.  Otherwise, if the MAG violates the yellow/red warning
                 # limit, colorize.
-                if ($fields[$field_idx] eq 'GS_MAG'){
-                    if (($c->{"P_ACQ$i"} ne '---') and ($c->{"P_ACQ$i"} < .50)){
+                if ($fields[$field_idx] eq 'GS_MAG') {
+                    if (($c->{"P_ACQ$i"} ne '---') and ($c->{"P_ACQ$i"} < .50)) {
                         $field_color = 'red';
                     }
-                    elsif (($c->{"P_ACQ$i"} ne '---') and ($c->{"P_ACQ$i"} < .75)){
+                    elsif (($c->{"P_ACQ$i"} ne '---') and ($c->{"P_ACQ$i"} < .75)) {
                         $field_color = 'yellow';
                     }
-                    elsif (($c->{"P_ACQ$i"} eq '---') and ($c->{"GS_MAG$i"} ne '---')
-                               and ($c->{"GS_MAG$i"} > $self->{mag_faint_red})){
+                    elsif ( ($c->{"P_ACQ$i"} eq '---')
+                        and ($c->{"GS_MAG$i"} ne '---')
+                        and ($c->{"GS_MAG$i"} > $self->{mag_faint_red}))
+                    {
                         $field_color = 'red';
                     }
-                    elsif (($c->{"P_ACQ$i"} eq '---') and ($c->{"GS_MAG$i"} ne '---')
-                               and ($c->{"GS_MAG$i"} > $self->{mag_faint_yellow})){
+                    elsif ( ($c->{"P_ACQ$i"} eq '---')
+                        and ($c->{"GS_MAG$i"} ne '---')
+                        and ($c->{"GS_MAG$i"} > $self->{mag_faint_yellow}))
+                    {
                         $field_color = 'yellow';
                     }
                 }
 
                 # Use colors if required
-                if ($field_color eq 'red'){
+                if ($field_color eq 'red') {
                     $curr_format = $red_font_start . $curr_format . $font_stop;
                 }
-                if ($field_color eq 'yellow'){
+                if ($field_color eq 'yellow') {
                     $curr_format = $yellow_font_start . $curr_format . $font_stop;
                 }
                 $table .= sprintf($curr_format, $c->{"$fields[$field_idx]$i"});
 
-
-	    }
-	    $table.= $font_stop if ($color);
-	    $table.= sprintf "\n";
-	}
-
+            }
+            $table .= $font_stop if ($color);
+            $table .= sprintf "\n";
+        }
 
     }
-    else{
+    else {
         $table = sprintf(" " x 93 . "\n");
     }
 
     $o .= $table;
 
-    $o .= "\n" if (@{$self->{warn}} || @{$self->{yellow_warn}} || @{$self->{fyi}} || @{$self->{orange_warn}});
+    $o .= "\n"
+      if ( @{ $self->{warn} }
+        || @{ $self->{yellow_warn} }
+        || @{ $self->{fyi} }
+        || @{ $self->{orange_warn} });
 
-
-
-    if (@{$self->{warn}}) {
-	$o .= "${red_font_start}";
-	foreach (sort(@{$self->{warn}})) {
-	    $o .= ">> CRITICAL: " . $_;
-	}
-	$o .= "${font_stop}";
+    if (@{ $self->{warn} }) {
+        $o .= "${red_font_start}";
+        foreach (sort(@{ $self->{warn} })) {
+            $o .= ">> CRITICAL: " . $_;
+        }
+        $o .= "${font_stop}";
     }
-    if (@{$self->{orange_warn}}) {
-	$o .= "${orange_font_start}";
-	foreach (sort(@{$self->{orange_warn}})) {
-	    $o .= ">> WARNING : " . $_;
-	}
-	$o .= "${font_stop}";
+    if (@{ $self->{orange_warn} }) {
+        $o .= "${orange_font_start}";
+        foreach (sort(@{ $self->{orange_warn} })) {
+            $o .= ">> WARNING : " . $_;
+        }
+        $o .= "${font_stop}";
     }
-    if (@{$self->{yellow_warn}}) {
-	$o .= "${yellow_font_start}";
-	foreach (sort(@{$self->{yellow_warn}})) {
-	    $o .= ">> CAUTION : " . $_;
-	}
-	$o .= "${font_stop}";
+    if (@{ $self->{yellow_warn} }) {
+        $o .= "${yellow_font_start}";
+        foreach (sort(@{ $self->{yellow_warn} })) {
+            $o .= ">> CAUTION : " . $_;
+        }
+        $o .= "${font_stop}";
     }
-    if (@{$self->{fyi}}) {
-	$o .= "${blue_font_start}";
-	foreach (sort(@{$self->{fyi}})) {
-	    $o .= ">> INFO    : " . $_;
-	}
-	$o .= "${font_stop}";
+    if (@{ $self->{fyi} }) {
+        $o .= "${blue_font_start}";
+        foreach (sort(@{ $self->{fyi} })) {
+            $o .= ">> INFO    : " . $_;
+        }
+        $o .= "${font_stop}";
     }
     $o .= "\n";
 
     # Don't print probability info, temperature, dynamic limits if there is no catalog
-    if ($c = find_command($self, "MP_STARCAT")){
-	if (exists $self->{figure_of_merit}) {
-	    my $bad_FOM = $self->{figure_of_merit}->{cum_prob_bad};
-	    $o .= "$red_font_start" if $bad_FOM;
-	    $o .= "Probability of acquiring 2 or fewer stars (10^-x):\t";
-	    $o .= sprintf("%.1f", $self->{figure_of_merit}->{P2}) . "\t";
-	    $o .= "$font_stop" if $bad_FOM;
-	    $o .= "\n";
-	    $o .= sprintf("Acquisition Stars Expected  : %.2f\n", $self->{figure_of_merit}->{expected});
-	    $o .= sprintf("Guide star count: %.1f \t", $self->{figure_of_merit}->{guide_count});
-	    if (defined $self->{figure_of_merit}->{guide_count_9th}){
-		$o .= sprintf("Guide count_9th: %.1f", $self->{figure_of_merit}->{guide_count_9th});
-	    }
-	    $o .= "\n";
-	}
+    if ($c = find_command($self, "MP_STARCAT")) {
+        if (exists $self->{figure_of_merit}) {
+            my $bad_FOM = $self->{figure_of_merit}->{cum_prob_bad};
+            $o .= "$red_font_start" if $bad_FOM;
+            $o .= "Probability of acquiring 2 or fewer stars (10^-x):\t";
+            $o .= sprintf("%.1f", $self->{figure_of_merit}->{P2}) . "\t";
+            $o .= "$font_stop" if $bad_FOM;
+            $o .= "\n";
+            $o .= sprintf("Acquisition Stars Expected  : %.2f\n",
+                $self->{figure_of_merit}->{expected});
+            $o .= sprintf("Guide star count: %.1f \t",
+                $self->{figure_of_merit}->{guide_count});
+
+            if (defined $self->{figure_of_merit}->{guide_count_9th}) {
+                $o .= sprintf("Guide count_9th: %.1f",
+                    $self->{figure_of_merit}->{guide_count_9th});
+            }
+            $o .= "\n";
+        }
 
         $o .= sprintf("Predicted Max CCD temperature: %.1f C ", $self->{ccd_temp});
-        if (defined $self->{n100_warm_frac}){
+        if (defined $self->{n100_warm_frac}) {
             $o .= sprintf("\t N100 Warm Pix Frac %.3f", $self->{n100_warm_frac});
         }
         $o .= "\n";
-        $o .= sprintf("Dynamic Mag Limits: Yellow %.2f \t Red %.2f\n",
-                      $self->{mag_faint_yellow}, $self->{mag_faint_red});
+        $o .= sprintf(
+            "Dynamic Mag Limits: Yellow %.2f \t Red %.2f\n",
+            $self->{mag_faint_yellow},
+            $self->{mag_faint_red}
+        );
     }
 
     # cute little table for buttons for previous and next obsid
     $o .= "
    		\n";
-    if (defined $self->{prev}->{obsid} or defined $self->{next}->{obsid}){
-	$o .= " ";
-	if (defined $self->{prev}->{obsid}){
-	    $o .= sprintf("",
-			  $self->{prev}->{obsid},
-			  $self->{STARCHECK} );
-	    $o .= sprintf("", $self->{prev}->{obsid});
-	}
-	else{
-	    $o .= sprintf("",
-			  $self->{STARCHECK} );
-	    $o .= sprintf("");
-	}
-	$o .= sprintf("");
-	if (defined $self->{next}->{obsid}){
-	    $o .= sprintf("",
-			  $self->{next}->{obsid},
-			  $self->{STARCHECK} );
-	    $o .= sprintf("", $self->{next}->{obsid});
-	}
-	$o .= " 
    PREV PREV   NEXT 
    ";
+    if (defined $self->{prev}->{obsid} or defined $self->{next}->{obsid}) {
+        $o .= " ";
+        if (defined $self->{prev}->{obsid}) {
+            $o .= sprintf(
+"",
+                $self->{prev}->{obsid},
+                $self->{STARCHECK}
+            );
+            $o .= sprintf("",
+                $self->{prev}->{obsid});
+        }
+        else {
+            $o .= sprintf("",
+                $self->{STARCHECK});
+            $o .= sprintf("");
+        }
+        $o .= sprintf("");
+        if (defined $self->{next}->{obsid}) {
+            $o .= sprintf(
+"",
+                $self->{next}->{obsid},
+                $self->{STARCHECK}
+            );
+            $o .= sprintf("",
+                $self->{next}->{obsid});
+        }
+        $o .= " 
    PREV PREV   NEXT 
    ";
 
     }
 
     # end of whole obsid table
     $o .= " 
    ";
 
-
-
     return $o;
 }
 
 #############################################################################################
 sub add_guide_summ {
 #############################################################################################
-# Receives $obsid and a reference to the guide star summary hash
-# parses the relevant info from the guide star summary and sticks it into
-# the obsid object where it belongs
+    # Receives $obsid and a reference to the guide star summary hash
+    # parses the relevant info from the guide star summary and sticks it into
+    # the obsid object where it belongs
     my $self = shift;
     my ($obsid, $guide_ref) = @_;
     my $c;
@@ -2160,41 +2487,44 @@ sub add_guide_summ {
     my $bad_idx_match = 0;
 
     # For each idx of the star catalog (starts at 1)
-    for my $j (1 .. (1 + $#{ $guide_ref->{$obsid}{info}}) ) {
-
-	@f = split ' ', $guide_ref->{$obsid}{info}[$j-1];
-
-	if (abs( $f[5]*$r2a - $c->{"YANG$j"}) < 10
-	    && abs( $f[6]*$r2a - $c->{"ZANG$j"}) < 10)	{
-	    $c->{"GS_TYPE$j"} = $f[0];
-	    $c->{"GS_ID$j"} = $f[1];
-	    $c->{"GS_RA$j"} = $f[2];
-	    $c->{"GS_DEC$j"} = $f[3];
-	    if ($f[4] eq '---'){
-		$c->{"GS_MAG$j"} = $f[4];
-	    }
-	    else{
-		$c->{"GS_MAG$j"} = sprintf "%8.3f", $f[4];
-	    }
-	    $c->{"GS_YANG$j"} = $f[5] * $r2a;
-	    $c->{"GS_ZANG$j"} = $f[6] * $r2a;
-	    # Parse the SAUSAGE star selection pass number
-	    $c->{"GS_PASS$j"} = defined $f[7] ? ($f[7] =~ /\*+/ ? length $f[7] : $f[7]) : ' ';
-	    $c->{"GS_PASS$j"} =~ s/[agf]1//g;
-	}
-	else {
-	    # if the position of the line item in the guide summary doesn't match
-	    # set the variable once (so we don't have a warning for all the remaining lines
-	    # if there is one missing...)
-	    $bad_idx_match = 1;
-	}
-
-    }
-
-    # if the position of an item didn't match, warn that the guide summary does not match
+    for my $j (1 .. (1 + $#{ $guide_ref->{$obsid}{info} })) {
+
+        @f = split ' ', $guide_ref->{$obsid}{info}[ $j - 1 ];
+
+        if (   abs($f[5] * $r2a - $c->{"YANG$j"}) < 10
+            && abs($f[6] * $r2a - $c->{"ZANG$j"}) < 10)
+        {
+            $c->{"GS_TYPE$j"} = $f[0];
+            $c->{"GS_ID$j"} = $f[1];
+            $c->{"GS_RA$j"} = $f[2];
+            $c->{"GS_DEC$j"} = $f[3];
+            if ($f[4] eq '---') {
+                $c->{"GS_MAG$j"} = $f[4];
+            }
+            else {
+                $c->{"GS_MAG$j"} = sprintf "%8.3f", $f[4];
+            }
+            $c->{"GS_YANG$j"} = $f[5] * $r2a;
+            $c->{"GS_ZANG$j"} = $f[6] * $r2a;
+
+            # Parse the SAUSAGE star selection pass number
+            $c->{"GS_PASS$j"} =
+              defined $f[7] ? ($f[7] =~ /\*+/ ? length $f[7] : $f[7]) : ' ';
+            $c->{"GS_PASS$j"} =~ s/[agf]1//g;
+        }
+        else {
+            # if the position of the line item in the guide summary doesn't match
+         # set the variable once (so we don't have a warning for all the remaining lines
+            # if there is one missing...)
+            $bad_idx_match = 1;
+        }
+
+    }
+
+   # if the position of an item didn't match, warn that the guide summary does not match
     # the backstop commanded catalog
-    if ($bad_idx_match == 1){
-	push @{$self->{warn}}, "Guide summary does not match commanded catalog.\n";
+    if ($bad_idx_match == 1) {
+        push @{ $self->{warn} }, "Guide summary does not match commanded catalog.\n";
     }
 }
 
@@ -2208,17 +2538,18 @@ sub get_agasc_stars {
     return unless ($c = find_command($self, "MP_TARGQUAT"));
 
     # Use Python agasc to fetch the stars into a hash
-    $self->{agasc_hash} = call_python(
-        "utils._get_agasc_stars",
-        [$self->{ra}, $self->{dec}, $self->{roll}, 1.3, $self->{date}, $agasc_file]
-    );
+    $self->{agasc_hash} = call_python("utils._get_agasc_stars",
+        [ $self->{ra}, $self->{dec}, $self->{roll}, 1.3, $self->{date}, $agasc_file ]);
 
-    foreach my $star (values %{$self->{agasc_hash}}) {
-	if ($star->{'mag_aca'} < -10 or $star->{'mag_aca_err'} < -10) {
-	    push @{$self->{warn}}, sprintf(
+    foreach my $star (values %{ $self->{agasc_hash} }) {
+        if ($star->{'mag_aca'} < -10 or $star->{'mag_aca_err'} < -10) {
+            push @{ $self->{warn} },
+              sprintf(
                 "Star with bad mag %.1f or magerr %.1f at (yag,zag)=%.1f,%.1f\n",
-                $star->{'mag_aca'}, $star->{'mag_aca_err'}, $star->{'yag'}, $star->{'zag'});
-	}
+                $star->{'mag_aca'}, $star->{'mag_aca_err'},
+                $star->{'yag'}, $star->{'zag'}
+              );
+        }
     }
 
 }
@@ -2230,100 +2561,114 @@ sub identify_stars {
 
     return unless (my $c = find_command($self, 'MP_STARCAT'));
 
-    my $manvr = find_command($self, "MP_TARGQUAT" );
+    my $manvr = find_command($self, "MP_TARGQUAT");
 
     my $obs_time = $c->{time};
 
     for my $i (1 .. 16) {
-	my $type = $c->{"TYPE$i"};
-	next if ($type eq 'NUL');
-	next if ($type eq 'FID');
+        my $type = $c->{"TYPE$i"};
+        next if ($type eq 'NUL');
+        next if ($type eq 'FID');
+
+        my $yag = $c->{"YANG$i"};
+        my $zag = $c->{"ZANG$i"};
+        my $gs_id = $c->{"GS_ID$i"};
+        my $gs_ra = $c->{"GS_RA$i"};
+        my $gs_dec = $c->{"GS_DEC$i"};
+
+        # strip * off gs_id if present
+        $gs_id =~ s/^\*/^/;
+
+     # if the star is defined in the guide summary but doesn't seem to be present in the
+        # agasc hash for this ra and dec, throw a warning
+        unless ((defined $self->{agasc_hash}{$gs_id}) or ($gs_id eq '---')) {
+            push @{ $self->{warn} },
+              sprintf(
+                "[%2d] Star $gs_id is not in retrieved AGASC region by RA and DEC! \n",
+                $i);
+        }
 
-	my $yag = $c->{"YANG$i"};
-	my $zag = $c->{"ZANG$i"};
-	my $gs_id = $c->{"GS_ID$i"};
-	my $gs_ra = $c->{"GS_RA$i"};
-	my $gs_dec = $c->{"GS_DEC$i"};
+        # if the star is defined in the agasc hash, copy
+        # the information from the agasc to the catalog
 
-	# strip * off gs_id if present
-	$gs_id =~ s/^\*/^/;
+        if (defined $self->{agasc_hash}{$gs_id}) {
+            my $star = $self->{agasc_hash}{$gs_id};
 
-	# if the star is defined in the guide summary but doesn't seem to be present in the
-	# agasc hash for this ra and dec, throw a warning
-	unless ((defined $self->{agasc_hash}{$gs_id}) or ($gs_id eq '---')){
-	    push @{$self->{warn}},
-	          sprintf("[%2d] Star $gs_id is not in retrieved AGASC region by RA and DEC! \n", $i);
-	}
+            # Confirm that the agasc magnitude matches the guide star summary magnitude
+            my $gs_mag = $c->{"GS_MAG$i"};
+            my $dmag = abs($star->{mag_aca} - $gs_mag);
+            if ($dmag > 0.01) {
+                push @{ $self->{yellow_warn} },
+                  sprintf("[%d] Guide sum mag diff from agasc mag %9.5f\n", $i, $dmag);
+            }
 
+            # let's still confirm that the backstop yag zag is what we expect
+            # from agasc and ra,dec,roll ACA-043
+
+            if (   abs($star->{yag} - $yag) > ($ID_DIST_LIMIT)
+                || abs($star->{zag} - $zag) > ($ID_DIST_LIMIT))
+            {
+                my $dyag = abs($star->{yag} - $yag);
+                my $dzag = abs($star->{zag} - $zag);
+
+                if (   abs($star->{yag} - $yag) > (2 * $ID_DIST_LIMIT)
+                    || abs($star->{zag} - $zag) > (2 * $ID_DIST_LIMIT))
+                {
+                    push @{ $self->{warn} },
+                      sprintf(
+"[%2d] Backstop YAG,ZAG differs from AGASC by > 3 arcsec: dyag = %2.2f dzag = %2.2f \n",
+                        $i,
+                        $dyag,
+                        $dzag
+                      );
+                }
+                else {
+                    push @{ $self->{yellow_warn} },
+                      sprintf(
+"[%2d] Backstop YAG,ZAG differs from AGASC by > 1.5 arcsec: dyag = %2.2f dzag = %2.2f \n",
+                        $i,
+                        $dyag,
+                        $dzag
+                      );
+                }
+            }
 
-	# if the star is defined in the agasc hash, copy
-	# the information from the agasc to the catalog
+            # should I put this in an else statement, or let it stand alone?
 
-	if (defined $self->{agasc_hash}{$gs_id}){
-	    my $star = $self->{agasc_hash}{$gs_id};
+            $c->{"GS_IDENTIFIED$i"} = 1;
+            $c->{"GS_BV$i"} = $star->{bv};
+            $c->{"GS_MAGERR$i"} = $star->{mag_aca_err};
+            $c->{"GS_POSERR$i"} = $star->{poserr};
+            $c->{"GS_CLASS$i"} = $star->{class};
+            $c->{"GS_ASPQ$i"} = $star->{aspq};
+            my $db_hist = star_dbhist("$gs_id", $obs_time);
+            $c->{"GS_USEDBEFORE$i"} = $db_hist;
 
-            # Confirm that the agasc magnitude matches the guide star summary magnitude
-            my $gs_mag = $c->{"GS_MAG$i"};
-            my $dmag = abs($star->{mag_aca} - $gs_mag);
-            if ($dmag > 0.01){
-                push @{$self->{yellow_warn}},
-                    sprintf("[%d] Guide sum mag diff from agasc mag %9.5f\n", $i, $dmag);
+        }
+        else {
+            # This loop should just get the $gs_id eq '---' cases
+            foreach my $star (values %{ $self->{agasc_hash} }) {
+                if (   abs($star->{yag} - $yag) < $ID_DIST_LIMIT
+                    && abs($star->{zag} - $zag) < $ID_DIST_LIMIT)
+                {
+                    $c->{"GS_IDENTIFIED$i"} = 1;
+                    $c->{"GS_BV$i"} = $star->{bv};
+                    $c->{"GS_MAGERR$i"} = $star->{mag_aca_err};
+                    $c->{"GS_POSERR$i"} = $star->{poserr};
+                    $c->{"GS_CLASS$i"} = $star->{class};
+                    $c->{"GS_ASPQ$i"} = $star->{aspq};
+                    $c->{"GS_ID$i"} = "*$star->{id}";
+                    $c->{"GS_RA$i"} = $star->{ra};
+                    $c->{"GS_DEC$i"} = $star->{dec};
+                    $c->{"GS_MAG$i"} = sprintf "%8.3f", $star->{mag_aca};
+                    $c->{"GS_YANG$i"} = $star->{yag};
+                    $c->{"GS_ZANG$i"} = $star->{zag};
+                    $c->{"GS_USEDBEFORE$i"} = star_dbhist($star->{id}, $obs_time);
+                    last;
+                }
             }
-	    # let's still confirm that the backstop yag zag is what we expect
-	    # from agasc and ra,dec,roll ACA-043
-
-	    if (abs($star->{yag} - $yag) > ($ID_DIST_LIMIT)
-		|| abs($star->{zag} - $zag) > ($ID_DIST_LIMIT)){
-		my $dyag = abs($star->{yag} - $yag);
-		my $dzag = abs($star->{zag} - $zag);
-
-		if (abs($star->{yag} - $yag) > (2 * $ID_DIST_LIMIT) ||
-		    abs($star->{zag} - $zag) > (2 * $ID_DIST_LIMIT)){
-		    push @{$self->{warn}},
-		         sprintf("[%2d] Backstop YAG,ZAG differs from AGASC by > 3 arcsec: dyag = %2.2f dzag = %2.2f \n", $i, $dyag, $dzag);
-		}
-		else{
-		    push @{$self->{yellow_warn}},
-		         sprintf("[%2d] Backstop YAG,ZAG differs from AGASC by > 1.5 arcsec: dyag = %2.2f dzag = %2.2f \n", $i, $dyag, $dzag);
-		}
-	    }
-
-	    # should I put this in an else statement, or let it stand alone?
-
-	    $c->{"GS_IDENTIFIED$i"} = 1;
-	    $c->{"GS_BV$i"} = $star->{bv};
-	    $c->{"GS_MAGERR$i"} = $star->{mag_aca_err};
-	    $c->{"GS_POSERR$i"} = $star->{poserr};
-	    $c->{"GS_CLASS$i"} = $star->{class};
-	    $c->{"GS_ASPQ$i"} = $star->{aspq};
-	    my $db_hist = star_dbhist( "$gs_id", $obs_time );
-	    $c->{"GS_USEDBEFORE$i"} =  $db_hist;
-
-	}
-	else{
-	    # This loop should just get the $gs_id eq '---' cases
-	    foreach my $star (values %{$self->{agasc_hash}}) {
-		if (abs($star->{yag} - $yag) < $ID_DIST_LIMIT
-		    && abs($star->{zag} - $zag) < $ID_DIST_LIMIT) {
-		    $c->{"GS_IDENTIFIED$i"} = 1;
-		    $c->{"GS_BV$i"} = $star->{bv};
-		    $c->{"GS_MAGERR$i"} = $star->{mag_aca_err};
-		    $c->{"GS_POSERR$i"} = $star->{poserr};
-		    $c->{"GS_CLASS$i"} = $star->{class};
-		    $c->{"GS_ASPQ$i"} = $star->{aspq};
-		    $c->{"GS_ID$i"} = "*$star->{id}";
-		    $c->{"GS_RA$i"} = $star->{ra};
-		    $c->{"GS_DEC$i"} = $star->{dec};
-		    $c->{"GS_MAG$i"} = sprintf "%8.3f", $star->{mag_aca};
-		    $c->{"GS_YANG$i"} = $star->{yag};
-		    $c->{"GS_ZANG$i"} = $star->{zag};
-		    $c->{"GS_USEDBEFORE$i"} =  star_dbhist( $star->{id}, $obs_time );
-		    last;
-		}
-	    }
-
-
-	}
+
+        }
     }
 }
 
@@ -2336,90 +2681,97 @@ sub star_dbhist {
 
     my $obs_tstart_minus_day = $obs_tstart - 86400;
 
-    return call_python("utils.get_mica_star_stats", [$star_id, $obs_tstart_minus_day]);
+    return call_python("utils.get_mica_star_stats",
+        [ $star_id, $obs_tstart_minus_day ]);
 
 }
 
 #############################################################################################
 sub star_image_map {
 #############################################################################################
-	my $self = shift;
-	my $c;
+    my $self = shift;
+    my $c;
     return unless ($c = find_command($self, 'MP_STARCAT'));
-    return unless ((defined $self->{ra}) and (defined $self->{dec}) and (defined $self->{roll}));
+    return
+      unless ((defined $self->{ra})
+        and (defined $self->{dec})
+        and (defined $self->{roll}));
     my $obsid = $self->{obsid};
 
-	# a hash of the agasc ids we want to plot
-	my %plot_ids;
-	# first the catalog ones
-	for my $i (1 .. 16){
-		next if ($c->{"TYPE$i"} eq 'NUL');
-		next if ($c->{"TYPE$i"} eq 'FID');
-		if (defined $self->{agasc_hash}->{$c->{"GS_ID${i}"}}){
-			$plot_ids{$c->{"GS_ID${i}"}} = 1;
-		}
-	}
-	# then up to 100 of the stars in the field brighter than
-	# the faint plot limit
-	my $star_count_limit = 100;
-	my $star_count = 0;
-    foreach my $star (values %{$self->{agasc_hash}}) {
-		next if ($star->{mag_aca} > $faint_plot_mag);
-		$plot_ids{$star->{id}} = 1;
-		last if $star_count > $star_count_limit;
-		$star_count++;
-	}
-
-	# notes for pixel scaling.
-	# these will need to change if we resize the images.
-        # top right +384+39
-        # top left +54+39
-	# 2900x2900
-	my $pix_scale = 330 / (2900. * 2);
+    # a hash of the agasc ids we want to plot
+    my %plot_ids;
+
+    # first the catalog ones
+    for my $i (1 .. 16) {
+        next if ($c->{"TYPE$i"} eq 'NUL');
+        next if ($c->{"TYPE$i"} eq 'FID');
+        if (defined $self->{agasc_hash}->{ $c->{"GS_ID${i}"} }) {
+            $plot_ids{ $c->{"GS_ID${i}"} } = 1;
+        }
+    }
+
+    # then up to 100 of the stars in the field brighter than
+    # the faint plot limit
+    my $star_count_limit = 100;
+    my $star_count = 0;
+    foreach my $star (values %{ $self->{agasc_hash} }) {
+        next if ($star->{mag_aca} > $faint_plot_mag);
+        $plot_ids{ $star->{id} } = 1;
+        last if $star_count > $star_count_limit;
+        $star_count++;
+    }
+
+    # notes for pixel scaling.
+    # these will need to change if we resize the images.
+    # top right +384+39
+    # top left +54+39
+    # 2900x2900
+    my $pix_scale = 330 / (2900. * 2);
 
     # Convert all the yag/zags to pixel rows/cols
     my @yags = map { $self->{agasc_hash}->{$_}->{yag} } keys %plot_ids;
     my @zags = map { $self->{agasc_hash}->{$_}->{zag} } keys %plot_ids;
-    my ($pix_rows, $pix_cols) = @{call_python("utils._yagzag_to_pixels", [\@yags, \@zags])};
+    my ($pix_rows, $pix_cols) =
+      @{ call_python("utils._yagzag_to_pixels", [ \@yags, \@zags ]) };
 
-	my $map = " \n";
+    my $map = " \n";
     my @star_ids = keys %plot_ids;
     for my $idx (0 .. $#star_ids) {
         my $star_id = $star_ids[$idx];
         my $pix_row = $pix_rows->[$idx];
         my $pix_col = $pix_cols->[$idx];
-		my $cat_star = $self->{agasc_hash}->{$star_id};
-		my $sid = $cat_star->{id};
-		my $yag = $cat_star->{yag};
-		my $zag = $cat_star->{zag};
-		my $image_x = 54 + ((2900 - $yag) * $pix_scale);
-		my $image_y = 39 + ((2900 - $zag) * $pix_scale);
-		my $star = '"
-			. sprintf("yag,zag=%.2f,%.2f 
    ", $yag, $zag)
-			. sprintf("row,col=%.2f,%.2f 
    ", $pix_row,$pix_col)
-			. sprintf("mag_aca=%.2f 
    ", $cat_star->{mag_aca})
-			. sprintf("mag_aca_err=%.2f 
    ", $cat_star->{mag_aca_err} / 100.0)
-			. sprintf("class=%s 
    ", $cat_star->{class})
-			. sprintf("color=%.3f 
    ", $cat_star->{bv})
-			. sprintf("aspq1=%.1f 
    ", $cat_star->{aspq})
-			. '\', WIDTH, 220);"' . "\n"
-			. 'ONMOUSEOUT="return nd();"' . "\n"
-			. 'SHAPE="circle"' . "\n"
-			. 'ALT=""' . "\n"
-			. "COORDS=\"$image_x,$image_y,2\">" . "\n";
-		$map .= $star;
-	}
-	$map .= "     \n";
-	return $map;
+        my $cat_star = $self->{agasc_hash}->{$star_id};
+        my $sid = $cat_star->{id};
+        my $yag = $cat_star->{yag};
+        my $zag = $cat_star->{zag};
+        my $image_x = 54 + ((2900 - $yag) * $pix_scale);
+        my $image_y = 39 + ((2900 - $zag) * $pix_scale);
+        my $star =
+            '"
+          . sprintf("yag,zag=%.2f,%.2f 
    ", $yag, $zag)
+          . sprintf("row,col=%.2f,%.2f 
    ", $pix_row, $pix_col)
+          . sprintf("mag_aca=%.2f 
    ", $cat_star->{mag_aca})
+          . sprintf("mag_aca_err=%.2f 
    ", $cat_star->{mag_aca_err} / 100.0)
+          . sprintf("class=%s 
    ", $cat_star->{class})
+          . sprintf("color=%.3f 
    ", $cat_star->{bv})
+          . sprintf("aspq1=%.1f 
    ", $cat_star->{aspq})
+          . '\', WIDTH, 220);"' . "\n"
+          . 'ONMOUSEOUT="return nd();"' . "\n"
+          . 'SHAPE="circle"' . "\n"
+          . 'ALT=""' . "\n"
+          . "COORDS=\"$image_x,$image_y,2\">" . "\n";
+        $map .= $star;
+    }
+    $map .= "     \n";
+    return $map;
 }
 
-
 #############################################################################################
 sub quat2radecroll {
 #############################################################################################
-    my $r2d = 180./3.14159265;
+    my $r2d = 180. / 3.14159265;
 
     my ($q1, $q2, $q3, $q4) = @_;
 
@@ -2434,8 +2786,8 @@ sub quat2radecroll {
     my $yn = 2 * ($q2 * $q3 + $q1 * $q4);
     my $zn = $q32 + $q42 - $q12 - $q22;
 
-    my $ra   = atan2($xb, $xa) * $r2d;
-    my $dec  = atan2($xn, sqrt(1 - $xn**2)) * $r2d;
+    my $ra = atan2($xb, $xa) * $r2d;
+    my $dec = atan2($xn, sqrt(1 - $xn**2)) * $r2d;
     my $roll = atan2($yn, $zn) * $r2d;
     $ra += 360 if ($ra < 0);
     $roll += 360 if ($roll < 0);
@@ -2444,15 +2796,15 @@ sub quat2radecroll {
 }
 
 ###################################################################################
-sub check_guide_count{
+sub check_guide_count {
 ###################################################################################
     my $self = shift;
     my $guide_count = $self->count_guide_stars();
 
-    my $min_num_gui = ($self->{obsid} >= 38000 ) ? 6.0 : 4.0;
+    my $min_num_gui = ($self->{obsid} >= 38000) ? 6.0 : 4.0;
 
-    if ($guide_count < $min_num_gui){
-        push @{$self->{warn}}, "Guide count of $guide_count < $min_num_gui.\n";
+    if ($guide_count < $min_num_gui) {
+        push @{ $self->{warn} }, "Guide count of $guide_count < $min_num_gui.\n";
     }
 
     # Also save the guide count in the figure_of_merit
@@ -2460,98 +2812,110 @@ sub check_guide_count{
 }
 
 ###################################################################################
-sub count_guide_stars{
+sub count_guide_stars {
 ###################################################################################
-    my $self=shift;
+    my $self = shift;
     my $c;
 
     return 0.0 unless ($c = find_command($self, 'MP_STARCAT'));
     my @mags = ();
-    for my $i (1 .. 16){
-	if ($c->{"TYPE$i"} =~ /GUI|BOT/){
+    for my $i (1 .. 16) {
+        if ($c->{"TYPE$i"} =~ /GUI|BOT/) {
             my $mag = $c->{"GS_MAG$i"};
             push @mags, $mag;
-	}
+        }
     }
-    return sprintf("%.1f", call_python("utils._guide_count", [\@mags, $self->{ccd_temp}]));
+    return
+      sprintf("%.1f", call_python("utils._guide_count", [ \@mags, $self->{ccd_temp} ]));
 }
 
-
 ###################################################################################
-sub set_ccd_temps{
+sub set_ccd_temps {
 ###################################################################################
     my $self = shift;
     my $obsid_temps = shift;
+
     # if no temperature data, just return
-    if ((not defined $obsid_temps->{$self->{obsid}})
-        or (not defined $obsid_temps->{$self->{obsid}}->{ccd_temp})){
-        push @{$self->{warn}}, "No CCD temperature prediction for obsid\n";
-        push @{$self->{warn}}, sprintf("Using %s (planning limit) for t_ccd for mag limits\n",
-                                       $config{ccd_temp_red_limit});
+    if (   (not defined $obsid_temps->{ $self->{obsid} })
+        or (not defined $obsid_temps->{ $self->{obsid} }->{ccd_temp}))
+    {
+        push @{ $self->{warn} }, "No CCD temperature prediction for obsid\n";
+        push @{ $self->{warn} },
+          sprintf("Using %s (planning limit) for t_ccd for mag limits\n",
+            $config{ccd_temp_red_limit});
         $self->{ccd_temp} = $config{ccd_temp_red_limit};
         $self->{ccd_temp_acq} = $config{ccd_temp_red_limit};
         return;
     }
+
     # set the temperature to the value for the current obsid
-    $self->{ccd_temp} = $obsid_temps->{$self->{obsid}}->{ccd_temp};
-    $self->{ccd_temp_min} = $obsid_temps->{$self->{obsid}}->{ccd_temp_min};
-    $self->{ccd_temp_acq} = $obsid_temps->{$self->{obsid}}->{ccd_temp_acq};
-    $self->{n100_warm_frac} = $obsid_temps->{$self->{obsid}}->{n100_warm_frac};
+    $self->{ccd_temp} = $obsid_temps->{ $self->{obsid} }->{ccd_temp};
+    $self->{ccd_temp_min} = $obsid_temps->{ $self->{obsid} }->{ccd_temp_min};
+    $self->{ccd_temp_acq} = $obsid_temps->{ $self->{obsid} }->{ccd_temp_acq};
+    $self->{n100_warm_frac} = $obsid_temps->{ $self->{obsid} }->{n100_warm_frac};
+
     # Add info statement for limit violations
-    if ($self->{ccd_temp} > $config{ccd_temp_red_limit}){
-        push @{$self->{fyi}}, sprintf("CCD temperature exceeds %.1f C\n",
-                                       $config{ccd_temp_red_limit});
+    if ($self->{ccd_temp} > $config{ccd_temp_red_limit}) {
+        push @{ $self->{fyi} },
+          sprintf("CCD temperature exceeds %.1f C\n", $config{ccd_temp_red_limit});
     }
+
     # Add CRITICAL if OR and too cold as fid lights may be out of boxes
-    if (($self->{obsid} < 38000) and ($self->{ccd_temp_min} < -14.0)){
-	push @{$self->{warn}}, sprintf(
-	    "OR with min(t_ccd) %.1f < -14. Fid lights may not be tracked\n",
-	    $self->{ccd_temp_min});
+    if (($self->{obsid} < 38000) and ($self->{ccd_temp_min} < -14.0)) {
+        push @{ $self->{warn} },
+          sprintf("OR with min(t_ccd) %.1f < -14. Fid lights may not be tracked\n",
+            $self->{ccd_temp_min});
     }
+
     # Add info for having a penalty temperature too
-    if ($self->{ccd_temp} > $config{ccd_temp_yellow_limit}){
-        push @{$self->{fyi}}, sprintf("Effective guide temperature %.1f C\n",
-                                      call_python("utils.get_effective_t_ccd",
-                                      [$self->{ccd_temp}]));
+    if ($self->{ccd_temp} > $config{ccd_temp_yellow_limit}) {
+        push @{ $self->{fyi} },
+          sprintf("Effective guide temperature %.1f C\n",
+            call_python("utils.get_effective_t_ccd", [ $self->{ccd_temp} ]));
 
     }
-    if ($self->{ccd_temp_acq} > $config{ccd_temp_yellow_limit}){
-        push @{$self->{fyi}}, sprintf("Effective acq temperature %.1f C\n",
-                                      call_python("utils.get_effective_t_ccd",
-                                      [$self->{ccd_temp_acq}]));
+    if ($self->{ccd_temp_acq} > $config{ccd_temp_yellow_limit}) {
+        push @{ $self->{fyi} },
+          sprintf("Effective acq temperature %.1f C\n",
+            call_python("utils.get_effective_t_ccd", [ $self->{ccd_temp_acq} ]));
 
     }
-    # Clip the acq ccd temperature to the calibrated range of the grid acq probability model
+
+# Clip the acq ccd temperature to the calibrated range of the grid acq probability model
     # and add a yellow warning to let the user know this has happened.
-    if (($self->{ccd_temp_acq} > -1.0) or ($self->{ccd_temp_acq} < -16.0)){
-        push @{$self->{yellow_warn}}, sprintf(
-            "acq t_ccd %.1f outside range -16.0 to -1.0. Clipped.\n",
+    if (($self->{ccd_temp_acq} > -1.0) or ($self->{ccd_temp_acq} < -16.0)) {
+        push @{ $self->{yellow_warn} },
+          sprintf("acq t_ccd %.1f outside range -16.0 to -1.0. Clipped.\n",
             $self->{ccd_temp_acq});
-        $self->{ccd_temp_acq} = $self->{ccd_temp_acq}  >  -1.0  ? -1.0
-                              : $self->{ccd_temp_acq}  < -16.0  ? -16.0
-                              : $self->{ccd_temp_acq};
+        $self->{ccd_temp_acq} =
+            $self->{ccd_temp_acq} > -1.0 ? -1.0
+          : $self->{ccd_temp_acq} < -16.0 ? -16.0
+          : $self->{ccd_temp_acq};
     }
 }
 
 ###################################################################################
-sub proseco_args{
+sub proseco_args {
 ###################################################################################
 # Build a hash that corresponds to reasonable arguments to use to call proseco get_acq_catalog
-# to calculate marginalized acquisition probabilities for a star catalog.
-# This routine also saves the guides and fids into lists, but those are not used
-# by get_acq_catalog.
-# If an observation does not have a target quaternion or a starcat, it is skipped and
-# an empty hash is returned with no warning.
+    # to calculate marginalized acquisition probabilities for a star catalog.
+    # This routine also saves the guides and fids into lists, but those are not used
+    # by get_acq_catalog.
+   # If an observation does not have a target quaternion or a starcat, it is skipped and
+    # an empty hash is returned with no warning.
     my $self = shift;
     my %proseco_args;
-    # For the target quaternion, use the -1 to get the last quaternion (there could be more than
+
+# For the target quaternion, use the -1 to get the last quaternion (there could be more than
     # one for a segmented maneuver).
     my $targ_cmd = find_command($self, "MP_TARGQUAT", -1);
     my $cat_cmd = find_command($self, "MP_STARCAT");
-    # For observations without a target attitude, catalog, or defined obsid return an empty hash
-    if ((not $targ_cmd) or (not $cat_cmd) or ($self->{obsid} =~ /NONE(\d+)/)){
+
+# For observations without a target attitude, catalog, or defined obsid return an empty hash
+    if ((not $targ_cmd) or (not $cat_cmd) or ($self->{obsid} =~ /NONE(\d+)/)) {
         return \%proseco_args;
     }
+
     # Use a default SI and offset for ERs (no effect without fid lights)
     my $is_OR = $self->{obsid} < $ER_MIN_OBSID;
     my $si = $is_OR ? $self->{SI} : 'ACIS-S';
@@ -2562,54 +2926,65 @@ sub proseco_args{
     my @gui_ids;
     my @fid_ids;
     my @halfwidths;
-    # Loop over the star catalog and assign the acq stars, guide stars, and fids to arrays.
+
+ # Loop over the star catalog and assign the acq stars, guide stars, and fids to arrays.
   IDX:
-    foreach my $i (1..16) {
-        (my $sid  = $cat_cmd->{"GS_ID$i"}) =~ s/[\s\*]//g;
+    foreach my $i (1 .. 16) {
+        (my $sid = $cat_cmd->{"GS_ID$i"}) =~ s/[\s\*]//g;
+
         # If there is no star there is nothing for proseco probs to do so skip it.
         # But warn if it was a thing that should have had an id (BOT/ACQ/GUI).
-        if ($sid eq '---'){
-            if ($cat_cmd->{"TYPE$i"} =~ /BOT|ACQ|GUI/){
-                push @{$self->{warn}}, sprintf(
-                    "[%2d] Could not calculate acq prob for star with no id.", $i);
+        if ($sid eq '---') {
+            if ($cat_cmd->{"TYPE$i"} =~ /BOT|ACQ|GUI/) {
+                push @{ $self->{warn} },
+                  sprintf("[%2d] Could not calculate acq prob for star with no id.",
+                    $i);
             }
             next IDX;
         }
         $sid = int($sid);
-        # While assigning ACQ stars into a list, warn if outside the 60 to 180 range used by proseco
+
+# While assigning ACQ stars into a list, warn if outside the 60 to 180 range used by proseco
         # and the grid acq model.
-        if ($cat_cmd->{"TYPE$i"} =~ /BOT|ACQ/){
-            push @acq_ids, $sid;;
+        if ($cat_cmd->{"TYPE$i"} =~ /BOT|ACQ/) {
+            push @acq_ids, $sid;
             my $hw = $cat_cmd->{"HALFW$i"};
-            if (($hw > 180) or ($hw < 60)){
-                push @{$self->{orange_warn}}, sprintf(
-                    "[%2d] Halfwidth %d outside range 60 to 180. Will be clipped in proseco probs.\n",
+            if (($hw > 180) or ($hw < 60)) {
+                push @{ $self->{orange_warn} },
+                  sprintf(
+"[%2d] Halfwidth %d outside range 60 to 180. Will be clipped in proseco probs.\n",
                     $i, $hw);
             }
             push @halfwidths, $hw;
             push @acq_indexes, $i;
         }
-        if ($cat_cmd->{"TYPE$i"} =~ /BOT|GUI/){
+        if ($cat_cmd->{"TYPE$i"} =~ /BOT|GUI/) {
             push @gui_ids, $sid;
         }
-        if ($cat_cmd->{"TYPE$i"} =~ /FID/){
+        if ($cat_cmd->{"TYPE$i"} =~ /FID/) {
             push @fid_ids, $sid;
         }
     }
 
-    # Build a hash of the arguments that could be used by proseco (get_aca_catalog or get_acq_catalog).
-    # Zeros are added to most of the numeric parameters as that seems to help "cast" them to floats or ints in
-    # Perl to some extent.  Also save the acquisition star catalog indexes to make it easier to assign back
+# Build a hash of the arguments that could be used by proseco (get_aca_catalog or get_acq_catalog).
+# Zeros are added to most of the numeric parameters as that seems to help "cast" them to floats or ints in
+# Perl to some extent.  Also save the acquisition star catalog indexes to make it easier to assign back
     # the probabilities without having to search again on the Perl side by agasc id.
     %proseco_args = (
         obsid => $self->{obsid},
         date => $targ_cmd->{stop_date},
-        att => [0 + $targ_cmd->{q1}, 0 + $targ_cmd->{q2}, 0 + $targ_cmd->{q3}, 0 + $targ_cmd->{q4}],
+        att => [
+            0 + $targ_cmd->{q1},
+            0 + $targ_cmd->{q2},
+            0 + $targ_cmd->{q3},
+            0 + $targ_cmd->{q4}
+        ],
         man_angle => 0 + $targ_cmd->{angle},
         detector => $si,
         sim_offset => 0 + $offset,
-        dither_acq => [$self->{dither_acq}->{ampl_y}, $self->{dither_acq}->{ampl_p}],
-        dither_guide => [$self->{dither_guide}->{ampl_y}, $self->{dither_guide}->{ampl_p}],
+        dither_acq => [ $self->{dither_acq}->{ampl_y}, $self->{dither_acq}->{ampl_p} ],
+        dither_guide =>
+          [ $self->{dither_guide}->{ampl_y}, $self->{dither_guide}->{ampl_p} ],
         t_ccd_acq => $self->{ccd_temp_acq},
         t_ccd_guide => $self->{ccd_temp},
         include_ids_acq => \@acq_ids,
@@ -2619,41 +2994,41 @@ sub proseco_args{
         n_guide => scalar(@gui_ids),
         fid_ids => \@fid_ids,
         n_fid => scalar(@fid_ids),
-        acq_indexes => \@acq_indexes);
+        acq_indexes => \@acq_indexes
+    );
 
-    return \%proseco_args
+    return \%proseco_args;
 
 }
 
-
 ###################################################################################
-sub set_proseco_probs_and_check_P2{
+sub set_proseco_probs_and_check_P2 {
 ###################################################################################
 # For observations with a star catalog and which have valid parameters already determined
-# in $self->{proseco_args}, call the Python proseco_probs method to calculate the
-# marginalized probabilities, P2, and expected stars, and assign those values back
-# where expected in the data structure.
-# This assigns the individual acq star probabilites back into $self->{acq_probs} and
-# assigns the P2 and expected values into $self->{figure_of_merit}.
+    # in $self->{proseco_args}, call the Python proseco_probs method to calculate the
+    # marginalized probabilities, P2, and expected stars, and assign those values back
+    # where expected in the data structure.
+    # This assigns the individual acq star probabilites back into $self->{acq_probs} and
+    # assigns the P2 and expected values into $self->{figure_of_merit}.
     my $self = shift;
     my $cat_cmd = find_command($self, "MP_STARCAT");
     my $args = $self->{proseco_args};
 
-    if (not %{$args}){
+    if (not %{$args}) {
         return;
     }
-    my ($p_acqs, $P2, $expected) = @{call_python("utils.proseco_probs", [], $args)};
+    my ($p_acqs, $P2, $expected) = @{ call_python("utils.proseco_probs", [], $args) };
 
     $P2 = sprintf("%.1f", $P2);
 
-    my @acq_indexes = @{$args->{acq_indexes}};
+    my @acq_indexes = @{ $args->{acq_indexes} };
 
     # Assign those p_acqs to a slot hash and the catalog P_ACQ by index
     my %slot_probs;
     for my $idx (0 .. $#acq_indexes) {
         my $i = $acq_indexes[$idx];
         $cat_cmd->{"P_ACQ$i"} = $p_acqs->[$idx];
-        $slot_probs{$cat_cmd->{"IMNUM$i"}} = $p_acqs->[$idx];
+        $slot_probs{ $cat_cmd->{"IMNUM$i"} } = $p_acqs->[$idx];
     }
     $self->{acq_probs} = \%slot_probs;
 
@@ -2662,42 +3037,44 @@ sub set_proseco_probs_and_check_P2{
     # Set the P2 requirement to be 2.0 for ORs and 3.0 for ERs.  The higher limit for ER
     # reflects a desire to minimize integrated mission risk for observations where the
     # attitude can be selected freely.  Yellow warning for marginal catalog is set to a
-    # factor of 10 less risk than the red limit P2 probability for OR / ER respectively).
+   # factor of 10 less risk than the red limit P2 probability for OR / ER respectively).
     my $P2_red = $self->{obsid} < $ER_MIN_OBSID ? 2.0 : 3.0;
     my $P2_yellow = $P2_red + 1.0;
 
     # Create a structure that gets used for report generation only.
-    $self->{figure_of_merit} = {expected => substr($expected, 0, 4),
-                                P2 => $P2,
-                                cum_prob_bad => ($P2 < $P2_red)};
+    $self->{figure_of_merit} = {
+        expected => substr($expected, 0, 4),
+        P2 => $P2,
+        cum_prob_bad => ($P2 < $P2_red)
+    };
 
     # Do the actual checks
-    if ($P2 < $P2_red){
-        push @{$self->{warn}},
-             "-log10 probability of 2 or fewer stars < $P2_red\n";
+    if ($P2 < $P2_red) {
+        push @{ $self->{warn} }, "-log10 probability of 2 or fewer stars < $P2_red\n";
     }
-    elsif ($P2 < $P2_yellow){
-        push @{$self->{yellow_warn}},
-             "-log10 probability of 2 or fewer stars < $P2_yellow\n";
+    elsif ($P2 < $P2_yellow) {
+        push @{ $self->{yellow_warn} },
+          "-log10 probability of 2 or fewer stars < $P2_yellow\n";
     }
 
 }
 
+sub set_dynamic_mag_limits {
 
-sub set_dynamic_mag_limits{
 # Use the t_ccd at time of acquistion and time to set the mag limits corresponding to the the magnitude
-# for a 75% acquisition succes (yellow limit) and a 50% acquisition success (red limit)
+ # for a 75% acquisition succes (yellow limit) and a 50% acquisition success (red limit)
     my $c;
     my $self = shift;
     return unless ($c = $self->find_command("MP_STARCAT"));
 
     my $date = $c->{date};
     my $t_ccd = $self->{ccd_temp_acq};
+
     # Dynamic mag limits based on 75% and 50% chance of successful star acq
     # Maximum limits of 10.3 and 10.6
-    $self->{mag_faint_yellow} = min(10.3, call_python(
-        "utils._mag_for_p_acq", [0.75, $date, $t_ccd]));
-    $self->{mag_faint_red} = min(10.6, call_python(
-        "utils._mag_for_p_acq", [0.5, $date, $t_ccd]));
+    $self->{mag_faint_yellow} =
+      min(10.3, call_python("utils._mag_for_p_acq", [ 0.75, $date, $t_ccd ]));
+    $self->{mag_faint_red} =
+      min(10.6, call_python("utils._mag_for_p_acq", [ 0.5, $date, $t_ccd ]));
 }
 
diff --git a/starcheck/src/lib/Ska/Starcheck/Python.pm b/starcheck/src/lib/Ska/Starcheck/Python.pm
index a83363f0..befa63b6 100644
--- a/starcheck/src/lib/Ska/Starcheck/Python.pm
+++ b/starcheck/src/lib/Ska/Starcheck/Python.pm
@@ -13,7 +13,7 @@ require Exporter;
 our @ISA = qw(Exporter);
 our @EXPORT = qw();
 our @EXPORT_OK = qw(call_python date2time time2date set_port set_key);
-%EXPORT_TAGS = ( all => \@EXPORT_OK );
+%EXPORT_TAGS = (all => \@EXPORT_OK);
 
 STDOUT->autoflush(1);
 
@@ -51,31 +51,33 @@ sub call_python {
     };
     my $command_json = encode_json $command;
 
-    if ($VERBOSE gt 2){
-	print STDERR "CLIENT: Sending command $command_json\n";
+    if ($VERBOSE gt 2) {
+        print STDERR "CLIENT: Sending command $command_json\n";
     }
     my $handle;
     my $iter = 0;
     while ($iter++ < 10) {
-        $handle = IO::Socket::INET->new(Proto     => "tcp",
-                                        PeerAddr  => $HOST,
-                                        PeerPort  => $PORT);
+        $handle = IO::Socket::INET->new(
+            Proto => "tcp",
+            PeerAddr => $HOST,
+            PeerPort => $PORT
+        );
         last if defined($handle);
         sleep 1;
     }
     if (!defined($handle)) {
         die "Unable to connect to port $PORT on $HOST: $!";
     }
-    $handle->autoflush(1);       # so output gets there right away
+    $handle->autoflush(1);    # so output gets there right away
     $handle->write("$command_json\n");
 
     my $response = <$handle>;
     $handle->close();
 
     my $data = decode_json $response;
-    if ($VERBOSE gt 2){
-	print STDERR "CLIENT: Got response: $response\n";
-	print STDERR Dumper($data);
+    if ($VERBOSE gt 2) {
+        print STDERR "CLIENT: Got response: $response\n";
+        print STDERR Dumper($data);
     }
     if (defined $data->{exception}) {
         my $msg = "\nPython exception:\n";
@@ -87,16 +89,16 @@ sub call_python {
     return $data->{result};
 }
 
-
 sub date2time {
     my $date = shift;
+
     # print "date2time: $date\n";
     return call_python("utils.date2time", [$date]);
 }
 
-
 sub time2date {
     my $time = shift;
+
     # print "time2date: $time\n";
     return call_python("utils.time2date", [$time]);
 }
diff --git a/starcheck/src/starcheck.pl b/starcheck/src/starcheck.pl
index cc0f77fb..8157b8da 100755
--- a/starcheck/src/starcheck.pl
+++ b/starcheck/src/starcheck.pl
@@ -7,7 +7,6 @@
 #
 ##*******************************************************************************
 
-
 # Set defaults and get command line options
 
 use strict;
@@ -36,63 +35,66 @@
 
 use HTML::TableExtract;
 use Carp 'verbose';
-$SIG{ __DIE__ } = sub { Carp::confess( @_ )};
+$SIG{__DIE__} = sub { Carp::confess(@_) };
 
 # Set some global vars with directory locations
 my $SKA = $ENV{SKA} || '/proj/sot/ska';
 
-my %par = (dir  => '.',
-		   plot => 1,
-		   html => 1,
-		   text => 1,
-		   yaml => 1,
-                   agasc_file => "${SKA}/data/agasc/proseco_agasc_1p7.h5",
-		   config_file => "characteristics.yaml",
-		   fid_char => "fid_CHARACTERISTICS",
-           verbose => 1,
-	   maude => 0,
-	   max_obsids => 0,
-    );
-
-
-GetOptions( \%par,
-			'help',
-			'dir=s',
-			'out=s',
-			'plot!',
-			'html!',
-			'text!',
-			'yaml!',
-			'vehicle!',
-            'verbose=s',
-			'agasc_file=s',
-			'sc_data=s',
-			'fid_char=s',
-			'config_file=s',
-                        'run_start_time=s',
-	    'maude!',
-	    'max_obsids:i',
-    ) ||
-    exit( 1 );
-
-usage( 1 )
-    if $par{help};
+my %par = (
+    dir => '.',
+    plot => 1,
+    html => 1,
+    text => 1,
+    yaml => 1,
+    agasc_file => "${SKA}/data/agasc/proseco_agasc_1p7.h5",
+    config_file => "characteristics.yaml",
+    fid_char => "fid_CHARACTERISTICS",
+    verbose => 1,
+    maude => 0,
+    max_obsids => 0,
+);
 
+GetOptions(
+    \%par,
+    'help',
+    'dir=s',
+    'out=s',
+    'plot!',
+    'html!',
+    'text!',
+    'yaml!',
+    'vehicle!',
+    'verbose=s',
+    'agasc_file=s',
+    'sc_data=s',
+    'fid_char=s',
+    'config_file=s',
+    'run_start_time=s',
+    'maude!',
+    'max_obsids:i',
+) || exit(1);
+
+usage(1)
+  if $par{help};
 
 my $sock = IO::Socket::INET->new(
-    LocalAddr => '', LocalPort => 0, Proto => 'tcp', Listen => 1);
+    LocalAddr => '',
+    LocalPort => 0,
+    Proto => 'tcp',
+    Listen => 1
+);
 my $server_port = $sock->sockport();
 close($sock);
 
 # Generate a 16-character random string of letters and numbers that gets used
 # as a key to authenticate the client to the server.
-my $server_key = join '', map +(0..9,'a'..'z','A'..'Z')[rand 62], 1..16;
+my $server_key = join '', map +(0 .. 9, 'a' .. 'z', 'A' .. 'Z')[ rand 62 ], 1 .. 16;
 
 # Configure the Python interface
 Ska::Starcheck::Python::set_port($server_port);
 Ska::Starcheck::Python::set_key($server_key);
 Ska::Starcheck::Python::set_debug($par{verbose});
-if ($par{verbose} gt 1){
+if ($par{verbose} gt 1) {
     print STDERR "CLIENT: starcheck.server started on port $server_port\n";
     print STDERR "CLIENT: starcheck.server key $server_key\n";
 }
@@ -100,6 +102,7 @@
 # Start a server that can call functions in the starcheck package
 my $pid = open(SERVER, "| python -m starcheck.server");
 SERVER->autoflush(1);
+
 # Send the port, key, and verbosity to the server
 print SERVER "$server_port\n";
 print SERVER "$server_key\n";
@@ -111,9 +114,8 @@
 
 my $version = call_python("utils.starcheck_version");
 
-
 my $Starcheck_Data = $par{sc_data} || call_python("utils.get_data_dir");
-my $STARCHECK   = $par{out} || ($par{vehicle} ? 'v_starcheck' : 'starcheck');
+my $STARCHECK = $par{out} || ($par{vehicle} ? 'v_starcheck' : 'starcheck');
 
 my $empty_font_start = qq{};
 my $red_font_start = qq{};
@@ -122,12 +124,11 @@
 my $blue_font_start = qq{};
 my $font_stop = qq{};
 
-
 # kadi log levels are a little different and INFO (corresponding to the default
 # verbose=1) is too chatty for the default. Instead allow only verbose=0
 # (CRITICAL) or verbose=2 (DEBUG).
 my $kadi_verbose = $par{verbose} gt 1 ? '2' : '0';
-call_python("utils.config_logging", [$STARCHECK, $kadi_verbose, "kadi"]);
+call_python("utils.config_logging", [ $STARCHECK, $kadi_verbose, "kadi" ]);
 call_python("utils.set_kadi_scenario_default");
 
 # Find backstop, guide star summary, OR, and maneuver files.
@@ -137,91 +138,95 @@
 my $sosa_dir_slash = $par{vehicle} ? "vehicle/" : "";
 my $sosa_prefix = $par{vehicle} ? "V_" : "";
 
-
 # Set up for global warnings
 my @global_warn;
+
 # asterisk only include to make globs work correctly
-my $backstop   = get_file("$par{dir}/${sosa_dir_slash}*.backstop", 'backstop', 'required');
-my $guide_summ = get_file("$par{dir}/mps/mg*.sum",   'guide summary');
-my $or_file    = get_file("$par{dir}/mps/or/*.or",      'OR');
-my $mm_file    = get_file("$par{dir}/mps/mm*.sum", 'maneuver');
-my $dot_file   = get_file("$par{dir}/mps/md*.dot",     'DOT', 'required');
-my $mech_file  = get_file("$par{dir}/${sosa_dir_slash}output/${sosa_prefix}TEST_mechcheck.txt*", 'mech check');
-my $fidsel_file= get_file("$par{dir}/History/FIDSEL.txt*",'fidsel');
-my $dither_file= get_file("$par{dir}/History/DITHER.txt*",'dither');
-my $radmon_file= get_file("$par{dir}/History/RADMON.txt*", 'radmon');
-my $simtrans_file= get_file("$par{dir}/History/SIMTRANS.txt*", 'simtrans');
-my $simfocus_file= get_file("$par{dir}/History/SIMFOCUS.txt*", 'simfocus');
-my $attitude_file= get_file("$par{dir}/History/ATTITUDE.txt*", 'attitude');
+my $backstop =
+  get_file("$par{dir}/${sosa_dir_slash}*.backstop", 'backstop', 'required');
+my $guide_summ = get_file("$par{dir}/mps/mg*.sum", 'guide summary');
+my $or_file = get_file("$par{dir}/mps/or/*.or", 'OR');
+my $mm_file = get_file("$par{dir}/mps/mm*.sum", 'maneuver');
+my $dot_file = get_file("$par{dir}/mps/md*.dot", 'DOT', 'required');
+my $mech_file =
+  get_file("$par{dir}/${sosa_dir_slash}output/${sosa_prefix}TEST_mechcheck.txt*",
+    'mech check');
+my $fidsel_file = get_file("$par{dir}/History/FIDSEL.txt*", 'fidsel');
+my $dither_file = get_file("$par{dir}/History/DITHER.txt*", 'dither');
+my $radmon_file = get_file("$par{dir}/History/RADMON.txt*", 'radmon');
+my $simtrans_file = get_file("$par{dir}/History/SIMTRANS.txt*", 'simtrans');
+my $simfocus_file = get_file("$par{dir}/History/SIMFOCUS.txt*", 'simfocus');
+my $attitude_file = get_file("$par{dir}/History/ATTITUDE.txt*", 'attitude');
 
 # Check for characteristics.  Ignore the get_file required vs not API and just pre-check
 # to see if there is characteristics
 my $char_file;
-for my $char_glob ("$par{dir}/mps/ode/characteristics/L_*_CHARACTERIS*",
-                   "$par{dir}/mps/ode/characteristics/CHARACTERIS*"){
-    if (glob($char_glob)){
-        $char_file  = get_file($char_glob, 'characteristics');
+for my $char_glob (
+    "$par{dir}/mps/ode/characteristics/L_*_CHARACTERIS*",
+    "$par{dir}/mps/ode/characteristics/CHARACTERIS*"
+  )
+{
+    if (glob($char_glob)) {
+        $char_file = get_file($char_glob, 'characteristics');
         last;
     }
 }
+
 # Check for a dynamic aimpoint file.  Precheck existence of file to avoid errors about a
 # missing file on historical products that won't have this file
 my $aimpoint_file;
-if (glob("$par{dir}/output/*_dynamical_offsets.txt")){
+if (glob("$par{dir}/output/*_dynamical_offsets.txt")) {
     $aimpoint_file = get_file("$par{dir}/output/*_dynamical_offsets.txt", 'aimpoint');
 }
 
 my $config_file = get_file("$Starcheck_Data/$par{config_file}*", 'config', 'required');
 
 my $config_ref = YAML::LoadFile($config_file);
-my $mp_top_link = guess_mp_toplevel({ path => abs_path($par{dir}),
-									  config => $config_ref });
-
+my $mp_top_link = guess_mp_toplevel(
+    {
+        path => abs_path($par{dir}),
+        config => $config_ref
+    }
+);
 
 my $odb_file = get_file("$Starcheck_Data/$par{fid_char}*", 'odb', 'required');
 
-
 my $agasc_file = get_file("$par{agasc_file}", "agasc_file");
 
-
-my $manerr_file= get_file("$par{dir}/output/*_ManErr.txt",'manerr');
-my $ps_file    = get_file("$par{dir}/mps/ms*.sum", 'processing summary');
-my $tlr_file   = get_file("$par{dir}/${sosa_dir_slash}*.tlr", 'TLR', 'required');
+my $manerr_file = get_file("$par{dir}/output/*_ManErr.txt", 'manerr');
+my $ps_file = get_file("$par{dir}/mps/ms*.sum", 'processing summary');
+my $tlr_file = get_file("$par{dir}/${sosa_dir_slash}*.tlr", 'TLR', 'required');
 
 my $bad_agasc_file = get_file("$Starcheck_Data/agasc.bad", 'banned_agasc');
 my $ACA_bad_pixel_file = get_file("$Starcheck_Data/ACABadPixels", 'bad_pixel');
-my $bad_acqs_file = get_file( "$Starcheck_Data/bad_acq_stars.rdb", 'acq_star_rdb');
-my $bad_gui_file = get_file( "$Starcheck_Data/bad_gui_stars.rdb", 'gui_star_rdb');
-
+my $bad_acqs_file = get_file("$Starcheck_Data/bad_acq_stars.rdb", 'acq_star_rdb');
+my $bad_gui_file = get_file("$Starcheck_Data/bad_gui_stars.rdb", 'gui_star_rdb');
 
 # Let's find which dark current made the current bad pixel file
 
 my $ACA_badpix_date;
-my $ACA_badpix_firstline =  io($ACA_bad_pixel_file)->getline;
+my $ACA_badpix_firstline = io($ACA_bad_pixel_file)->getline;
 
 Ska::Starcheck::Obsid::set_config($config_ref);
 
-if ($ACA_badpix_firstline =~ /Bad Pixel.*\d{7}\s+\d{7}\s+(\d{7}).*/ ){
+if ($ACA_badpix_firstline =~ /Bad Pixel.*\d{7}\s+\d{7}\s+(\d{7}).*/) {
     $ACA_badpix_date = $1;
     print STDERR "Using ACABadPixel file from $ACA_badpix_date Dark Cal \n";
 }
 
-
 unless (-e $STARCHECK) {
-    die "Couldn't make directory $STARCHECK\n" unless (mkdir $STARCHECK, 0777);
+    die "Couldn't make directory $STARCHECK\n"
+      unless (mkdir $STARCHECK, 0777);
     print STDERR "Created plot directory $STARCHECK\n";
 }
 
 # copy over the up and down gifs and overlib
-for my $data_file ('up.gif', 'down.gif', 'overlib.js'){
-    copy( "${Starcheck_Data}/${data_file}", "${STARCHECK}/${data_file}")
-	or print STDERR "copy(${Starcheck_Data}/${data_file}, ${STARCHECK}/${data_file}) failed: $! \n";
+for my $data_file ('up.gif', 'down.gif', 'overlib.js') {
+    copy("${Starcheck_Data}/${data_file}", "${STARCHECK}/${data_file}")
+      or print STDERR
+      "copy(${Starcheck_Data}/${data_file}, ${STARCHECK}/${data_file}) failed: $! \n";
 }
 
-
-
-
-
 # First read the Backstop file, and split into components
 print "Reading backstop file $backstop\n";
 my @bs = Ska::Parse_CM_File::backstop($backstop);
@@ -229,18 +234,19 @@
 my $i = 0;
 my (@date, @vcdu, @cmd, @params, @time);
 foreach my $bs (@bs) {
-    ( $date[$i], $vcdu[$i], $cmd[$i], $params[$i], $time[$i] ) =
-	( $bs->{date}, $bs->{vcdu}, $bs->{cmd}, $bs->{params}, $bs->{time} );
+    ($date[$i], $vcdu[$i], $cmd[$i], $params[$i], $time[$i]) =
+      ($bs->{date}, $bs->{vcdu}, $bs->{cmd}, $bs->{params}, $bs->{time});
     $i++;
-#    print STDERR "BS TIME = $bs->{time} \n";
+
+    #    print STDERR "BS TIME = $bs->{time} \n";
 }
 
 # Read DOT, which is used to figure out the Obsid for each command
 print "Reading DOT file $dot_file\n";
-my ($dot_ref, $dot_touched_by_sausage) = Ska::Parse_CM_File::DOT($dot_file) if ($dot_file);
+my ($dot_ref, $dot_touched_by_sausage) = Ska::Parse_CM_File::DOT($dot_file)
+  if ($dot_file);
 my %dot = %{$dot_ref};
 
-
 #foreach my $dotkey (keys  %dot){
 #	print STDERR "$dotkey $dot{$dotkey}{cmd_identifier} $dot{$dotkey}{anon_param3} $dot{$dotkey}{anon_param4} \n";
 #}
@@ -249,8 +255,10 @@
 my @load_segments = Ska::Parse_CM_File::TLR_load_segments($tlr_file);
 
 print "Reading MM file $mm_file\n";
+
 # Read momentum management (maneuvers + SIM move) summary file
-my %mm = Ska::Parse_CM_File::MM({file => $mm_file, ret_type => 'hash'}) if ($mm_file);
+my %mm = Ska::Parse_CM_File::MM({ file => $mm_file, ret_type => 'hash' })
+  if ($mm_file);
 
 # Read maneuver management summary for handy obsid time checks
 print "Reading process summary $ps_file\n";
@@ -258,7 +266,7 @@
 
 # Read mech check file and parse
 print "Reading mech check file $mech_file\n";
-my @mc  = Ska::Parse_CM_File::mechcheck($mech_file) if ($mech_file);
+my @mc = Ska::Parse_CM_File::mechcheck($mech_file) if ($mech_file);
 
 # Read OR file and integrate into %obs
 print "Reading OR file $or_file\n";
@@ -268,34 +276,35 @@
 # characteristics) and parse; use fid_time_violation later (when global_warn set up
 
 print "Reading FIDSEL file $fidsel_file\n";
-my ($fid_time_violation, $error, $fidsel) = Ska::Parse_CM_File::fidsel($fidsel_file, \@bs) ;
+my ($fid_time_violation, $error, $fidsel) =
+  Ska::Parse_CM_File::fidsel($fidsel_file, \@bs);
 map { warning("$_\n") } @{$error};
 
-
 # Now that global_warn exists, if the DOT wasn't made/modified by SAUSAGE
 # throw an error
-if ($dot_touched_by_sausage == 0 ){
-	warning("DOT file not modified by SAUSAGE! \n");
+if ($dot_touched_by_sausage == 0) {
+    warning("DOT file not modified by SAUSAGE! \n");
 }
 
-Ska::Starcheck::Obsid::setcolors({ red => $red_font_start,
-				   blue => $blue_font_start,
-				   yellow => $yellow_font_start,
-                                   orange => $orange_font_start,
-				   });
+Ska::Starcheck::Obsid::setcolors(
+    {
+        red => $red_font_start,
+        blue => $blue_font_start,
+        yellow => $yellow_font_start,
+        orange => $orange_font_start,
+    }
+);
 
 my %odb = Ska::Parse_CM_File::odb($odb_file);
 Ska::Starcheck::Obsid::set_odb(%odb);
 
-
-
 # Read Maneuver error file containing more accurate maneuver errors
 print "Reading Maneuver Error file $manerr_file\n";
 my @manerr;
 if ($manerr_file) {
     @manerr = Ska::Parse_CM_File::man_err($manerr_file);
-} else { warning("Could not find Maneuver Error file in output/ directory\n") };
-
+}
+else { warning("Could not find Maneuver Error file in output/ directory\n") }
 
 # Get an initial dither state from kadi.  Dither states are then built from backstop commands
 # after this time.  If the running loads will be terminated in advance of new commands in the loads
@@ -303,48 +312,47 @@
 # command will be the first command ($bs[0]) and the kadi dither state will be fetched at that time.
 # This is expected and appropriate.
 print "Getting dither state from kadi at $bs[0]->{date} \n";
-my $kadi_dither = call_python("utils.get_dither_kadi_state", [$bs[0]->{date}]);
+my $kadi_dither =
+  call_python("utils.get_dither_kadi_state", [ $bs[0]->{date} ]);
 
 # Read DITHER history file and backstop to determine expected dither state
 print "Reading DITHER file $dither_file\n";
-my ($dither_error, $dither) = Ska::Parse_CM_File::dither($dither_file, \@bs, $kadi_dither);
+my ($dither_error, $dither) =
+  Ska::Parse_CM_File::dither($dither_file, \@bs, $kadi_dither);
 
 print "Reading RADMON file $radmon_file\n";
 my ($radmon_time_violation, $radmon) = Ska::Parse_CM_File::radmon($radmon_file, \@bs);
 
 # if dither history runs into load or kadi mismatch
-if (defined($dither_error)){
+if (defined($dither_error)) {
     warning($dither_error);
 }
 
 # if radmon history runs into load
-if ($radmon_time_violation){
-  warning("Radmon History runs into load\n");
+if ($radmon_time_violation) {
+    warning("Radmon History runs into load\n");
 }
 
 # if fidsel history runs into load
-if ($fid_time_violation){
+if ($fid_time_violation) {
     warning("Fidsel History runs into load\n");
 }
 
-
 # Read in the failed acquisition stars
 warning("Could not open ACA bad acquisition stars file $bad_acqs_file\n")
-    unless (Ska::Starcheck::Obsid::set_bad_acqs($bad_acqs_file));
-
+  unless (Ska::Starcheck::Obsid::set_bad_acqs($bad_acqs_file));
 
 # Read in the troublesome guide stars
 warning("Could not open ACA bad guide star file $bad_gui_file\n")
-    unless (Ska::Starcheck::Obsid::set_bad_gui($bad_gui_file));
-
+  unless (Ska::Starcheck::Obsid::set_bad_gui($bad_gui_file));
 
 # Read in the ACA bad pixels
 warning("Could not open ACA bad pixel file $ACA_bad_pixel_file\n")
-    unless (Ska::Starcheck::Obsid::set_ACA_bad_pixels($ACA_bad_pixel_file));
+  unless (Ska::Starcheck::Obsid::set_ACA_bad_pixels($ACA_bad_pixel_file));
 
 # Read bad AGASC stars
 warning("Could not open bad AGASC file $bad_agasc_file\n")
-    unless (Ska::Starcheck::Obsid::set_bad_agasc($bad_agasc_file));
+  unless (Ska::Starcheck::Obsid::set_bad_agasc($bad_agasc_file));
 
 # Initialize list of "interesting" commands
 
@@ -364,25 +372,30 @@
 my @obsid_id;
 my $n_obsid = 0;
 for my $i (0 .. $#cmd) {
+
     # Get obsid (aka ofls_id) for this cmd by matching up with corresponding
     # commands from DOT.  Returns undef if it isn't "interesting"
-    next unless ($obsid = get_obsid ($time[$i], $cmd[$i], $date[$i]));
+    next unless ($obsid = get_obsid($time[$i], $cmd[$i], $date[$i]));
 
     # If obsid hasn't been seen before, create obsid object
 
     unless ($obs{$obsid}) {
-    	push @obsid_id, $obsid;
-    	$obs{$obsid} = Ska::Starcheck::Obsid->new($obsid, $date[$i]);
+        push @obsid_id, $obsid;
+        $obs{$obsid} = Ska::Starcheck::Obsid->new($obsid, $date[$i]);
         $n_obsid++;
     }
 
     # Add the command to the correct obs object
 
-    $obs{$obsid}->add_command( { Ska::Parse_CM_File::parse_params($params[$i]),
-				 vcdu => $vcdu[$i],
-				 date => $date[$i],
-				 time => $time[$i],
-				 cmd  => $cmd[$i] } );
+    $obs{$obsid}->add_command(
+        {
+            Ska::Parse_CM_File::parse_params($params[$i]),
+            vcdu => $vcdu[$i],
+            date => $date[$i],
+            time => $time[$i],
+            cmd => $cmd[$i]
+        }
+    );
 
     if (defined $MAX_OBSIDS and $n_obsid > $MAX_OBSIDS) {
         last;
@@ -393,28 +406,40 @@
 # guide/acq/fid star catalogs for each obsid.  In addition to confirming
 # numbers from Backstop, it has star id's and magnitudes.
 
-my %guidesumm = Ska::Parse_CM_File::guide($guide_summ) if (defined $guide_summ);
+my %guidesumm = Ska::Parse_CM_File::guide($guide_summ)
+  if (defined $guide_summ);
 
 # After all commands have been added to each obsid, set some global
 # object parameters based on commands
 
 foreach my $obsid (@obsid_id) {
-    $obs{$obsid}->set_obsid(\%guidesumm); # Commanded obsid
+    $obs{$obsid}->set_obsid(\%guidesumm);    # Commanded obsid
     $obs{$obsid}->set_target();
     $obs{$obsid}->set_star_catalog();
     $obs{$obsid}->set_maneuver(%mm) if ($mm_file);
     $obs{$obsid}->set_manerr(@manerr) if (@manerr);
-    $obs{$obsid}->set_files($STARCHECK, $backstop, $guide_summ, $or_file, $mm_file, $dot_file, $tlr_file);
+    $obs{$obsid}->set_files(
+        $STARCHECK,
+        $backstop,
+        $guide_summ,
+        $or_file,
+        $mm_file,
+        $dot_file,
+        $tlr_file
+    );
     $obs{$obsid}->set_fids($fidsel);
     $obs{$obsid}->set_ps_times(@ps) if ($ps_file);
-    map { $obs{$obsid}->{$_} = $or{$obsid}{$_} } keys %{$or{$obsid}} if (exists $or{$obsid});
+    map { $obs{$obsid}->{$_} = $or{$obsid}{$_} } keys %{ $or{$obsid} }
+      if (exists $or{$obsid});
 }
 
 # Create pointers from each obsid to the previous obsid (except the first one)
 # and the next obsid
-for my $obsid_idx (0 .. ($#obsid_id)){
-    $obs{$obsid_id[$obsid_idx]}->{prev} = ( $obsid_idx > 0 ) ? $obs{$obsid_id[$obsid_idx-1]} : undef;
-    $obs{$obsid_id[$obsid_idx]}->{next} = ( $obsid_idx < $#obsid_id) ? $obs{$obsid_id[$obsid_idx+1]} : undef;
+for my $obsid_idx (0 .. ($#obsid_id)) {
+    $obs{ $obsid_id[$obsid_idx] }->{prev} =
+      ($obsid_idx > 0) ? $obs{ $obsid_id[ $obsid_idx - 1 ] } : undef;
+    $obs{ $obsid_id[$obsid_idx] }->{next} =
+      ($obsid_idx < $#obsid_id) ? $obs{ $obsid_id[ $obsid_idx + 1 ] } : undef;
 }
 
 # Set the NPM times.  This requires the PREV/NEXT entries
@@ -424,26 +449,27 @@
 
 # Check that every Guide summary OFLS ID has a matching OFLS ID in DOT
 # Skip this check if developing code with MAX_OBSIDS set
-if (not defined $MAX_OBSIDS){
-    foreach my $oflsid (keys %guidesumm){
-	unless (defined $obs{$oflsid}){
-	    warning("OFLS ID $oflsid in Guide Summ but not in DOT! \n");
-	}
+if (not defined $MAX_OBSIDS) {
+    foreach my $oflsid (keys %guidesumm) {
+        unless (defined $obs{$oflsid}) {
+            warning("OFLS ID $oflsid in Guide Summ but not in DOT! \n");
+        }
     }
 }
 
 # Add guide_summary data to MP_STARCAT cmd for each obsid.
 
 HAS_GUIDE:
-foreach my $oflsid (@obsid_id){
-    if (defined $guidesumm{$oflsid}){
-		$obs{$oflsid}->add_guide_summ($oflsid, \%guidesumm);
+foreach my $oflsid (@obsid_id) {
+    if (defined $guidesumm{$oflsid}) {
+        $obs{$oflsid}->add_guide_summ($oflsid, \%guidesumm);
     }
     else {
-	my $cat = Ska::Starcheck::Obsid::find_command($obs{$oflsid}, "MP_STARCAT");
-	if (defined $cat){
-	    push @{$obs{$oflsid}->{warn}}, sprintf("No Guide Star Summary for obsid $obsid ($oflsid). \n");
-	}
+        my $cat = Ska::Starcheck::Obsid::find_command($obs{$oflsid}, "MP_STARCAT");
+        if (defined $cat) {
+            push @{ $obs{$oflsid}->{warn} },
+              sprintf("No Guide Star Summary for obsid $obsid ($oflsid). \n");
+        }
     }
 }
 
@@ -454,10 +480,13 @@
 my @sim_trans = ();
 foreach my $mc (@mc) {
     if ($mc->{var} eq 'simtsc_continuity') {
-	push @sim_trans, { cmd  => 'SIMTRANS',
-			   time => $mc->{time},
-			   params=> "POS= $mc->{val}, SCS= 129, STEP= -999"};
-	last;
+        push @sim_trans,
+          {
+            cmd => 'SIMTRANS',
+            time => $mc->{time},
+            params => "POS= $mc->{val}, SCS= 129, STEP= -999"
+          };
+        last;
     }
 }
 foreach (@bs) {
@@ -467,68 +496,67 @@
 # Take the MP_STARCAT hash from find_command and convert it into an array with
 # a record for each catalog index.  This is used for the Python plotting of the
 # catalog
-sub catalog_array{
+sub catalog_array {
     my $cat = shift;
     my @catarr;
-    for $i (1 .. 16){
-        if (not exists $cat->{"TYPE$i"}){
+    for $i (1 .. 16) {
+        if (not exists $cat->{"TYPE$i"}) {
             next;
         }
-        if ($cat->{"TYPE$i"} eq 'NUL'){
+        if ($cat->{"TYPE$i"} eq 'NUL') {
             next;
         }
-        my %catrow = ('yang'=>$cat->{"YANG$i"},
-                      'zang'=>$cat->{"ZANG$i"},
-                      'halfw'=>$cat->{"HALFW$i"},
-                      'type'=>$cat->{"TYPE$i"},
-                      'idx'=>$i);
+        my %catrow = (
+            'yang' => $cat->{"YANG$i"},
+            'zang' => $cat->{"ZANG$i"},
+            'halfw' => $cat->{"HALFW$i"},
+            'type' => $cat->{"TYPE$i"},
+            'idx' => $i
+        );
         push @catarr, \%catrow;
     }
     return \@catarr;
 }
 
-
 # Write out Obsid objects as JSON
 # include a routine to change the internal context to a float/int
 # for everything that looks like a number
 sub force_numbers {
-    if (ref $_[0] eq ""){
-        if ( looks_like_number($_[0]) ){
+    if (ref $_[0] eq "") {
+        if (looks_like_number($_[0])) {
             $_[0] += 0;
         }
-    } elsif ( ref $_[0] eq 'ARRAY' ){
-        force_numbers($_) for @{$_[0]};
-    } elsif ( ref $_[0] eq 'HASH' ) {
-        force_numbers($_) for values %{$_[0]};
+    }
+    elsif (ref $_[0] eq 'ARRAY') {
+        force_numbers($_) for @{ $_[0] };
+    }
+    elsif (ref $_[0] eq 'HASH') {
+        force_numbers($_) for values %{ $_[0] };
     }
     return $_[0];
 }
 
-
-sub json_obsids{
+sub json_obsids {
 
     my @all_obs;
     my %exclude = ('next' => 1, 'prev' => 1, 'agasc_hash' => 1);
-    foreach my $obsid (@obsid_id){
+    foreach my $obsid (@obsid_id) {
         my %obj = ();
-        for my $tkey (keys(%{$obs{$obsid}})){
-            if (not defined $exclude{$tkey}){
+        for my $tkey (keys(%{ $obs{$obsid} })) {
+            if (not defined $exclude{$tkey}) {
                 $obj{$tkey} = $obs{$obsid}->{$tkey};
             }
         }
         push @all_obs, \%obj;
     }
 
-    return JSON::to_json(force_numbers(\@all_obs), {pretty => 1});
+    return JSON::to_json(force_numbers(\@all_obs), { pretty => 1 });
 }
 
-
 # Set the thermal model run start time to be either the supplied
 # run_start_time or now.
-my $run_start_time = call_python(
-    "utils.get_run_start_time",
-    [$par{run_start_time}, $bs[0]->{date}]
-);
+my $run_start_time =
+  call_python("utils.get_run_start_time", [ $par{run_start_time}, $bs[0]->{date} ]);
 
 my $json_text = json_obsids();
 my $obsid_temps;
@@ -537,8 +565,8 @@ sub json_obsids{
     "utils.ccd_temp_wrapper",
     [],
     {
-        oflsdir=> $par{dir},
-        outdir=>$STARCHECK,
+        oflsdir => $par{dir},
+        outdir => $STARCHECK,
         json_obsids => $json_text,
         orlist => $or_file,
         run_start_time => $run_start_time,
@@ -546,62 +574,69 @@ sub json_obsids{
         maude => $par{maude},
     }
 );
+
 # convert back from JSON outside
 $obsid_temps = JSON::from_json($json_obsid_temps);
 
-if ($obsid_temps){
+if ($obsid_temps) {
     foreach my $obsid (@obsid_id) {
         $obs{$obsid}->set_ccd_temps($obsid_temps);
+
         # put all the interval pieces in the main obsid structure
-        if (defined $obsid_temps->{$obs{$obsid}->{obsid}}){
-            $obs{$obsid}->{thermal} = $obsid_temps->{$obs{$obsid}->{obsid}};
+        if (defined $obsid_temps->{ $obs{$obsid}->{obsid} }) {
+            $obs{$obsid}->{thermal} = $obsid_temps->{ $obs{$obsid}->{obsid} };
         }
     }
 }
 
-
 # Do main checking
 foreach my $obsid (@obsid_id) {
     $obs{$obsid}->get_agasc_stars($agasc_file);
     $obs{$obsid}->identify_stars();
     my $cat = Ska::Starcheck::Obsid::find_command($obs{$obsid}, "MP_STARCAT");
+
     # If the catalog is empty, don't make plots
-    if (defined $cat){
+    if (defined $cat) {
         my $cat_as_array = catalog_array($cat);
-        my %plot_args = (obsid=>"$obs{$obsid}->{obsid}",
-                         ra=>$obs{$obsid}->{ra},
-                         dec=>$obs{$obsid}->{dec},
-                         roll=>$obs{$obsid}->{roll},
-                         catalog=>$cat_as_array,
-                         starcat_time=>"$obs{$obsid}->{date}",
-                         duration=>($obs{$obsid}->{obs_tstop} - $obs{$obsid}->{obs_tstart}),
-                         outdir=>$STARCHECK, agasc_file=>$agasc_file);
+        my %plot_args = (
+            obsid => "$obs{$obsid}->{obsid}",
+            ra => $obs{$obsid}->{ra},
+            dec => $obs{$obsid}->{dec},
+            roll => $obs{$obsid}->{roll},
+            catalog => $cat_as_array,
+            starcat_time => "$obs{$obsid}->{date}",
+            duration => ($obs{$obsid}->{obs_tstop} - $obs{$obsid}->{obs_tstart}),
+            outdir => $STARCHECK,
+            agasc_file => $agasc_file
+        );
         call_python("utils.plot_cat_wrapper", [], \%plot_args);
         $obs{$obsid}->{plot_file} = "$STARCHECK/stars_$obs{$obsid}->{obsid}.png";
-        $obs{$obsid}->{plot_field_file} = "$STARCHECK/star_view_$obs{$obsid}->{obsid}.png";
+        $obs{$obsid}->{plot_field_file} =
+          "$STARCHECK/star_view_$obs{$obsid}->{obsid}.png";
         $obs{$obsid}->{compass_file} = "$STARCHECK/compass$obs{$obsid}->{obsid}.png";
 
-    $obs{$obsid}->check_monitor_commanding(\@bs, $or{$obsid});
-    $obs{$obsid}->set_dynamic_mag_limits();
-    $obs{$obsid}->check_dither($dither);
-    # Get the args that proseco would want
-    $obs{$obsid}->{'proseco_args'} = $obs{$obsid}->proseco_args();
-    $obs{$obsid}->set_proseco_probs_and_check_P2();
-    $obs{$obsid}->check_star_catalog($or{$obsid}, $par{vehicle});
-    $obs{$obsid}->check_sim_position(@sim_trans) unless $par{vehicle};
-	$obs{$obsid}->check_momentum_unload(\@bs);
-    $obs{$obsid}->check_bright_perigee($radmon);
-    $obs{$obsid}->check_guide_count();
+        $obs{$obsid}->check_monitor_commanding(\@bs, $or{$obsid});
+        $obs{$obsid}->set_dynamic_mag_limits();
+        $obs{$obsid}->check_dither($dither);
+
+        # Get the args that proseco would want
+        $obs{$obsid}->{'proseco_args'} = $obs{$obsid}->proseco_args();
+        $obs{$obsid}->set_proseco_probs_and_check_P2();
+        $obs{$obsid}->check_star_catalog($or{$obsid}, $par{vehicle});
+        $obs{$obsid}->check_sim_position(@sim_trans) unless $par{vehicle};
+        $obs{$obsid}->check_momentum_unload(\@bs);
+        $obs{$obsid}->check_bright_perigee($radmon);
+        $obs{$obsid}->check_guide_count();
     }
 
     # Make sure there is only one star catalog per obsid
-    warning ("More than one star catalog assigned to Obsid $obsid\n")
-	if ($obs{$obsid}->find_command('MP_STARCAT',2));
+    warning("More than one star catalog assigned to Obsid $obsid\n")
+      if ($obs{$obsid}->find_command('MP_STARCAT', 2));
 }
 
 my $final_json = json_obsids();
 open(my $JSON_OUT, "> $STARCHECK/obsids.json")
-     or die "Couldn't open $STARCHECK/obsids.json for writing\n";
+  or die "Couldn't open $STARCHECK/obsids.json for writing\n";
 print $JSON_OUT $final_json;
 close($JSON_OUT);
 
@@ -624,34 +659,33 @@ sub json_obsids{
 }
 $out .= " Kadi scenario: $kadi_scenario\n";
 my $cheta_source = call_python("utils.get_cheta_source");
-if ($cheta_source ne 'cxc'){
+if ($cheta_source ne 'cxc') {
     $cheta_source = "${red_font_start}${cheta_source}${font_stop}";
 }
 $out .= " cheta data source: $cheta_source\n";
 $out .= "\n";
 
-if ($mp_top_link){
-    $out .= sprintf("Short Term Schedule: %s", $mp_top_link->{url}, $mp_top_link->{week});
+if ($mp_top_link) {
+    $out .= sprintf("Short Term Schedule: %s",
+        $mp_top_link->{url}, $mp_top_link->{week});
     $out .= "\n\n";
 }
 
-
-
 if (%input_files) {
     $out .= "------------  PROCESSING FILES  -----------------\n\n";
     $out .= "DATA = $Starcheck_Data\n";
     for my $name (sort (keys %input_files)) {
-        if ($input_files{$name} =~ /$Starcheck_Data\/?(.*)/){
+        if ($input_files{$name} =~ /$Starcheck_Data\/?(.*)/) {
             $out .= "Using $name file \$\{DATA\}/$1\n";
         }
-        else{
+        else {
             $out .= "Using $name file $input_files{$name}\n";
         }
-    };
+    }
 
-# Add info about which bad pixel file is being used:
-    if (defined $ACA_badpix_date){
-	$out .= "Using ACABadPixel file from $ACA_badpix_date Dark Cal \n";
+    # Add info about which bad pixel file is being used:
+    if (defined $ACA_badpix_date) {
+        $out .= "Using ACABadPixel file from $ACA_badpix_date Dark Cal \n";
     }
 
     $out .= "\n";
@@ -661,7 +695,7 @@ sub json_obsids{
     $out .= "------------  PROCESSING WARNING  -----------------\n\n";
     $out .= $red_font_start;
     foreach (@global_warn) {
-	$out .= $_;
+        $out .= $_;
     }
     $out .= qq{${font_stop}\n};
 }
@@ -673,80 +707,91 @@ sub json_obsids{
     "utils.make_ir_check_report",
     [],
     {
-        backstop_file=> $backstop,
-        out=> $ir_report
+        backstop_file => $backstop,
+        out => $ir_report
     }
 );
-if ($ir_ok){
+if ($ir_ok) {
     $out .= "[OK] In NMAN during High IR Zones.\n";
 }
-else{
+else {
     $out .= "[${red_font_start}NOT OK${font_stop}]";
     $out .= " Not in NMAN during High IR Zone.\n";
 }
 
-
 # Run independent attitude checker
 my $ATT_CHECK_AFTER = '2015:315:00:00:00.000';
-if ((defined $char_file) or ($bs[0]->{time} > date2time($ATT_CHECK_AFTER))){
+if (   (defined $char_file)
+    or ($bs[0]->{time} > date2time($ATT_CHECK_AFTER)))
+{
     $out .= "------------  VERIFY ATTITUDE (SI_ALIGN CHECK)  -----------------\n\n";
+
     # dynamic aimpoint files are required after 21-Aug-2016
     my $AIMPOINT_REQUIRED_AFTER = '2016:234:00:00:00.000';
-    if ((not defined $aimpoint_file) and ($bs[0]->{time} > date2time($AIMPOINT_REQUIRED_AFTER))){
+    if (    (not defined $aimpoint_file)
+        and ($bs[0]->{time} > date2time($AIMPOINT_REQUIRED_AFTER)))
+    {
         $out .= "Error.  dynamic aimpoint file not found. \n";
     }
-    # The attitude checks are possible with either the characteristics file or the dynamic aimpoint file
+
+# The attitude checks are possible with either the characteristics file or the dynamic aimpoint file
     # but not without both
-    if ((not defined $char_file) and (not defined $aimpoint_file)){
+    if ((not defined $char_file) and (not defined $aimpoint_file)) {
         $out .= "Error.  No dynamic aimpoint or characteristics file. \n";
     }
-    elsif ($par{vehicle}){
+    elsif ($par{vehicle}) {
         $out .= "Skipping attitude checks for vehicle-only processing. \n";
     }
-    else{
+    else {
         my $att_report = "${STARCHECK}/pcad_att_check.txt";
         my $att_ok = call_python(
             "utils._make_pcad_attitude_check_report",
             [],
             {
-                backstop_file=> $backstop,
-                or_list_file=>$or_file,
-                simtrans_file=>$simtrans_file,
-                simfocus_file=>$simfocus_file,
-                attitude_file=>$attitude_file,
-                ofls_characteristics_file=>$char_file,
-                out=>$att_report,
-                dynamic_offsets_file=>$aimpoint_file
-            });
-        if ($att_ok){
+                backstop_file => $backstop,
+                or_list_file => $or_file,
+                simtrans_file => $simtrans_file,
+                simfocus_file => $simfocus_file,
+                attitude_file => $attitude_file,
+                ofls_characteristics_file => $char_file,
+                out => $att_report,
+                dynamic_offsets_file => $aimpoint_file
+            }
+        );
+        if ($att_ok) {
             $out .= "[OK] Coordinates as expected.\n";
         }
-        else{
-            $out .= "[${red_font_start}NOT OK${font_stop}] Coordinate mismatch or error.\n";
+        else {
+            $out .=
+"[${red_font_start}NOT OK${font_stop}] Coordinate mismatch or error.\n";
         }
-        # Only check that characteristics file is less than 30 days old if backstop starts before 01-Aug-2016
+
+# Only check that characteristics file is less than 30 days old if backstop starts before 01-Aug-2016
         my $CHAR_DATE_CHECK_BEFORE = '2016:214:00:00:00.000';
-        if ($bs[0]->{time} < date2time($CHAR_DATE_CHECK_BEFORE)){
-            if (call_python(
+        if ($bs[0]->{time} < date2time($CHAR_DATE_CHECK_BEFORE)) {
+            if (
+                call_python(
                     "pcad_att_check.check_characteristics_date",
-                    [$char_file, $date[0]])
-                ) {
+                    [ $char_file, $date[0] ]
+                )
+              )
+            {
                 $out .= "[OK] Characteristics file newer than 30 days\n\n";
             }
-            else{
-                $out .= "[${red_font_start}NOT OK${font_stop}] Characteristics file older than 30 days\n\n";
+            else {
+                $out .=
+"[${red_font_start}NOT OK${font_stop}] Characteristics file older than 30 days\n\n";
             }
         }
     }
 }
 
 # CCD temperature plot
-if ($obsid_temps){
+if ($obsid_temps) {
     $out .= "------------  CCD TEMPERATURE PREDICTION -----------------\n\n";
     $out .= "\n";
 }
 
-
 # Summary of obsids
 
 $out .= "------------  SUMMARY OF OBSIDS -----------------\n\n";
@@ -758,79 +803,86 @@ sub json_obsids{
     $obsid = $obsid_id[$obs_idx];
 
     # mark the OBC load segment starts
-    if ($load_seg_idx <= $#load_segments ){
-	my $load_seg_time = date2time( $load_segments[$load_seg_idx]->{date});
-	my $obsid_time = date2time($obs{$obsid}->{date});
-    	if ($load_seg_time < $obsid_time){
-	    $out .= "         ------  $load_segments[$load_seg_idx]->{date}   OBC Load Segment Begins     $load_segments[$load_seg_idx]->{seg_id} \n";
-	    $load_seg_idx++;
+    if ($load_seg_idx <= $#load_segments) {
+        my $load_seg_time = date2time($load_segments[$load_seg_idx]->{date});
+        my $obsid_time = date2time($obs{$obsid}->{date});
+        if ($load_seg_time < $obsid_time) {
+            $out .=
+"         ------  $load_segments[$load_seg_idx]->{date}   OBC Load Segment Begins     $load_segments[$load_seg_idx]->{seg_id} \n";
+            $load_seg_idx++;
 
-	}
+        }
 
     }
 
-    $out .= sprintf "{obsid}\">OBSID = %5s", $obs{$obsid}->{obsid};
+    $out .= sprintf "{obsid}\">OBSID = %5s",
+      $obs{$obsid}->{obsid};
     $out .= sprintf " at $obs{$obsid}->{date}   ";
 
-
     # If Obsid is numeric include in the summary
-    if ($obs{$obsid}->{obsid} =~ /^\d+$/){
-
-	my $cat = Ska::Starcheck::Obsid::find_command($obs{$obsid}, "MP_STARCAT");
-
-	# But exclude the obsid if it has no star catalog
-	if (defined $cat){
-	    my $guide_count = $obs{$obsid}->{figure_of_merit}->{guide_count};
-	    # minumum requirements for fractional guide star count for ERs and ORs
-	    my $min_num_gui = ($obs{$obsid}->{obsid} >= 38000 ) ? 6.0 : 4.0;
-
-	    # Use the acq prob model values saved in figure_of_merit for the expected
-	    # number of acq stars and a bad overall probability.  figure_of_merit isn't
-	    # defined if there is no star catalog, so use default of 0 stars and not-bad (0 status)
-	    my $n_acq = 0.0;
-	    my $bad_acq_prob = 0;
-	    if (defined $obs{$obsid}->{figure_of_merit}){
-		$n_acq = $obs{$obsid}->{figure_of_merit}->{expected};
-		$bad_acq_prob = $obs{$obsid}->{figure_of_merit}->{cum_prob_bad};
-	    }
-	    my $acq_font_start =  $bad_acq_prob ? $red_font_start
-		: $empty_font_start;
-	    my $gui_font_start = ($guide_count < $min_num_gui) ? $red_font_start
-		: $empty_font_start;
-
-	    $out .= "$acq_font_start";
-	    $out .= sprintf("%3.1f ACQ | ", $n_acq);
-	    $out .= "$font_stop";
-
-	    $out .= "$gui_font_start";
-	    $out .= sprintf("%3.1f GUI | ", $guide_count);
-	    $out .= "$font_stop";
-	}
+    if ($obs{$obsid}->{obsid} =~ /^\d+$/) {
+
+        my $cat = Ska::Starcheck::Obsid::find_command($obs{$obsid}, "MP_STARCAT");
+
+        # But exclude the obsid if it has no star catalog
+        if (defined $cat) {
+            my $guide_count = $obs{$obsid}->{figure_of_merit}->{guide_count};
+
+            # minumum requirements for fractional guide star count for ERs and ORs
+            my $min_num_gui = ($obs{$obsid}->{obsid} >= 38000) ? 6.0 : 4.0;
+
+            # Use the acq prob model values saved in figure_of_merit for the expected
+            # number of acq stars and a bad overall probability.  figure_of_merit isn't
+ # defined if there is no star catalog, so use default of 0 stars and not-bad (0 status)
+            my $n_acq = 0.0;
+            my $bad_acq_prob = 0;
+            if (defined $obs{$obsid}->{figure_of_merit}) {
+                $n_acq = $obs{$obsid}->{figure_of_merit}->{expected};
+                $bad_acq_prob = $obs{$obsid}->{figure_of_merit}->{cum_prob_bad};
+            }
+            my $acq_font_start =
+                $bad_acq_prob
+              ? $red_font_start
+              : $empty_font_start;
+            my $gui_font_start =
+              ($guide_count < $min_num_gui)
+              ? $red_font_start
+              : $empty_font_start;
+
+            $out .= "$acq_font_start";
+            $out .= sprintf("%3.1f ACQ | ", $n_acq);
+            $out .= "$font_stop";
+
+            $out .= "$gui_font_start";
+            $out .= sprintf("%3.1f GUI | ", $guide_count);
+            $out .= "$font_stop";
+        }
     }
+
     # if Obsid is non-numeric, print "Unknown"
-    else{
-	$out .= sprintf("Undefined Obsid; ER? OR?  | ");
+    else {
+        $out .= sprintf("Undefined Obsid; ER? OR?  | ");
     }
 
-
-    if (@{$obs{$obsid}->{warn}}) {
-	my $count_red_warn = $#{$obs{$obsid}->{warn}}+1;
-	$out .= sprintf("${red_font_start}Critical:%2d${font_stop} ", $count_red_warn);
+    if (@{ $obs{$obsid}->{warn} }) {
+        my $count_red_warn = $#{ $obs{$obsid}->{warn} } + 1;
+        $out .= sprintf("${red_font_start}Critical:%2d${font_stop} ", $count_red_warn);
     }
-    if (@{$obs{$obsid}->{orange_warn}}) {
-	my $count_orange_warn = $#{$obs{$obsid}->{orange_warn}}+1;
-	$out .= sprintf("${orange_font_start}Warn:%2d${font_stop} ", $count_orange_warn);
+    if (@{ $obs{$obsid}->{orange_warn} }) {
+        my $count_orange_warn = $#{ $obs{$obsid}->{orange_warn} } + 1;
+        $out .=
+          sprintf("${orange_font_start}Warn:%2d${font_stop} ", $count_orange_warn);
     }
-    if (@{$obs{$obsid}->{yellow_warn}}) {
-	my $count_yellow_warn = $#{$obs{$obsid}->{yellow_warn}}+1;
-	$out .= sprintf("${yellow_font_start}Caution:%2d${font_stop}", $count_yellow_warn);
+    if (@{ $obs{$obsid}->{yellow_warn} }) {
+        my $count_yellow_warn = $#{ $obs{$obsid}->{yellow_warn} } + 1;
+        $out .=
+          sprintf("${yellow_font_start}Caution:%2d${font_stop}", $count_yellow_warn);
     }
     $out .= "\n";
 }
 
 $out .= "\n";
 
-
 # For each obsid, print star report, errors, and generate star plot
 
 foreach $obsid (@obsid_id) {
@@ -839,24 +891,25 @@ sub json_obsids{
     my $pict1 = qq{};
     my $pict2 = qq{};
     my $pict3 = qq{};
-    if ($obs{$obsid}->{plot_file}){
+    if ($obs{$obsid}->{plot_file}) {
         my $obs = $obs{$obsid}->{obsid};
         my $obsmap = $obs{$obsid}->star_image_map();
         $pict1 = qq{$obsmap  };
     }
-    if ($obs{$obsid}->{plot_field_file}){
-	$pict2 = qq{Star Field
    };
+    if ($obs{$obsid}->{plot_field_file}) {
+        $pict2 =
+qq{Star Field
    };
     }
-    if ($obs{$obsid}->{compass_file}){
-	$pict3 = qq{Compass
    };
+    if ($obs{$obsid}->{compass_file}) {
+        $pict3 =
+qq{Compass
    };
     }
 
-    $out .= "
    $pict1$pict2
    $pict3
    \n" ;
+    $out .=
+"
    $pict1$pict2
    $pict3
    \n";
 }
 
-
-
 # Finish up and format it
 
 $out .= '
    '; @@ -868,14 +921,19 @@ sub json_obsids{ # Write the HTML if ($par{html}) { - open (my $OUT, "> $STARCHECK.html") or die "Couldn't open $STARCHECK.html for writing\n"; -# print $OUT $ptf->ptf2any('html', $out); - print $OUT qq{}; - print $OUT qq{$out}; + open(my $OUT, "> $STARCHECK.html") + or die "Couldn't open $STARCHECK.html for writing\n"; + + # print $OUT $ptf->ptf2any('html', $out); + print $OUT +qq{}; + print $OUT +qq{$out}; close $OUT; -# open (my $DBGOUT, "> $STARCHECK.ptf"); -# print $DBGOUT $out; -# close $DBGOUT; + + # open (my $DBGOUT, "> $STARCHECK.ptf"); + # print $DBGOUT $out; + # close $DBGOUT; print STDERR "Wrote HTML report to $STARCHECK.html\n"; @@ -900,36 +958,40 @@ sub json_obsids{ my %table; foreach my $ts ($te->table_states) { -# print "Table (", join(',', $ts->coords), "):\n"; - my $table_text = qq{}; - my ($depth, $count) = $ts->coords; - foreach my $row ($ts->rows) { - $table_text .= $row->[0] . "\n" if defined $row->[0]; - } - if ($table_text =~ /OBSID/s){ - $table{$depth}{$count} = $table_text; - } + + # print "Table (", join(',', $ts->coords), "):\n"; + my $table_text = qq{}; + my ($depth, $count) = $ts->coords; + foreach my $row ($ts->rows) { + $table_text .= $row->[0] . "\n" if defined $row->[0]; + } + if ($table_text =~ /OBSID/s) { + $table{$depth}{$count} = $table_text; + } } -# use Data::Dumper; -# print Dumper %table; - for my $depth ( sort {$a <=> $b} (keys %table) ){ - for my $count ( sort {$a <=> $b} (keys %{$table{$depth}})){ -# print " $depth $count \n"; - my $chunk = $table{$depth}{$count}; - chomp($chunk); - $chunk =~ s/\s+$/\n/; - $textout->print("$chunk"); - $textout->print("==================================================================================== \n"); - } + + # use Data::Dumper; + # print Dumper %table; + for my $depth (sort { $a <=> $b } (keys %table)) { + for my $count (sort { $a <=> $b } (keys %{ $table{$depth} })) { + + # print " $depth $count \n"; + my $chunk = $table{$depth}{$count}; + chomp($chunk); + $chunk =~ s/\s+$/\n/; + $textout->print("$chunk"); + $textout->print( +"==================================================================================== \n" + ); + } } print STDERR "Wrote text report to $STARCHECK.txt\n"; } - ##*************************************************************************** -sub guess_mp_toplevel{ +sub guess_mp_toplevel { ##*************************************************************************** # figure out the "week" based on the path, and make a URL to point to the @@ -940,31 +1002,25 @@ sub guess_mp_toplevel{ my $config = $arg_ref->{config}; my $lookup_cgi; - if (defined $config->{paths}->{week_lookup}){ - $lookup_cgi = $config->{paths}->{week_lookup}; + if (defined $config->{paths}->{week_lookup}) { + $lookup_cgi = $config->{paths}->{week_lookup}; } - else{ - return undef; + else { + return undef; } - - if ($source_dir =~ /.*\/\d{4}\/(\w{3}\d{4})\/ofls(\w+)/){ - my $week = $1; - my $rev = uc($2); - my $weekfile = ${week} . ${rev}; - my $url = $lookup_cgi . "?week=${weekfile}"; - return { url => $url, week => $weekfile }; + if ($source_dir =~ /.*\/\d{4}\/(\w{3}\d{4})\/ofls(\w+)/) { + my $week = $1; + my $rev = uc($2); + my $weekfile = ${week} . ${rev}; + my $url = $lookup_cgi . "?week=${weekfile}"; + return { url => $url, week => $weekfile }; } return undef; - } - - - - ##*************************************************************************** sub add_obsid_to_tlr { ##*************************************************************************** @@ -976,13 +1032,14 @@ sub add_obsid_to_tlr { # Cross correlate obsid command in TLR with backstop foreach (@lines) { - next unless /COAOSQID \s+ ASSIGN \s OBSERVATION/x; - my ($date) = split; - my ($bs_obsid) = grep { $_->{date} eq $date and $_->{cmd} eq 'MP_OBSID' } @{$bs}; - next unless defined $bs_obsid; - my %params = Ska::Parse_CM_File::parse_params($bs_obsid->{params}); - my $obsid = sprintf("%6d", $params{ID}); - s/OBSERVATION ID NUMBER/OBSERVATION ID $obsid/; + next unless /COAOSQID \s+ ASSIGN \s OBSERVATION/x; + my ($date) = split; + my ($bs_obsid) = + grep { $_->{date} eq $date and $_->{cmd} eq 'MP_OBSID' } @{$bs}; + next unless defined $bs_obsid; + my %params = Ska::Parse_CM_File::parse_params($bs_obsid->{params}); + my $obsid = sprintf("%6d", $params{ID}); + s/OBSERVATION ID NUMBER/OBSERVATION ID $obsid/; } return \@lines; @@ -991,92 +1048,101 @@ sub add_obsid_to_tlr { ##*************************************************************************** sub make_annotated_file { ##*************************************************************************** -# $backstop = get_file("$par{dir}/*.backstop",'backstop', 'required'); -# $guide_summ = get_file("$par{dir}/mg*.sum", 'guide summary'); -# $or_file = get_file("$par{dir}/*.or", 'OR'); -# $mm_file = get_file("$par{dir}/*/mm*.sum", 'maneuver'); -# $dot_file = get_file("$par{dir}/*.dot", 'DOT', 'required'); + # $backstop = get_file("$par{dir}/*.backstop",'backstop', 'required'); + # $guide_summ = get_file("$par{dir}/mg*.sum", 'guide summary'); + # $or_file = get_file("$par{dir}/*.or", 'OR'); + # $mm_file = get_file("$par{dir}/*/mm*.sum", 'maneuver'); + # $dot_file = get_file("$par{dir}/*.dot", 'DOT', 'required'); my ($start_rexp, $id_pre, $id_post, $file_in, $lines) = @_; if (not defined $lines) { - open(my $FILE1, $file_in) or return; - $lines = [ <$FILE1> ]; - close $FILE1; + open(my $FILE1, $file_in) or return; + $lines = [<$FILE1>]; + close $FILE1; } my $obsid; my $start = $start_rexp ? 1 : 0; foreach (@{$lines}) { - $start = 0 if ($start && /$start_rexp/); - next if ($start); - if (/$id_pre(\S+)$id_post/) { - my $pre = "$PREMATCH\\target{"; - my $post = "}\\red_start $MATCH\\red_end $POSTMATCH"; - ($obsid = $1) =~ s/^0+//; - $_ = "$pre$obsid$post"; - } + $start = 0 if ($start && /$start_rexp/); + next if ($start); + if (/$id_pre(\S+)$id_post/) { + my $pre = "$PREMATCH\\target{"; + my $post = "}\\red_start $MATCH\\red_end $POSTMATCH"; + ($obsid = $1) =~ s/^0+//; + $_ = "$pre$obsid$post"; + } } my $file_out = "$STARCHECK/" . basename($file_in) . ".html"; - open(my $FILE2, "> $file_out") or die "Couldn't open $file_out for writing\n"; - print $FILE2 $ptf->ptf2any('html', "\\fixed_start \n" . join('',@{$lines})); + open(my $FILE2, "> $file_out") + or die "Couldn't open $file_out for writing\n"; + print $FILE2 $ptf->ptf2any('html', "\\fixed_start \n" . join('', @{$lines})); close $FILE2; } ##*************************************************************************** sub fix_targquat_time { ##*************************************************************************** -# Go through records and set the time of MP_TARGQUAT commands to -# the time of the subsequent cmd with COMMAND_SW | TLMSID= AOMANUVR + # Go through records and set the time of MP_TARGQUAT commands to + # the time of the subsequent cmd with COMMAND_SW | TLMSID= AOMANUVR my $manv_time; my $set = 0; - for my $i (reverse (0 .. $#cmd)) { + for my $i (reverse(0 .. $#cmd)) { if ($cmd[$i] eq 'COMMAND_SW' and $params[$i] =~ /AOMANUVR/) { -# print STDERR "First: $cmd[$i], $time[$i], $date[$i] \n"; - $manv_time = $time[$i]; - $set = 1; - } - if ($cmd[$i] eq 'MP_TARGQUAT') { -# print STDERR "Second: $cmd[$i], $time[$i], $date[$i] \n"; - if ($set eq 1) { - $time[$i] = $manv_time; -# undef $manv_time; # Make sure that each TARGQUAT gets a unique AOMANUVR time - $set = 0; - } else { - warning ("Found MP_TARGQUAT at $date[$i] without corresponding AOMANUVR\n"); - } - } + + # print STDERR "First: $cmd[$i], $time[$i], $date[$i] \n"; + $manv_time = $time[$i]; + $set = 1; + } + if ($cmd[$i] eq 'MP_TARGQUAT') { + + # print STDERR "Second: $cmd[$i], $time[$i], $date[$i] \n"; + if ($set eq 1) { + $time[$i] = $manv_time; + + # undef $manv_time; # Make sure that each TARGQUAT gets a unique AOMANUVR time + $set = 0; + } + else { + warning( + "Found MP_TARGQUAT at $date[$i] without corresponding AOMANUVR\n"); + } + } } } - ##*************************************************************************** sub set_dot_cmd { ##*************************************************************************** - %dot_cmd = (ATS_MANVR => 'MP_TARGQUAT', -# SIMPKT_SIM => 'SIMFOCUS' , - ATS_DTHR => 'MP_DITHER' , - ATS_ACQ => 'MP_STARCAT', - ATS_OBSID => 'MP_OBSID', - ); - - %dot_time_offset = (ATS_DTHR => -120.0, - ATS_OBSID => 0, - ); - - %dot_tolerance = (ATS_DTHR => 200.0, - ATS_OBSID => 1.0, - ); + %dot_cmd = ( + ATS_MANVR => 'MP_TARGQUAT', + + # SIMPKT_SIM => 'SIMFOCUS' , + ATS_DTHR => 'MP_DITHER', + ATS_ACQ => 'MP_STARCAT', + ATS_OBSID => 'MP_OBSID', + ); + + %dot_time_offset = ( + ATS_DTHR => -120.0, + ATS_OBSID => 0, + ); + + %dot_tolerance = ( + ATS_DTHR => 200.0, + ATS_OBSID => 1.0, + ); } ##*************************************************************************** sub get_obsid { ##*************************************************************************** - my $TIME_TOLERANCE = 20; # seconds + my $TIME_TOLERANCE = 20; # seconds my $time = shift; my $cmd = shift; my $date = shift; @@ -1089,24 +1155,23 @@ sub get_obsid { # Match (by time) the input command to corresponding command in the DOT foreach my $obsid_index (keys %dot) { - next unless (defined $dot_cmd{ $dot{$obsid_index}{cmd_identifier}}); - - my $cmd_identifier = $dot{$obsid_index}{cmd_identifier}; - my $dt = $dot_time_offset{$cmd_identifier} || 0.0; - my $tolerance = $dot_tolerance{$cmd_identifier} || $TIME_TOLERANCE ; + next unless (defined $dot_cmd{ $dot{$obsid_index}{cmd_identifier} }); + my $cmd_identifier = $dot{$obsid_index}{cmd_identifier}; + my $dt = $dot_time_offset{$cmd_identifier} || 0.0; + my $tolerance = $dot_tolerance{$cmd_identifier} || $TIME_TOLERANCE; - if ($dot_cmd{$cmd_identifier} eq $cmd ){ - if ( abs($dot{$obsid_index}{time} + $dt - $time) < $tolerance) { - if ($obsid_index =~ /\S0*(\S+)\d{4}/){ - return $1; + if ($dot_cmd{$cmd_identifier} eq $cmd) { + if (abs($dot{$obsid_index}{time} + $dt - $time) < $tolerance) { + if ($obsid_index =~ /\S0*(\S+)\d{4}/) { + return $1; - } - else{ - die "Couldn't parse obsid_index = '$obsid_index' in get_obsid()\n"; - } - } - } + } + else { + die "Couldn't parse obsid_index = '$obsid_index' in get_obsid()\n"; + } + } + } } # Couldn't match input command to DOT. This happens normally for @@ -1119,7 +1184,6 @@ sub get_obsid { return (); } - ##*************************************************************************** sub get_file { ##*************************************************************************** @@ -1130,19 +1194,20 @@ sub get_file { my @files = glob($glob); if (@files != 1) { - my $warn = ((@files == 0) ? - "$warning: No $name file matching $glob\n" - : "$warning: Found more than one file matching $glob, using none\n"); - warning($warn); - die "\n" if ($required); - return undef; + my $warn = ( + (@files == 0) + ? "$warning: No $name file matching $glob\n" + : "$warning: Found more than one file matching $glob, using none\n" + ); + warning($warn); + die "\n" if ($required); + return undef; } - $input_files{$name}=$files[0]; + $input_files{$name} = $files[0]; print STDERR "Using $name file $files[0]\n"; return $files[0]; } - ##*************************************************************************** sub warning { ##*************************************************************************** @@ -1151,17 +1216,16 @@ sub warning { print STDERR $text; } - ##*************************************************************************** sub usage ##*************************************************************************** { - my ( $exit ) = @_; + my ($exit) = @_; - local $^W = 0; - require Pod::Text; - Pod::Text::pod2text( '-75', $0 ); - exit($exit) if ($exit); + local $^W = 0; + require Pod::Text; + Pod::Text::pod2text('-75', $0); + exit($exit) if ($exit); } END { @@ -1170,20 +1234,21 @@ END # If the Python process id is defined, kill that process and wait if (defined $pid) { - if ($par{verbose} gt 1){ - my $server_calls = call_python("get_server_calls"); - # print the server_calls hash sorted by value in descending order - print("Python server calls:"); - print Dumper($server_calls); - } - if ($par{verbose} gt 1){ - print("Shutting down python starcheck server with pid=$pid\n"); - } - kill 9, $pid; # must it be 9 (SIGKILL)? - my $gone_pid = waitpid $pid, 0; # then check that it's gone + if ($par{verbose} gt 1) { + my $server_calls = call_python("get_server_calls"); + + # print the server_calls hash sorted by value in descending order + print("Python server calls:"); + print Dumper($server_calls); + } + if ($par{verbose} gt 1) { + print("Shutting down python starcheck server with pid=$pid\n"); + } + kill 9, $pid; # must it be 9 (SIGKILL)? + my $gone_pid = waitpid $pid, 0; # then check that it's gone } exit($exit_status); -}; +} =pod