# This code can be used to read the SAC-D/Aquarius alarm state metadata that
# are stored under $metadir .  These metadata are used to color code various
# SAC-D/Aquarius telemetry interfaces.

# Norman Kuring		15-Jul-2011	Encapsulate this code in a separate
#					module.
# Norman Kuring		11-Aug-2011	Add file2station to this module.
# Norman Kuring		14-Sep-2011	Add get_menu_hierarchy,
#					remove_menu_singlets, and
#					sort_menu_leaves subroutines.
# Norman Kuring		 5-Oct-2011	Was erroneously multiplying seconds
#					value by 60 when I should not have.
# Norman Kuring		11-Oct-2011	Return hourly alarms if so requested.
# Norman Kuring		13-Oct-2011	Must subtract 1 from date before using
#					as an array index.
# Norman Kuring		19-Jun-2012	Let get_param_specs also read the
#					Aquarius_sciparam_index.txt file if
#					so requested.

package ReadTelemMeta;

use strict;
use Exporter qw(import);
use Time::Local;
use lib '/web/aquarius/scripts';
use Utility qw(read_dir monthbounds);

our $VERSION     = 1.00;
our @ISA         = qw(Exporter);
our @EXPORT_OK   = qw(
                     get_max_alarms_range
                     get_max_alarms
                     get_param_specs
                     get_menu_hierarchy
                     remove_menu_singlets
                     sort_menu_leaves
                     readmeta
                     read_units
                     available_years
                     file2station
                     read_condensed
                   );

my $metadir = '/web/aquarius/metadata';

