Planet Jupiter receiver

jove.pl

#!/opt/local/bin/perl -w
# jove -- listen to jupiter
#
# We get a constant 1ch s16le bitstream on <STDIN>.  Not
# optimal, I know.  We are constantly reading from the
# bitstream, in one of two modes:
# - in SLAB mode, the samples are then preserved, processed and
#   dumped to outputs (logfile, slabfile, slabstat, quadfile).
# - in NOTSLAB mode, the samples are ignored.  This also gives
#   us some processing headroom.

use strict;
use warnings;
use threads;
use threads::shared;
use autodie;
$|++;

use Data::Dumper;
use JSON;
use Math::FFT;
use POSIX 'strftime';
use Tie::IxHash;
use Time::HiRes qw(usleep);

my $NOTSLAB = 0;
my $SLAB = 1;

#####
##### KNOBS AND TUNABLES
#####
#
# $audioSampleRate is the number of samples to expect over the
# course of 1 second (or sampling rate, measured in Hz).
#
my $audioSampleRate = 48000;

#
# $sampleSize controls how long one sample 'slab' should be.  In
# normal circumstances, this is the normal audio sample rate.
# For me, the sample rate is 48 kHz, but it needs to be an
# integer power of two (due to constraints in Math::FFT).
#
my $sampleSize = 32;

#
# $sampleInterval controls how long to wait between taking one
# 'slab' of samples.  This is counted in seen samples.
# Normally, the automatic calculation here will suffice; this
# assumes ($sampleSize / $audioSampleRate) is the listened
# sample section.
#
my $sampleInterval = $audioSampleRate - $sampleSize;

#####
##### END KNOBS AND TUNABLES
#####

# Should our threads be running?
my $threadRun = 1;

# Set binary mode on STDIN; after all, that's what we want.
binmode STDIN;
binmode STDOUT;

# A cute little twiddle while we work.
my @twiddle = qw(q w e r t y u i o p a s d f g h j k l z x c v b n m < > ?);

my ($mode, $sampleNumber, $contextSwitches, $procSrs, $inputValue) :shared;

$mode = $SLAB;
$sampleNumber = 0;
$contextSwitches = 0;
$inputValue = 0;

my $series;
my $block = 0;

#
# This thread updates the status line with the current time, the
# twiddle, sample number, mode, the number of 'context' switches
# (really how many times we've switched to SLAB mode) and the status
# string out of &processSeries.
#
threads->create(
  sub {
    while (1) {
      printf("\r%s[%s] [%s] Processing sample %5d [%s %4d] %s [%s]",
	     "\t" x 10,
	     strftime("%Y-%m-%d:%H:%M:%S", gmtime(time)),
	     $twiddle[int($sampleNumber % (scalar @twiddle))],
	     $sampleNumber,
	     $mode ? '#' : '!', $contextSwitches,
	     $procSrs,
	     unpack("H*", $inputValue));
      usleep (50000);
    }
  }
    );

