package RamData::A2Module;
use strict;
use warnings;

BEGIN {
  use Exporter qw();
  require 5.004;

  our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);

  $VERSION     = '1.14';
  @ISA         = qw(Exporter);
  @EXPORT      = qw();
  %EXPORT_TAGS = qw();
  @EXPORT_OK   = qw(
    $VERSION $PER_BUFFER 
    $CONFIG_SIZE $CONFIG_TEMPLATE 
    $HEADER_SIZE $HEADER_TEMPLATE
  );
}

use Carp;
use FileHandle;
use File::Basename;
use RamData::Flags qw(%FLAG);     #load flags, threshold
use AtlasData::Buoy;
use TAOPerl::JulianTime;

our (
  $PER_BUFFER, $CONFIG_SIZE, $CONFIG_TEMPLATE, $HEADER_SIZE, $HEADER_TEMPLATE,
  %convert2ndx 
);

$PER_BUFFER = 144;

## CWF 02/11/2005 added global for data record header size
## CWF 2006-11-03 added global for data record header template
$HEADER_SIZE = 15;
$HEADER_TEMPLATE = 'H4 H4 H4 H4H2H2 H2H2H2 H4';

## CWF 02/03/2005 added global for config buffer size
## CWF 2006-11-03 added global for config template
$CONFIG_SIZE = 1024;
$CONFIG_TEMPLATE = 'C C n n N n n n n n A10 A10 A10 H2 H2 H2 n';

#  These are the indices for the array of calibrated data read in from the
#    the temporary binary files.
%convert2ndx = (
  TEMP => 0,    # cal data in uppercase
  COND => 1,
  PRES => 2,
  SAL  => 3,
  DENS => 4,
);

#-----------------------------------------------------------------------
sub new {
  my $class = shift;
  my $self = {};
  my $fileName = shift;

  bless $self, $class;
  $self->{file} = {};
  $self->{data} = [];

  if (-r $fileName and -T $fileName )#check for Text vs. binary: seems to work
    {$self->{file}{type} = "ASCII";}
  else
    {$self->{file}{type} = "binary";}

  $self->{info} = { filename => $fileName,
		    filesize => -s $fileName
		  };

  return $self;
}

#-----------------------------------------------------------------------
sub close {
  my $self = shift;}


#-----------------------------------------------------------------------
sub report_problems
  {
  my $self= shift;
  if ($self->{file}{problems})
    {return "\n" . $self->{file}{problems} ."\n";}
  else
    {return "\n  No errors occured.\n\n";}
  }


#-----------------------------------------------------------------------
sub serial{
  my $self = shift;
  my ($mode, $time, $vishay, $battery, $checksum);
  if (@_) {$self->{info}{serialnum} = shift;}
  return $self->{info}{serialnum};
}


#-----------------------------------------------------------------------
sub dump_info{
  my $self = shift;
  my $answer = "\t---header info----------------------------------\n";
  foreach my $key (sort keys %{ $self->{info} }) {
    $answer .= "\t".sprintf("%-20s",$key)."$self->{info}{$key}\n";
  }
  $answer .=   "\t------------------------------------------------\n";
  return $answer;
}