sub get_max_alarms_range{
  # For help in interpretting variable names below:
  #   b - beginning   e - end
  #   a - alarm   l - location (i.e. a file offset in bytes)
  #   y - year
  #   o - month
  #   d - day
  #   h - hour
  #   m - minute
  #   s - second
  #   p - parameter
  #
  # For example:
  #   $ma - minute alarm
  #   $ob - month beginning
  #   $dl - day location

  # Desired beginning and end times are passed in.
  my ($typ,$bt,$et) = @_;

  my @max;

  my $by = (gmtime $bt)[5] + 1900;
  my $ey = (gmtime $et)[5] + 1900;

  my $firstyear = 1;
  for(my $y=$by; $y<=$ey; $y++){	# For each year ...
    my $path = sprintf "$metadir/alarms/Q%d.$typ.bin",$y;
    -s $path or next;

    open F,'<',$path or die "Could not open $path ($!)";
    my $bytes;
    read(F,$bytes,4) == 4 or die "Error reading from $path ($!)";
    $bytes eq $y or die "Unexpected 1st 4 bytes ($bytes) of $path";
    read(F,$bytes,4) == 4 or die "Error reading from $path ($!)";
    my $numparams = unpack "L",$bytes;

    # Initialize the alarms to "missing" the first time around.
    if($firstyear){
      $firstyear = 0;
      @max = (chr(0)) x $numparams;
    }

    # Read the parameter year alarms and month offsets.
    my ($ya,$ol) = readmeta($path,\*F,8,$numparams);
    # Compute the beginning and end second of this year.
    my $yb = timegm(0,0,0,1,0,$y-1900);
    my $ye = timegm(59,59,23,31,11,$y-1900);
    for(my $p=0; $p<$numparams; $p++){	# For each telemetry parameter ...
      if($bt>$yb || $et<$ye and $ol->[$p]){
        # If this year is not wholly contained within the specified
        # time period and the component month alarms vary ...
        my (@oa, @dl);
        # Read the month alarms and day offsets for this year.
        ($oa[$p],$dl[$p]) = readmeta($path,\*F,$ol->[$p],12);
        for(my $o=0; $o<12; $o++){	# For each month ...
          # Compute the beginning and end second of this month.
          my $ob = timegm(0,0,0,1,$o,$y-1900);
          $ob > $et and next;
          my $oe = $o==11 ? $ye : timegm(0,0,0,1,$o+1,$y-1900) - 1;
          $oe < $bt and next;
          my $ndays = ($oe - $ob + 1)/86400;
          if($bt>$ob || $et<$oe and $dl[$p][$o]){
            # If this month is not wholly contained within the specified
            # time period and the component day alarms vary ...
            my (@da, @hl);
            # Read the day alarms and hour offsets for this month.
            ($da[$p],$hl[$p]) = readmeta($path,\*F,$dl[$p][$o],$ndays);
            for(my $d=0; $d<$ndays; $d++){	# For each day ...
              # Compute the beginning and end second of this day.
              my $db = $ob + 86400*$d;
              $db > $et and next;
              my $de = $db + 86399;
              $de < $bt and next;
              if($bt>$db || $et<$de and $hl[$p][$d]){
                # If this day is not wholly contained within the specified
                # time period and the component hour alarms vary ...
                my (@ha, @ml);
                # Read the hour alarms and minute offsets for this day.
                ($ha[$p],$ml[$p]) = readmeta($path,\*F,$hl[$p][$d],24);
                for(my $h=0; $h<24; $h++){	# For each hour ...
                  # Compute the beginning and end second of this hour.
                  my $hb = $db + 3600*$h;
                  $hb > $et and next;
                  my $he = $hb + 3599;
                  $he < $bt and next;
                  if($bt>$hb || $et<$he and $ml[$p][$h]){
                    # If this hour is not wholly contained within the specified
                    # time period and the component minute alarms vary ...
                    my (@ma, @sl);
                    # Read the minute alarms and second offsets for this hour.
                    ($ma[$p],$sl[$p]) = readmeta($path,\*F,$ml[$p][$h],60);
                    for(my $m=0; $m<60; $m++){	# For each minute ...
                      # Compute the beginning and end second of this minute.
                      my $mb = $hb + 60*$m;
                      $mb > $et and next;
                      my $me = $mb + 59;
                      $me < $bt and next;
                      if($bt>$mb || $et<$me and $sl[$p][$m]){
                        # If this minute is not wholly contained within the
                        # specified time period and the component second
                        # alarms vary ...
                        # Read the second alarms for this minute.
                        seek F,$sl[$p][$m],0 or
                        die "Error seeking to byte $sl[$p][$m] in $path ($!)";
                        my $bytes;
                        read(F,$bytes,60) == 60 or
                        die "Error reading 60 bytes starting at ",
                            "byte $sl[$p][$m] in $path ($!)";
                        my @sa;
                        $sa[$p] = [unpack 'a' x 60, $bytes];
                        for(my $s=0; $s<60; $s++){	# For each second ...
                          # Compute the second with reference to the epoch.
                          my $sec = $mb + $s;
                          next if($bt>$sec || $et<$sec);
                          $max[$p] = $sa[$p][$s]
                            if($sa[$p][$s] gt $max[$p]);
                        }
                      }
                      else{
                        $max[$p] = $ma[$p][$m] if($ma[$p][$m] gt $max[$p]);
                      }
                    }
                  }
                  else{
                    $max[$p] = $ha[$p][$h] if($ha[$p][$h] gt $max[$p]);
                  }
                }
              }
              else{
                $max[$p] = $da[$p][$d] if($da[$p][$d] gt $max[$p]);
              }
            }
          }
          else{
            $max[$p] = $oa[$p][$o] if($oa[$p][$o] gt $max[$p]);
          }
        }
      }
      else{
        $max[$p] = $ya->[$p] if($ya->[$p] gt $max[$p]);
      }
    }
    close F;
  }
  @max;
}