sub processSeries($) {
  my $series = $_[0];
  share $series;

  #
  # $procSrs describes this function's current status, described
  # by a series of characters, or 'flags', that describe the
  # current processing state in this function, contained within
  # two square brackets ('[' and ']').  All flags are cleared
  # upon return.
  #
  # CHARACTER 1
  #   ' ' -- not in the processing function
  #   '-' -- in the processing function
  #
  # CHARACTER 2
  #   ' ' -- no sample information has been gathered
  #   '+' -- sample information has been gathered
  #
  # CHARACTER 3
  #   ' ' -- no metadata collection has been run
  #   'm' -- about to launch metadata collection thread
  #   'M' -- metadata collection completed successfully
  #
  # CHARACTER 4
  #   ' ' -- no Fourier transform has been run
  #   'f' -- about to launch Fourier transform thread
  #   'F' -- Fourier transform completed successfully
  #
  # CHARACTER 5
  #   ' ' -- output filehandles are closed
  #   ':' -- output filehandles are open
  #   '|' -- data being written
  #
  $procSrs = "[-    ]";

  #
  # Gather sample metadata.
  #
  tie my %statisticsHash, 'Tie::IxHash';
  %statisticsHash = (
    'sampleSection' => $contextSwitches,
    'sampleCount' => $sampleSize,
    'sampleTime' => strftime("%Y-%m-%d:%H:%M:%S", gmtime(time)),
    'sampleDuration' => $sampleSize / $audioSampleRate,
      );
  $procSrs = "[-+   ]";

  my $outputFilenamePrefix = sprintf("jove-%05d", $contextSwitches);
  open (SLABSTAT, ">", "$outputFilenamePrefix.stats");
  open (SLABDATA, ">", "$outputFilenamePrefix.data");
  open (SLABRAW, ">", "$outputFilenamePrefix.raw");
  $procSrs = "[-+  :]";

  #
#
#
  $procSrs = "[-+m :]";
  my ($sampleMaximum, $sampleMinimum, $sampleSum,
      $sampleSumSquared, $sampleAverage, $sampleStdDev) :shared;
  $sampleMaximum = 0;
  $sampleMinimum = 2 ** 32;
  $sampleSum = 0;
  $sampleSumSquared = 0;
  $sampleAverage = 0;
  $sampleStdDev = 0;
  my $mdThread = threads->create(
    sub {
      foreach my $val (@$series) {
	$sampleMaximum = $val
	    if ($val > $sampleMaximum);
	$sampleMinimum = $val
	    if ($val < $sampleMinimum);
	
	$sampleSum += $val;
	$sampleSumSquared += $val*$val;
	$sampleAverage = $sampleSum / $sampleSize;
	$sampleStdDev =
	    sqrt($sampleSumSquared / $sampleSize -
		 ($sampleSum / $sampleSize) * ($sampleSum / $sampleSize));
      }
    });

  $procSrs = "[-+mf:]";
  my $fft = Math::FFT->new($series);
  # Do I need to have run rdft() before I fetch the spectrum? No.
  $statisticsHash{'sampleCoefficients'} = $fft->rdft();
  $statisticsHash{'sampleCharacteristics'} = $fft->spctrm;
  $procSrs = "[-+mF:]";

  $mdThread->join();
  $statisticsHash{'sampleMaximum'} = $sampleMaximum;
  $statisticsHash{'sampleMinimum'} = $sampleMinimum;
  $statisticsHash{'sampleSum'} = $sampleSum;
  $statisticsHash{'sampleSumSquared'} = $sampleSumSquared;
  $statisticsHash{'sampleAverage'} = $sampleAverage;
  $statisticsHash{'sampleStdDev'} = $sampleStdDev;
  $procSrs = "[-+MF:]";

  my ($slabStat, $slabData, $slabRaw);
  $slabStat = JSON->new->utf8->pretty->encode(\%statisticsHash);
  foreach my $val (@$series) {
    $slabData .= unpack('H*', $val);
    $slabRaw .= pack('l', $val);
  }

  $procSrs = "[-+MF>]";
  print SLABSTAT $slabStat;
  print SLABDATA $slabData;
  print SLABRAW $slabRaw;
# print "\nprocess: ", unpack('H*', pack('l', $series->[0])), "\n";
  $procSrs = "[-+MF:]";

  close SLABSTAT;
  close SLABDATA;
  close SLABRAW;
  $procSrs = "[-+MF ]";

  $procSrs = "[     ]";
}

# This is defined down here to make it easier to resize.
  $procSrs = '[     ]';

while ($threadRun) {
  #
  # Read a sample from STDIN.  We use sysread() here to avoid
  # funky behaviour and/or overheads.
  #
  $block = sysread (STDIN, $inputValue, 2);

  #
  # If we're in SLAB mode, then we record the sample into the
  # set.  We use an array here to make it easier to feed into
  # Math::FFT without too much more effort.
  #
  if ($block == 2) {
    # Hooray, we got enough data to treat this as a sample!

    $series->[$sampleNumber] = unpack('v!', $inputValue) if ($mode == $SLAB);
#   print "\nread: ", unpack('H*', $inputValue), "\n" unless $sampleNumber;
  } else {
    # We didn't get enough data to treat this as a sample.
    # Normally means we got an EOF on STDIN.  Terminate.

    $series->[$sampleNumber] = 0 if ($mode == $SLAB);
    $threadRun = 0;
  }

  #
  # We should also increment $sampleNumber here, to avoid
  # confusing Math::FFT and it's 'integer powers of 2'.
  #
  $sampleNumber++;

  #
  # Toggle the mode between SLAB and NOTSLAB and reset the
  # sample number when we get to the desired slab interval or
  # size.
  #
  if (($mode == $SLAB) && ($sampleNumber == $sampleSize)) {
    $mode = $NOTSLAB;
    $sampleNumber = 0;
    threads->create(sub { processSeries($series); });
  } elsif (($mode == $NOTSLAB) && ($sampleNumber == $sampleInterval)) {
    $mode = $SLAB;
    $sampleNumber = 0;
    $contextSwitches++;
  }
}

print "\nEOF received (".$block."b/2) exiting.\n";