#-----------------------------------------------------------------------
sub match_data_header{
  my ($self,$head) = @_;

  my ($mode,$time,$vishay,$battery,$checksum);

  if ($self->{file}{type} eq "binary")
      {
      unless (length $head == $HEADER_SIZE)
        {return undef;}
      #below is a really ugly line to simply uppercase the header
      #my @head = split "#",uc join "#", unpack "H4 H4 H4 H4H2H2 H2H2H2 H4",$head;
      my @head = split "#",uc join "#", unpack $HEADER_TEMPLATE, $head;
      $mode      = $head[0];
      $checksum  = $head[1];
      $battery   = $head[2];
      $time = sprintf "%04s/%02s/%02s %02s:%02s:%02s",  @head[3..8];
      $vishay = $head[9];
      }
  elsif ($self->{file}{type} eq "ASCII")
      {
      ($mode, $time, $vishay, $battery, $checksum) =
                      ($head =~ m<^
                                   (CAFE|3502)
                                  \s+
                                   ([\d/]{8,10}\s+[\d:]{8})
                                  \s+
                                   ([\dA-F]{5})
                                  \s+
                                   ([\dA-F]{5})
                                  \s+
                                   ([\dA-F]{5})
                                  >x);
#  Use this one for really old software (v 3.03, pm006)
#  my ($time, $vishay, $battery, $mode, $checksum) =
#                      ($head =~ m<^
#                                   ([\d/]{8,10}\s+[\d:]{8})
#                                  \s+
#                                   ([\dA-F]{5})
#                                  \s+
#                                   ([\dA-F]{5})
#                                  \s+
#                                   0(CAFE|3502)
#                                  \s+
#                                   ([\dA-F]{5})
#                                  >x);
      }

  if (defined $mode and ($mode eq '3502' or $mode eq 'CAFE') and defined $time and ( $time =~ m#(\d{2}|\d{4})/\d{2}/\d{2}\s+\d{2}:\d{2}:\d{2}# )  )
    {
    $time =~ s<^(\d{2}/)><19$1>; # prefix the '19' to a two-digit year
    # Should all be 4 digit years now, i think.. PNA Jan. 2000
    # substitute for only one space in the middle
    $time =~ tr/ //s;
    return wantarray ? ($mode, $time, $vishay, $battery, $checksum) : 1;
    }
  else
    {
    return undef
    }

}


#-----------------------------------------------------------------------
sub scan_headers{
  # scans through the file and 
  # reads and stores all the buffer header information

  my $self = shift;

  my $fh;
  unless ( $fh = new FileHandle( "$self->{info}{filename}", "r") )
    {die "$self->{info}{filename} could not be read.  $!\n";}

  ## CWF 02/02/2005 must read config to obtain buffer_size
  defined $self->{info}{buffer_size} or $self->read_config();

  my ($mode, $time, $vishay, $battery, $checksum);

  $self->{file}{bufferlocs}  = [];
  $self->{file}{buffermodes} = [];
  $self->{file}{buffertimes} = [];
  $self->{file}{vishay}      = [];
  $self->{file}{battery}     = [];
  $self->{file}{checksum}    = [];

  my $told =$self->{file}{data_pos};

  if ($self->{file}{type} eq "binary")
    {
    my $lastreadbad=0;
    binmode $fh;
    while (not eof $fh)
      {
      seek $fh, $told, 0;
      read $fh, $_, $HEADER_SIZE;
      if ( (($mode, $time, $vishay, $battery, $checksum) =
	                               $self->match_data_header($_)) == 5)
	{
        push @{ $self->{file}{bufferlocs} },  $told;
        push @{ $self->{file}{buffermodes} }, $mode;
	push @{ $self->{file}{buffertimes} }, $time;
	push @{ $self->{file}{vishay} },      $vishay;
	push @{ $self->{file}{battery} },     $battery;
	push @{ $self->{file}{checksum} },    $checksum;
	# If battery has FFFF, the clock was reset (by the tube) by the number
	#   of samples stored in the vishay spot as a 16 bit signed integer
	if ($battery eq 'FFFF')
	  {
	  $vishay = hex $vishay;
	  $self->{file}{problems} .=
	    "Clock adjusted by ".(($vishay & 32768) ? $vishay-65536 : $vishay).
	    " samples in buffer at $time!\n";
          }
	$told += $self->{info}{buffer_size};  #skip to next buffer
        $lastreadbad=0;
        }
      else  #didn't match header!!
	{
        unless ($told >= ($self->{info}{filesize} - 1024) or $lastreadbad)
          {$self->{file}{problems} .= "Bad buffer header at file position $told.\n";}
        $told++;  # go one byte farther and try again
        $lastreadbad=1;
        } #end else
      } #end while
    }

  else
    {
    while (<$fh>)
      {
      if ( (($mode, $time, $vishay, $battery, $checksum) =
	  $self->match_data_header($_)) == 5)
	{
        push @{ $self->{file}{bufferlocs} },  $told;
        push @{ $self->{file}{buffermodes} }, $mode;
	push @{ $self->{file}{buffertimes} }, $time;
	push @{ $self->{file}{vishay} },      $vishay;
	push @{ $self->{file}{battery} },     $battery;
	push @{ $self->{file}{checksum} },    $checksum;
	# If battery has 0FFFF, the clock was reset (by the tube) by the number
	#   of samples stored in the vishay spot as a 16 bit signed integer
	if ($battery eq '0FFFF')
	  {
	  $vishay = hex $vishay;
	  $self->{file}{problems} .=
	 "Clock adjusted by ". (($vishay & 32768) ? $vishay - 65536 : $vishay).
	  " samples in buffer at $time!\n";
          } #end if battery
        } # end if header ok

        $told = tell $fh;
      } # end while
    } # end ASCII scan
$fh->close;
$self->{info}{buffers_read} = @{ $self->{file}{buffertimes} };

unless ($self->{info}{num_buffers} == $self->{info}{buffers_read})
  {$self->{file}{problems} .= $self->{info}{buffers_read}. " buffers "
  ."found of ".$self->{info}{num_buffers}." expected!\n";}

return 1;
}

#-----------------------------------------------------------------------
sub check_buffers{
# NOT USED AT PRESENT!!!
# checks all the times that have been read 
# in with '&scan_headers'.  If times don't match from 
# header to header, then writes an error statement to
# $self->{file}{problems}

  my $self = shift;
  my (@notmatch, @jds, @times);
  my $time_step = $PER_BUFFER * $self->{info}{increm};

  return -1 unless @{ $self->{file}{bufferlocs} };

  @times = @{ $self->{file}{buffertimes} };
  @jds = timestr2jdfmt($times[0]);

  for (my $i = 1; $i < @times; $i++) {
    my $expect_time = jdfmt2timestr($jds[0], $jds[1] + $time_step);
    unless ($times[$i] eq $expect_time) {
      $self->{file}{problems} .=
	"Timing problem - expected: $expect_time but found: $times[$i]\n";
      push @notmatch, $i;
    }
    @jds = timestr2jdfmt($times[$i]);
  }

  unless ($self->{info}{num_buffers} == $self->{info}{buffers_read})
    {$self->{file}{problems} .= $self->{info}{buffers_read}. " buffers "
    ."found of ".$self->{info}{num_buffers}." expected!\n";}
  $self->{info}{last_time} = $times[ -1 ];
  $self->{info}{last_time_jd} = timestr2jdstr($times[ -1 ]);

  return @notmatch
}

#-----------------------------------------------------------------------
sub check_times{
  # given two timestrings ('1997/08/02 12:30:01') and a
  # time increment in seconds, returns the >difference< between 
  # (1) the number of increments in the delta times and
  # (2) the expected number of increments in the delta time
  # That expected number is the global $PER_BUFFER

  my ($t0, $t1, $seconds) = @_;
  # if $t0 is not initialized, then call it 'ok'
  return 0 if not $t0;

  my @jds0 = timestr2jdfmt($t0);
  my @jds1 = timestr2jdfmt($t1);

  my $interval = jdfmt2secs( diff_jdfmt( @jds1, @jds0) );
  return ($interval/$seconds - $PER_BUFFER);
}

#-----------------------------------------------------------------------
sub read_data{
  my $self = shift;

  my $fh;
  unless ( $fh = new FileHandle( "$self->{info}{filename}", "r") )
    {die "$self->{info}{filename} could not be read.  $!\n";}
  if ($self->{file}{type} eq "binary")
    {binmode $fh;}

  my ($mode, $time, $prev_time, $time_zero);

  # set up a list of the hash keys (in order they appear in dumped buffer)
  #  that are to be filled with raw data
  # for a CAFE mode TC module this list is (1, 2)
  # for a 3502 mode TP module the list is (0, 1, 3)
  my @hash_keys = (
		      ($self->{info}{V}) ? 'VISHAY' : (),
		      ($self->{info}{T}) ?  $self->{info}{T_label}: (),
		      ($self->{info}{C}) ?  $self->{info}{C_label}: (),
		      ($self->{info}{P}) ?  $self->{info}{P_label}: ()
		     );

  my %raw_data_hash;
  map { $raw_data_hash{$_}=();} (@hash_keys);

  $prev_time = '';

  for (0..$#{$self->{file}{bufferlocs}})
    {
    my $header;
    if ($self->{file}{type} eq "binary")
      {
      seek $fh, $self->{file}{bufferlocs}[$_], 0;
      read $fh, $header, $HEADER_SIZE;
      }
    elsif ($self->{file}{type} eq "ASCII")
      {
      seek $fh, $self->{file}{bufferlocs}[$_], 0;
      $header = <$fh>;
      chomp $header;
      }

    ($mode, $time) = $self->match_data_header($header);

    unless ($mode && $time)
      {
      $self->{file}{problems} .= "unusual line in file: ($.) $header\n" ;
#      $self->{file}{problems} .= "unusual line in file at position ".tell $fh.": ($.) $header\n" ;
      next;
      }

    if ($mode ne $self->{info}{mode})
      {
      $self->{file}{problems} .= "Sampling mode changed at " .
	"header:<$header>\n";
      }

    my $t_off = check_times($prev_time, $time, $self->{info}{increm} );

    if ($t_off != 0)
      {
      # if $t_off is non-integer, format it with no trailing zeroes
      ($t_off = sprintf "%+.3f", $t_off) =~ s/\.?0*$//;
      my $t_off_round = sprintf "%+0.0f",$t_off;
      $self->{file}{problems} .= "Times do not match between <$prev_time>" .
	" and <$time>: off by $t_off increments\n\tAdjusting $t_off_round".
	" samples.\n";
      $self->pad_or_clip_data(\%raw_data_hash, $t_off_round, $time);
      }

    $prev_time = $time;

    my @raw_buffer = $self->get_data_buffer($fh, $mode )
      or $self->{file}{problems} .= "empty buffer after header: $header\n";

    convert2dec(\@raw_buffer) if ($self->{info}{softversion} >= 5
                                  or $self->{info}{softversion} == 3.02);
    # NOPP buoy has some NOPP v3.02 modules
    # apportion the raw data into the appropriate array
    while (@raw_buffer)
      {
      foreach my $key (@hash_keys)
        {push @{ $raw_data_hash{$key} }, shift @raw_buffer}
      }
    }

#  $self->{info}{buffertotal} = $buffer_count;
  $fh->close;
  return \%raw_data_hash;
}

#-----------------------------------------------------------------------
sub get_data_buffer{
  my ($self, $data_fh, $mode) = @_;

  my $num_types = $self->{info}{numsensors};

  my $num_words = $PER_BUFFER * $num_types;
  my $num_lines = $num_words/12;

  my @block = ();

  if ($self->{file}{type} eq 'ASCII')
    {
    for (1..$num_lines) {
      my $line = <$data_fh>;
#  Old old old modules (version 3.05, pm007 and pm008) have 5 digit decimal
#  columns, New ones have 4 digit hex columns.  Look for 12.
      unless ($line =~ m/^\s*   ([0-9A-Fa-f]{1,5}\s+){12} # 12 hex or dec patterns
                        \s*                                  # whitespace?
                       $                                     # end of line
                      /ox
       	     )
	{
        my $loc = tell $data_fh;
        chomp $line;
        $self->{file}{problems} .= "bad line at $loc bytes in " . 
 	  "the middle of data buffer:\n\t$line\n " ;
        }
      push @block, split " ", $line;
      }
    }
  elsif ($self->{file}{type} eq 'binary')
    {
    my $data;
    read $data_fh, $data, $self->{info}{buffer_size};
    #unpack as 4 character hex strings, just like the text dumps.
    @block = unpack("H4" x (($self->{info}{buffer_size} - $HEADER_SIZE)/2), $data);
    }

  my $missing = $num_words - @block;
  if ($missing < 0) {
    $#block = $num_words - 1
  } elsif ($missing > 0) {
    push @block, ($FLAG{missing}) x $missing;
  }

  return @block
}

#-----------------------------------------------------------------------
sub convert2dec{
  use integer;
  my $data_r = shift;
  @$data_r = map hex, @$data_r;
  return
}


#-----------------------------------------------------------------------
sub make_auto_timer{
  no strict 'refs';

  # a moderately flexible timer-maker.  Will work for both newatlas format
  # and ISO standard timestr format.  Internally, it works with the 
  # two-element Julian Day / seconds format.  See JulianTime.pm.

  # if the time format is not supplied, the time format is expected to 
  # be a timestr.  If the time is not supplied, the data-start-time is used.

  # returns a subroutine closure that auto-increments times

  my ($self, $time, $t_format) = @_;
  my ($jdstr, @jds);

  unless ($t_format){
    $t_format = 'timestr'
  }

  my $tojulian = 'TAOPerl::JulianTime::' . $t_format . '2jdstr';
  my $fromjulian = 'TAOPerl::JulianTime::jdfmt2' . $t_format;

  if ($time) {
    $jdstr = $self->floor_time( &$tojulian( $time ) );
  } else {
    $jdstr = $self->{info}{start_time_jd};
  }

  @jds = split " ", $jdstr;
  my $increm = $self->{info}{increm};

  return sub {
    my $retvalue = &$fromjulian( @jds ) ;
    @jds = normalize_jds($jds[0], $jds[1] + $increm);
    return $retvalue
  }
}

#-----------------------------------------------------------------------
sub floor_time{
  # takes input as a jd-string, and outputs a jd-string.
  # align the time with the start_time of this module 
  # and with the size of the time increment for this module;

  my ($self, $jd_input) = @_;

  my $start_jd =  $self->{info}{start_time_jd};
  my @sjd = split " ", $start_jd;

  my $data_points_off = $self->data_diff($jd_input, $start_jd);

  return sprintf("%07d %07d",
		 normalize_jds($sjd[0], 
			       $sjd[1] + $data_points_off * $self->{info}{increm}
			      )) 
}


#-----------------------------------------------------------------------
sub _floor ($) {
  return (int $_[0])      if     $_[0] >= 0;
  return (int $_[0])      if int $_[0] == $_[0];
  return (int $_[0] - 1)
}


#-----------------------------------------------------------------------
sub data_diff {
  my $self = shift;
  my ($str1, $str2) = @_;
  my $diff = jdstr2secs( diff_jdstr( $str1, $str2 ) ) / $self->{info}{increm};
  _floor $diff;
}

#-----------------------------------------------------------------------
sub print_output{
  my ($self, $out_fh, @data_sel) = @_;

  # @data_sel is the array of desired data types - the text names of the 
  # data types

  # which indices to use?
  my @indices = map {defined $convert2ndx{$_} ? $convert2ndx{$_}: ()} 
    @data_sel;

  #make sure that the desired data exists
  @indices = grep { $self->{data}[$_] && @{ $self->{data}[$_] } }
    @indices; 
  die "no existing data types selected for print!" unless @indices;

  my $auto_time = $self->make_auto_timer();

  my @formats = ( ('%10d') x 4,  ('%10.4f') x 4 ); #raw->integer,cal->float 
  my $timefmt = "%20s";
  my $format = join " ", $timefmt, @formats[ @indices ], "\n";

  for (my $i = 0; $i < @{ $self->{data}[ $indices[0] ] }; $i++) {
    my $time = &$auto_time;
    printf $out_fh $format, $time, map $self->{data}[ $_ ][$i],
			                @indices ;

  }
}

#-----------------------------------------------------------------------
sub read_config {
  my $self = shift;

  die "filename is not defined\n" unless defined $self->{info}{filename};

  my ($fh, $config);
  if ( $fh = new FileHandle( "$self->{info}{filename}", "r") )
    {
    if ($self->{file}{type} eq "binary")
      {binmode $fh;$config = $self->get_binary_config($fh);}
    else
      {$config = $self->get_ASCII_config($fh);

      }
    }
  else
    {die "$self->{info}{filename} could not be read.  $!\n";}

  $fh->close;
  #check to see if we got the important info
  for (qw/serialnum increm softversion address numsensors mode start_time/)
    {die ("Couldn't find $_ in dump configuration:\n$config") 
      unless $self->{info}{$_}}

  return 1;
}


#-----------------------------------------------------------------------
sub get_ASCII_config {
  my ($self, $fh) = @_;

  my $max_length  = 200;
  my $config      = '';
  my $read_on     = 1;
  my $count       = 0;
  my $line;
  my $pos;

  # the header should be bracketed by 'READ.DATA' and a data header.
  # but in recent tube dumps the READ.DATA line is missing.  So,
  # read in everything up to and including the first data header.  Then
  # clip off the things that precede READ.DATA

  while ($read_on) {
    $pos=tell $fh;
    ++$count;
    last if eof $fh;
    $line = scalar <$fh>;

    $read_on = 0 if $self->match_data_header($line);
    $config .= $line;

    # exit badly if can't find data_header
    return undef if $count > $max_length; 
  }

  $self->{file}{data_pos}=$pos;
  # remove ^H - have to use a while, 'cause of ^H^H
  1 while $config =~ s/.\010//;	



#  Don't do this line for really old software (e.g. PM006, 3.03)
#     it throws out anything above READ.DATA or TEXT.DUMP
  $config =~ s/(^.*READ\.DATA)//s;
  $config =~ s/(^.*TEXT\.DUMP)//s;  # for v 5.07 and later
  $self->{file}{config} = $config;
  study $config;

  ($self->{info}{softversion}) =
   ($config =~ m/(?:sensor )?version (?:number|is)?\s+([0-9]+\.[0-9]+)\s*/im); 
  ($self->{info}{num_buffers}) = ($config =~ m/number records is\s+(\d{4})/im);
  ($self->{info}{serialnum}) =
   ($config =~ m/serial number is\s+([0-9]+)\s*/im);
  ($self->{info}{address}) = 
   ($config =~ m/address is\s+([0-9]+)\s*/im);
  if ($config =~ m/(sampling|logging) interval is\s+(\d\d):(\d\d):(\d\d)\s*$/im ) {
    my $increm = ($2*3600 + $3*60 + $4);
    $self->{info}{increm} = $increm;
  }
  if ($config =~ m/average interval is\s+(\d{1,4})/im ) {
    $self->{info}{avg_interval} = $1;
    if (!($self->{info}{avg_interval} == 24)) {
      print "!!!Problem: Average interval is $self->{info}{avg_interval} (should be 24).\n\n";
    }
  }
  else {$self->{info}{avg_interval} = "unknown";}

  if (  $config =~ m/configured to sample:\s+(\w.*\w*)\s*$/im || $config =~ m/module type is\s+(\w+)\s*$/im
     ) {

    if (  $1 =~ /SSC/i
	  || $1 =~ /C/i) {
      $self->{info}{T}=1; 
      $self->{info}{C}=1; 
      $self->{info}{numsensors} = 2

    } elsif ($1 =~ /P/i) {
      $self->{info}{T}=1; 
      $self->{info}{P}=1; 
      $self->{info}{numsensors} = 2

    } elsif ($1 =~ /T/i) {
      $self->{info}{T}=1; 
      $self->{info}{numsensors} = 1
    }
  }

  (my $last_line) = ($config =~ m/^(.*)\Z/m);
  my ($mode, $t0) = $self->match_data_header($last_line);
  if ($mode && $t0){
    $self->{info}{mode}          = $mode;
    $self->{info}{start_time}    = $t0;
    $self->{info}{start_time_jd} = timestr2jdstr($t0);

    if ($mode eq '3502') {
      $self->{info}{V} = 1;
      $self->{info}{numsensors}++;
    }
  }


  return $config;
}


#-----------------------------------------------------------------------
sub get_binary_config{
  my ($self, $fh) = @_;

  if (-s $fh < $CONFIG_SIZE) {$self->{file}{problems} .= "No data in file!!!\n";return}

  $self->{file}{data_pos}=$CONFIG_SIZE;
  seek $fh, 0, 0;
  my $config;
  read $fh, $config, $CONFIG_SIZE;
  $self->{file}{config} = $config; 
  #my $config_pack_format = ("x" x $HEADER_SIZE) ."C C n n N n n n n n A10 A10 A10 H2 H2 H2 n";
  #my @info = unpack $config_pack_format, $config;
  my @info = unpack( ( 'x' x $HEADER_SIZE ) . $CONFIG_TEMPLATE, $config );
  # "C"haracters are 1 byte. "n"etwork shorts are 2. "N"etwork longs are 4.
  # H2 is a 2 character hex number in binary-coded-decimal format.

  $self->{info}{softversion}      = $info[0].".".sprintf("%02d",$info[1]);
  $self->{info}{num_buffers}      = $info[2];
  $self->{info}{buffer_size}      = $info[3];
  $self->{info}{num_bytes}        = $info[4];
  $self->{info}{last_page}        = $info[5];
  $self->{info}{sensor_type}      = $info[6];
  $self->{info}{sensor_config}    = $info[7];

  if ($self->{info}{sensor_type} == 1)        #TC/TP/TV/TCV/TPV
    {  #decode: bit1 = vishay, bit2 = T, bit3 = P, bit4 = C, bit5 = currents
    $self->{info}{T}   = ( $self->{info}{sensor_config} & 2 )?1:0;
    $self->{info}{P}   = ( $self->{info}{sensor_config} & 4 )?1:0;
    $self->{info}{C}   = ( $self->{info}{sensor_config} & 8 )?1:0;
    $self->{info}{Vel} = ( $self->{info}{sensor_config} & 16)?1:0;
    }
  elsif ($self->{info}{sensor_type} == 2)   #SST/SSC
    {  #decode: bit1 = vishay, bit2 = T, bit3 = C
    $self->{info}{T} = ( $self->{info}{sensor_config} & 2)?1:0;
    $self->{info}{C} = ( $self->{info}{sensor_config} & 4)?1:0;
    $self->{info}{P}   = 0;
    $self->{info}{Vel} = 0;
    }
  $self->{info}{numsensors}       = $self->{info}{T} +
                                    $self->{info}{C} +
				    $self->{info}{P};
  $self->{info}{serialnum}        = $info[8];
  $self->{info}{address}          = sprintf("%02d",$info[9]);
  $self->{info}{P_serial}         = $info[10] if ($self->{info}{P});
  $self->{info}{C_serial}         = $info[11] if ($self->{info}{C});
  $self->{info}{Vel_serial}       = $info[12] if ($self->{info}{Vel});

  ## Bug in versions 5.07, 5.10 - no seconds with hours and minutes shifted right!!
  if (grep {$self->{info}{softversion} == $_} (5.07, 5.10))
    {$self->{info}{increm}       = $info[14]*60*60 + $info[15]*60;}
  else
    {$self->{info}{increm}       = $info[13]*60*60 + $info[14]*60 + $info[15];}
  $self->{info}{avg_interval}    = $info[16];
  if ($self->{info}{avg_interval} != 24) {
    print "!!!Problem: Average interval is $self->{info}{avg_interval} (should be 24).\n\n";
  }

  read $fh, my ($first_header), $HEADER_SIZE;
  my ($mode, $t0) = $self->match_data_header($first_header);
  if ($mode && $t0){
    $self->{info}{mode}          = $mode;
    $self->{info}{start_time}    = $t0;
    $self->{info}{start_time_jd} = timestr2jdstr($t0);

    if ($mode eq '3502') {
      $self->{info}{V} = 1;
      $self->{info}{numsensors}++;
    }
  }

}


#-----------------------------------------------------------------------
sub pad_or_clip_data {
  my ($self, $data_hash_ref, $offset, $time) = @_;
  my $ok = 1;

  foreach my $key ( keys %$data_hash_ref ) {
    my $array_r = $$data_hash_ref{$key};

#    next unless @$array_r;

    if ($offset > 0) {
      push @$array_r, ($FLAG{missing}) x $offset;
    } elsif ($offset < 0) {
      if (@$array_r >= abs($offset)) {
	splice @$array_r, $offset;
	#removes |$offset| values from the end of the list

      } else {
        $self->{file}{problems} .=
	  "Time offset at $time ($offset data points) has clipped" .
	    " all previous data from array!\n";
	@$array_r = ();
        $ok = 0;
      }
    }
  }

  unless ($ok) {
    $self->{info}{start_time}    = $time;
    $self->{info}{start_time_jd} = timestr2jdstr $time;
  }

  return $ok;
}

#-----------------------------------------------------------------------
sub delete_data{
  my $self = shift;
#  delete $self->{data};
  delete $self->{file}{buffertimes};
  delete $self->{file}{bufferlocs};
  delete $self->{file}{buffermodes};
}

#-----------------------------------------------------------------------
sub hash2string{
  my $self = shift;
  my $string;
  for (keys %{ $self->{info} } ) {
    $string .= sprintf "%s=>'%s',", $_, $self->{info}{$_};
  }
  $string =~ s/,$//;
  return "($string)";
}

#-----------------------------------------------------------------------
sub open_temporary_file{
  my $self = shift;

  my $fh = new FileHandle $self->{info}{temp_filename}, "r";
  unless ($fh){
    $self->{file}{binproblems} = 
      "temporary file <$self->{info}{temp_filename}> cannot be opened: $!\n";
    return undef
  }
  binmode $fh;
  $self->{file}{bin_fh} = $fh;
}

#-----------------------------------------------------------------------
sub close_temporary_file{
  my $self = shift;
  if ($self->{file}{bin_fh}) {
    $self->{file}{bin_fh}->close;
    delete $self->{file}{bin_fh};
    return 1;
  } else {
    return undef;
  }
}

#-----------------------------------------------------------------------
sub check_temporary_datatype{
  my ($self, $dtype) = @_;
  $dtype = substr $dtype, 0, 1;
  return 1 if $self->{info}{$dtype . '_bin_loc'};
  return 0
}

#-----------------------------------------------------------------------
sub read_temporary_data{
  # reads data out of the temporary file given a datatype, 
  # a start time, and a number of data values

  my ($self, $dtype, $jd_time, $num_req) = @_;
  my $retvalue = 1;
  my $bin_fh;
  my $bindata;

  unless ($self->{file}{bin_fh}) {
    $self->{file}{problems} .=
      "Can't read data.  Temporary file has not been opened\n";
    return undef;
  } else {
    $bin_fh = $self->{file}{bin_fh}
  }

  # my $time = jdstr2timestr($jd_time);
  # print STDOUT "time requested is: $time, number requested is $num_req\n";

  $dtype = substr $dtype, 0, 1;
  die "Can't find data location for type <$dtype>\n"
    unless $self->check_temporary_datatype($dtype);;

  # calculate the actual start and end locations of the data

  my $start_data = $self->{info}{$dtype . '_bin_loc'};
  my $bytes_data = $self->{info}{$dtype . '_bin_length'};
  my $end_data   = $start_data + $bytes_data;
  my $num_data   = $bytes_data / 4;

  # calculate the requested start and end locations

  my $num_offset = $self->data_diff($jd_time, $self->{info}{start_time_jd} );

  my $start_req  = $start_data + $num_offset * 4;
  my $bytes_req  = $num_req * 4;
  my $end_req    = $start_req + $bytes_req;

  # do different things depending on how the actual and desired 
  # locations compare

  my @data;

  if (       $start_req >= $start_data
	     && $end_req <= $end_data) {

    seek $bin_fh, $start_req, 0;
    read $bin_fh, $bindata, $bytes_req ;
    @data = unpack "f" x $num_req, $bindata;

  } elsif (  $start_req < $start_data
	     && $end_req < $start_data) {

    @data = ($FLAG{missing}) x $num_req;

  } elsif (  $start_req > $end_data
	     && $end_req > $end_data) {

    @data = ($FLAG{missing}) x ($num_req);

  } elsif (  $start_req >= $start_data
	     && $end_req > $end_data) {

    seek $bin_fh, $start_req, 0;
    read $bin_fh, $bindata, 4 * ($num_data - $num_offset) ;
    @data = unpack "f" x ($num_data - $num_offset), $bindata;
    push @data, ($FLAG{missing}) x ($num_req + $num_offset- $num_data);

  } elsif (  $start_req < $start_data
	     && $end_req <= $end_data) {

    seek $bin_fh, $start_data, 0;
    read $bin_fh, $bindata, 4 * ($num_req + $num_offset) ;
    @data = unpack "f" x ($num_req + $num_offset), $bindata;
    unshift @data, ($FLAG{missing}) x (-$num_offset);

  } elsif (  $start_req < $start_data
	     && $end_req > $end_data) {

    #  $num_overflow = $num_req + $num_offset - $num_data;
    seek $bin_fh, $start_data, 0;
    read $bin_fh, $bindata, 4 * ($num_data) ; 
    @data = unpack "f" x ($num_data), $bindata;
    unshift @data, ($FLAG{missing}) x (-$num_offset);
    push @data, ($FLAG{missing}) x ($num_req + $num_offset - $num_data);

  } else {
    die "What's wrong?"
  }
  unless ((my $count = @data) == $num_req){
    die "Busted logic?  Bad adder? $count, $num_req, $num_offset, $num_data\n"
  }

  # Now replace values above close to the threshold value with the fill value.
  # 0.9999 neccesary because of loss of precision when written to binary temp
  # file.  If it's greater than the threshold value, we sprintf it with no
  # decimal places (eg 1e+35 under most OSs, but 1e+035 under Windows), then
  # strip out the "+" and possible following "0".  This SHOULD give us
  # the same result as is stored in the %FLAGS hash.  Note that $_ is NOT an
  # independent variable, it's sort of a reference to the original array element

  foreach (@data)
    {if($_ >= $FLAG{thresh}*0.9999)
       {$_ = sprintf("%1.0e",$_); s/\+0?//;}}

  return @data;

}


#-----------------------------------------------------------------------
sub write_temporary_file{
  my ($self, $data_hash_ref, $tempfile) = @_;
  my $retvalue = 1;
  my $fh;

  unless ( $fh = new FileHandle( $self->{info}{temp_filename}, "w") )
    {
      $self->{file}{problems} .= 
	"File $self->{info}{temp_filename} cannot be opened for binary data write: $!\n";
      return undef;
    }

  binmode $fh;

  print $fh " " x $CONFIG_SIZE;		#header goes up front

  foreach my $key (keys %$data_hash_ref) {
    my $dtype = substr $key, 0, 1;
    my $loc = $dtype . '_bin_loc';
    my $len = $dtype . '_bin_length';

    unless ($data_hash_ref->{$key} && @{ $data_hash_ref->{$key} }) {
      $retvalue = 0;
      $self->{file}{problems} .=
	"Can't write $dtype data to temporary file - no processed data\n";
      next;
    }

    $self->{info}{$loc} = tell $fh;
    $self->{info}{$len} = 4 * @{ $data_hash_ref->{$key} } ;
    print $fh pack "f*", @{ $data_hash_ref->{$key} };
  }

  my $header_ok;
  my $header = $self->hash2string();
  seek $fh, 0, 0;
  if (length $header < $CONFIG_SIZE) {
    print $fh $header;
    $header_ok = 1;
  } else {
    $self->{file}{problems} .=
      "Can't write too-long header information data to temporary file\n";
    $header_ok = 0;
  }
  $fh->close;
  return $header_ok && $retvalue;
}


#-----------------------------------------------------------------------
sub dump_buffer_headers {
  my $self = shift;
  my $format = "%4d  %4s %20s   %6d   %6d  %6d   %8d    %4d\n";
  my $title  = "%4s  %4s %20s   %6s   %6s  %6s   %8s    %4s\n\n";
  my $length = $self->{info}{num_buffers} * $self->{info}{buffer_size}
               + $CONFIG_SIZE;
  if ($length > $self->{info}{filesize}) { $length = $self->{info}{filesize}; }

  printf $title,'#','MODE','TIME','VISHAY','BATTV','CKSUM','LOCATION','SIZE';

  for my $buf (0..$#{$self->{file}{bufferlocs}}) {
    printf $format,
      $buf,
      $self->{file}{buffermodes}[$buf],
      $self->{file}{buffertimes}[$buf],
      hex $self->{file}{vishay}[$buf],
      hex $self->{file}{battery}[$buf],
      hex $self->{file}{checksum}[$buf],
      $self->{file}{bufferlocs}[$buf],
      ## CWF 02/03/2005 last buffer size is checked against file size and
      ## buffer count
      (
        defined($self->{file}{bufferlocs}[$buf+1]) ?
        $self->{file}{bufferlocs}[$buf+1] :
        $length
      )
        - $self->{file}{bufferlocs}[$buf];
  }
  return;
}

1;

__END__

=head1 NAME RamData::A2Module

A module to read an Atlas II module data dump, parse the header information, 
assist (with AtlasData::Buoy) with calibration, write the calibrated data to 
a binary file for temporary storage, read the data from that binary file, 
and keep track of and apply all the time information in the appropriate places.

=head1 SYNOPSIS

First we read in the header, then read in the data.  Main program 
(processA2Mod) will calibrate the data via AtlasData::Buoy.  Write the data 
to a file in a binary format.  Pull any specified data type back out of the binary file, starting with any specified time point.  

The module design allows the routine to be stuck together to process a group 
of modules from one buoy.  It also allows the creation of GUI 
programs using perl/Tk.  The latter goal may be important in allowing Window95 
laptop users to easily access the data dumps.

=head1 REQUIRES

  Perl 5.004
  JulianTime 1.02

=head1 EXPORTS 

Nothing.

=head1 METHODS

=head2 Creation

=over 4

=back

=head2 Access

=over 4

=back

=head2 Utility

=over 4

=back

=head1 subroutines

Line numbers may not reflact later changes in the code.
 
 RamData/A2Module.pm

   sub new_data
   sub dump_info
   sub match_data_header
   sub seek_to_start_of_data
     calls match_data_header at line 64
   sub scan_headers
     calls match_data_header at line 85
   sub check_buffers
   sub read_all_buffer_headers
   sub check_times
   sub read_data
     calls seek_to_start_of_data at line 144
     calls match_data_header at line 159
     calls match_data_header at line 163
     calls check_times at line 169
     calls pad_or_clip_data at line 175
     calls get_data_buffer at line 179
     calls convert2dec at line 182
   sub get_data_buffer
   sub convert2dec
   sub calibrate_data
   sub make_auto_timer
     calls floor_time at line 291
   sub floor_time
     calls data_diff at line 316
   sub floor
   sub data_diff
     calls floor at line 334
   sub print_output
     calls make_auto_timer at line 340
   sub get_header
     calls match_data_header at line 371
     calls die_in_header at line 374
   sub read_header
     calls get_header at line 390
     calls die_in_header at line 398
     calls die_in_header at line 411
     calls die_in_header at line 425
     calls die_in_header at line 428
     calls match_data_header at line 432
   sub die_in_header
   sub pad_or_clip_data
   sub delete_data
   sub hash2string
   sub open_binary_file
   sub close_binary_file
   sub check_binary_datatype
   sub read_binary_data
     calls check_binary_datatype at line 544
     calls data_diff at line 551
   sub get_binary_data
   sub print_binary_data
     calls hash2string at line 673




=head1 test program


=cut