sub get_max_alarms{
  my ($typ,$year,$month,$day) = @_;
  $year or return ();

  my $path = "$metadir/alarms/Q$year.$typ.bin";
  open F,'<',$path or die "Could not open $path ($!)";

  my $bytes;
  read(F,$bytes,4) == 4 or die "Error reading from $path ($!)";
  $bytes eq $year or die "Unexpected 1st 4 bytes ($bytes) of $path.\n";
  read(F,$bytes,4) == 4 or die "Error reading from $path ($!)";
  my $numparams = unpack "L",$bytes;

  # Read the year alarms and corresponding offsets to the monthly alarms.
  my ($yalarm,$ooffset) = readmeta($path,\*F,8,$numparams);

  # Read the month alarms and corresponding offsets to the daily alarms.
  my (@oalarm, @doffset);
  for(my $p=0; $p<$numparams; $p++){
    if($ooffset->[$p]){
      ($oalarm[$p],$doffset[$p]) = readmeta($path,\*F,$ooffset->[$p],12);
    }
    else{
      $oalarm[$p] = [($yalarm->[$p]) x 12];
    }
  }

  unless(defined $month){
    # I can quit early if a month has not been specified.
    close F;
    return (\@oalarm);
  }

  # Read the day alarms and corresponding offsets to the hourly alarms.
  my (@dalarm, @hoffset);
  my @d = monthbounds($year,$month);
  my $ndays = $d[1] - $d[0] + 1;
  for(my $p=0; $p<$numparams; $p++){
    if($doffset[$p][$month]){
      ($dalarm[$p],$hoffset[$p]) =
      readmeta($path,\*F,$doffset[$p][$month],$ndays);
    }
    else{
      $dalarm[$p] = [($oalarm[$p][$month]) x $ndays];
    }
  }

  unless(defined $day){
    # I can quit early if a day has not been specified.
    close F;
    return (\@oalarm,\@dalarm);
  }

  # Read the hour alarms and corresponding offsets to the minute alarms.
  my (@halarm, @moffset);
  for(my $p=0; $p<$numparams; $p++){
    if($hoffset[$p][$day - 1]){
      ($halarm[$p],$moffset[$p]) =
      readmeta($path,\*F,$hoffset[$p][$day - 1],24);
    }
    else{
      $halarm[$p] = [($dalarm[$p][$day - 1]) x 24];
    }
  }

  close F;
  return (\@oalarm,\@dalarm,\@halarm);
}
    
sub readmeta{
  my ($path,$fh,$loc,$n) = @_;
  seek $fh,$loc,0 or die "Error seeking to byte $loc in $path ($!)";
  my $bytes;
  my $nb = 5*$n;
  read($fh,$bytes,$nb) == $nb
  or die "Error reading $nb bytes starting at byte $loc in $path ($!)";
  my @a = unpack 'ax4' x $n, $bytes;
  my @p = unpack 'xL'  x $n, $bytes;
  \(@a,@p);
}

sub get_param_specs{
  my $type = lc shift;	# aq: Aquarius, sp: Service Platform, sc: Science data

  my $file = $type eq 'aq'
           ? "$metadir/Aquarius_parameter_index.txt"
           : $type eq 'sp'
           ? "$metadir/ServicePlatform_parameter_index.txt"
           : "$metadir/Aquarius_sciparam_index.txt";

  open F,'<',$file or die "Error opening $file ($!)";
  my @a = grep !/^\s*#/, <F>;   # Remove comments.
  close F;
  chop @a;                      # Remove linefeeds.
  map { my @b = split ' ',$_,9; (shift @b,[@b]) } @a;
}

sub get_menu_hierarchy{
  my $file = "$metadir/MenuHierarchy.txt";

  open F,'<',$file or die "Error opening $file ($!)";
  my @a = grep !/^\s*#/, <F>;   # Remove comments.
  close F;
  chop @a;                      # Remove linefeeds.

  # I trust these data because I am reading them from a file (with
  # a fully specified path) that I created; I am therefore untainting
  # everything.
  @a = map {/(.*)/;$1} @a;

  my %h;
  foreach my $a (@a){

    # Protect whitespace in quoted strings.
    my $sub = chr(26);
    my $tmp;
    $a =~ s/'([^']+)'/$tmp=$1,$tmp=~s#\s#$sub#g,$tmp/ge;

    # Split the record into fields -- restoring whitespace where appropriate.
    my @b = grep s/$sub/ /g || 1, split ' ', $a;

    my $prm = shift @b;

    # I reverse the hierarchy to put the more
    # general groupings earlier in the array.
    $h{$prm} = [reverse @b];

  }
  %h;
}

# Remove all intermediate menu levels that only have one submenu.
sub remove_menu_singlets{
  my $r = shift;
  if(ref($r) eq 'HASH'){
    my @k = keys %$r;
    if(@k == 1){
      $r = remove_menu_singlets($r->{$k[0]});
    }
    else{
      foreach my $k (@k){
        $r->{$k} = remove_menu_singlets($r->{$k});
      }
    }
  }
  return $r;
}

# Sort parameters in the menu leaf nodes according to their
# specified positions in the parameter index.
sub sort_menu_leaves{
  my ($i,$r) = @_;	# Parameter index and menu reference are passed in.
  if(ref($r) eq 'HASH'){
    foreach my $k (keys %$r){
      sort_menu_leaves($i,$r->{$k});
    }
  }
  elsif(ref($r) eq 'ARRAY'){
    @$r = sort { $i->{$a}[1] <=> $i->{$b}[1] } @$r;
  }
}

sub read_units{
  my %units;
  my $ufile = "$metadir/units.txt";
  open F,'<',$ufile or die "Could not open $ufile ($!)";
  while(<F>){
    /^\s*#/ and next;   # Skip comments.
    s/^\s*(.*)\s*/$1/;  # Trim leading and trailing whitespace.

    my @fields = split /<\|>/, $_, 6;   # '<|>' is the field delimiter.

    @fields == 5 or warn "Unexpected number of fields in record: $_\n";

    defined $units{$fields[0]} and
    warn "[$fields[0] @{ $units{$fields[0]} }] superceded by [@fields]\n";

    $units{$fields[0]} = [splice @fields,1];
  }
  close F;
  %units;
}

sub available_years{
  my $typ = shift;
  map /^Q(\d{4})/, read_dir("$metadir/alarms",'^Q\d{4}\.' . $typ . '\.bin$');
}

sub file2station{
  my $f = shift;

  my @station;

  my %stations = (
  '100' => ['ETC','Cordoba, Argentina'],
  '140' => ['SGS','Svalbard, Norway'],
  '141' => ['ASF','Fairbanks, Alaska'],
  '142' => ['MGS','McMurdo, Antarctica'],
  '143' => ['WGS','Wallops, Virginia'],
  '144' => ['SKS','Svalbard, Norway'],
  '180' => ['IMT','Matera, Italy'],
  '181' => ['IML','Malindi, Kenya'],
  );

  $f =~ /_(\d{3})\d{14}_SACD/;
  my $code = $1;
  if(defined $code){
    if(defined $stations{$code}){
      @station = @{ $stations{$code} };
    }
    else{
      @station = ('UKN','Unknown station code');
    }
  }
  else{
    @station = ('N/A','Station code not available');
  }
  @station;
}

sub read_condensed{
  my ($f,$begin,$delta_t,$st,$et,$numgroups,$numstats,$col) = @_;
  my @condensed = ();

  my $numrecs = $numgroups * $numstats;

  if(open F,'<',$f){

    # Read the records of condensed data.
    @condensed = <F>;
    close F;

    if(@condensed != $numrecs){
      warn "Found ",
           scalar(@condensed),
           " records in $f ; expected $numrecs\n";
      next;
    }

    # Group the statistics together.
    {
      my (@c,@a);
      push @c,[@a] while @a = splice @condensed,0,$numstats;
      @condensed = @c;
    }

    # Add time stamps. Set the time to the
    # middle of the averaging interval.
    for(my $i=0; $i<$numgroups; $i++){
      my $t = $begin + $delta_t*$i + $delta_t/2;
      unshift @{ $condensed[$i] }, $t;
    }

    # Remove records that were marked as empty or that fall
    # outside of the specified time range.
    for(my $i=$#condensed; $i>=0; $i--){
      if($condensed[$i][1] =~ /^N/
      or $condensed[$i][0] < $st
      or $condensed[$i][0] > $et){
        splice @condensed,$i,1;
      }
    }

    # Keep only the parameter that we are interested in.
    for(my $i=0; $i<@condensed; $i++){
      for(my $j=0; $j<$numstats; $j++){
        my $k = $j + 1; # The time stamp is at $j = 0.
        $condensed[$i][$k] = (split ' ',$condensed[$i][$k])[$col - 1];
      }
    }

    # Get rid of periods that, for this specific parameter, have no data.
    for(my $i=$#condensed; $i>=0; $i--){
      splice @condensed,$i,1 if $condensed[$i][1] == 0;
    }
  }
  @condensed;
}

1;
