#!/usr/bin/perl

# ==>	SEND 'NOW PLAYING:' INFO AS RADIOTEXT TO RBDS BOX

use IO::Socket;
use DB_File;


sub already {
  open PS, "/bin/ps wwfaux |";
  @PS = <PS>;
  close PS;
  my $flag = 0;
  foreach (@PS) {
    $flag++ if (/$0/);
  }
  if ($flag > 2) {
    return 1;
  } else {
    return 0;
  }
}


sub child_process_remote {

  close STDIN;
  $outitle = '';
  $utitle = '';

# ==>	LOOK FOR INPUT FILE
  while (1) {
    sleep 1;
    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
    $atime,$mtime,$ctime,$blksize,$blocks)
    = stat($FILE);
    if ((time - $mtime) > $DELAY) {
      if (open (RBDS,"<$FILE")) {
        $a = <RBDS>;
        close RBDS;
        ($utitle,$title,$artist,$duration,$album) = &extract($a,$mtime);
  
# ==>	TRANSMIT AND LOG RESULTS
        if ($utitle) {
          if ($utitle eq $outitle) { 
              &rbds_scroll($utitle);
          } else {
            &log($title,$artist,$duration,$album);
            &rbds_scroll($utitle);
            &pad($utitle);
#           print "$utitle\n";
            $outitle = $utitle;
            if (open (OUTITLE,">$OUTITLE")) {
              print (OUTITLE $outitle);
              close OUTITLE;
            }
          }
        }
      }
    }
  }
}


sub consonant {
  my @C = ('b','c','d','f','g','h','j','k','l','m','n','p','q','r',
  's','t','v','w','x','z','-','/','\'');
  my $c = lc(shift());
  my $d = '';
  while ($d = shift @C) {
    if ($c eq $d) {return 1}
  }
  return 0;
}


sub dictionary_lookup {
  my @a = ();
  my @b = ();
  my $a = '';
  my $b = '';
  my $i = 0;
  tie (%dictionary,"DB_File",$DICTIONARY);
  while ($a = shift) {
    if ($b = $dictionary{$a}) {
      @b = split (' ',$b);
      while ($b = shift @b) {
        $a[$i] = $b;
        $i++;
      }
    } else {
      $a[$i] = $a;
      $i++;
      if (length($a) > 8) {
        $dictionary{$a} = $a;
      }
    }
  }
  untie %dictionary;
  return @a;
}


sub extract {
  my $a = shift;
  my $mtime = shift;
  my $b = '';
  my $c = '';
  my $d = 0;
  my $e = '';
  my $time = time;
  ($b,$c,$d,$e) = ($a =~ /(.*)\|(.*)\|(.*)\|(.*)$/);
  if (($time - $mtime) < $d) {
    $a = "$b by $c";
    return ($a,$b,$c,$d,$e);
  } else {
    return ($DEFAULT,$DEFAULT,'',0,'');
  }
}


sub frame {
  my $h = $_[0];        # frame ID
  my $f = $_[1];        # frame flags
  my $t = $_[2];        # frame text
  if (length($t) > 127) {
    ($t) = ($t =~ /(.{127})/);
    ($t) = ($t =~ /(.*)\;/);
    $t = "$t)";
  }
  my $l = 1 + length($t);
  my $s = &size($l);
  $h = $FRAME{$h};
  $l += 10;
  return ($l,"$h$s$f$t");
}


sub insert {
  my $a =  $_[0];
  my $b = '';
  my $c = '';
  my $d = '';
  ($b,$c,$d) = ($a =~ /(.*){{(.*)}}(.*)/);
  my $e = $b.$$c.$d;
  if ($e) {
    return $e;
  } else {
    return $a;
  }
}


sub log {
  my $b = $_[0];
  my $c = $_[1];
  my $d = $_[2];
  my $e = $_[3];
  my @t = ();
  my $dt = '';
# if (! ($b =~ /^Coming Up:/)) {
    @t = localtime(time);
    $t = sprintf("%02u",$t[2]).':'.sprintf("%02u",$t[1]).':'.
    sprintf("%02u",$t[0]);
    $dt = substr($t[5],1,2).sprintf("%02u",1 + $t[4]).
    sprintf("%02u",$t[3]);
    if (open(LOG,">>$LOG/$dt.txt")) {
      print (LOG "$t\t$b\t$c\t$d\t$e\n");
      close LOG;
    } elsif (open(LOG,">$LOG/$d.txt")) {
      print (LOG "$t\t$b\t$c\t$d\t$e\n");
      close LOG;
    } else {
      print "Can\'t open $LOG to write $b:$c:$d:$e\n";
    }
# }
}


sub pad {
  my $msg = $_[0];
  my $t = '';
  my $a = '';
  my $r = '';
  if ($msg =~ / by /) {
    ($t,$a) = ($msg =~ /(.*) by (.*)/);
  } else {
    $t = $msg;
    $a = '';  
    $r = '';
  }
  if (! $t) {
    ($t,$a,$r) = @PADDEFAULT;
  }
# print "title: $t; artist: $a; record: $r\n";
  my $msg = &tag(&frame('Title',$FLF,$t),&frame('Artist',$FLF,$a),
  &frame('Album',$FLF,$r));

# ==>   OPEN PAD PORT
  $MySocket=new IO::Socket::INET->new(PeerPort=>$PADPORT, Proto=>'udp',
  PeerAddr=>$EXCITER);

# ==>	SEND PACKET
  $MySocket->send($msg);

# ==>	CLOSE PAD PORT
  close $MySocket;
}


sub parse {
  my @a = &parse8($_[0]);
  my @b = ();
  my $x = '';
  my $y = '';
  while ($y = shift @a) {
    if ($x) {
      if (length("$x $y") < 9) {
        $x = "$x $y";
      } else {
        @b = (@b,$x);
        $x = $y;
      }
    } else {
      $x = $y;
    }
  }
  if ($x) {
    @b = (@b,$x);
  }
  return @b;
}


sub parse8 {

# ==>	BREAK MESSAGE INTO 8-CHARACTER SEGMENTS

  my $a = $_[0];
  my @a = &dictionary_lookup(split(' ',$a));
  my @w = ();
  while ($a = shift @a) {
    @w = (@w,&parse_word($a));
  }
  return @w;
}


sub parse_word {

# ==>	BREAK WORDS LONGER THAN 8 LETTERS INTO 8-LETTER SEGMENTS
# 	BREAK BEFORE LAST CONSONANT FOLLOWED BY A VOWEL

  my $w = shift();
  my @c = split ('',$w);
  my $c = '';
  my $pc = ' ';
  my $i = 0;
  my $k = 0;
  my $v = '';
  my @cc = ();
  while (defined ($c = shift @c)) {
    if ($i < 8) {
      $v .= $c;
      if ($i < 7) {
        if (&consonant($c)) {
          @cc = @c;
          if (! &consonant(shift(@cc))) {
            $k = $i;
          }
        }
      }
      $pc = $c;
      $i++;
    } else {
      if ($k == 0) {$k = 8}
      return (substr($v,0,$k),&parse_word(substr($w,$k,length($w)))); 
    }
  }
  return ($v);
}


sub rbds {
# ==>	RBDS SUBROUTINE
# 	(RT AMERICA UNIT)
#	Based on code written by Paul Haas, http://hamjudo.com.

# ==>	Set the serial port.
  open("portfh","+<$PORT") || die "opening $PORT for input: $!";

# ==>	SET SERIAL PORT PARAMETERS
  if (system("/bin/stty 9600 -echo cs8 -parenb -cstopb raw < $PORT")) {
    die "FAILED: stty 9600 -echo cs8 -parenb -cstopb raw < $PORT";
  }
  $msg = "$_[0]                                                                 ";
  ($msg) = ($msg =~ /(.{64}).*/);
  $msg = "RT,1,1,0,'$msg'\r\n"; 
  sendMsg("portfh",$msg);
  close("portfh");
}


sub rbds_scroll {

# ==>	RBDS PS SCROLL SUBROUTINE
# 	(RT AMERICA UNIT)
#	Based on code written by Paul Haas, http://hamjudo.com.

# ==>	Set the serial port.
  open("portfh","+<$PORT") || die "opening $PORT for input: $!";

# ==>	SET SERIAL PORT PARAMETERS
  if (system("/bin/stty 9600 -echo cs8 -parenb -cstopb raw < $PORT")) {
    die "FAILED: stty 9600 -echo cs8 -parenb -cstopb raw < $PORT";
  }
  $msg = "$_[0]                                                                 ";

# ==>	ADD STATION NAME
  $msg .= $STATION_NAME;

# ==>	BREAK MESSAGE INTO 8-CHARACTER SEGMENTS
  @msg = &parse($msg);
  while ($msg = shift @msg) {
    $msg =~ s/'/''/g;
    $msg = "PS,'$msg'\r\n"; 
    sendMsg("portfh",$msg);
  }
  close("portfh");
}


sub sendMsg {
  local($portfh, $msg) = @_;
  chomp $msg;
  $msg .= "\r";
  syswrite $portfh, $msg, length($msg);
  sleep $INTERVAL;
}


sub size {
  use integer;
  my $m = 0;
  my $n = $_[0];
  if (($m = $n / 128) > 0) {
    $n = 256 * $m + ($n - (128 * $m));
  }
  if (($m = $n / 32768) > 0) {
    $n = 65536 * $m + ($n - (32768 * $m));
  }
  if (($m = $n / 8388608) > 0) {
    $n = 16777216 * $m + ($n - (8388608 * $m));
  }
  return pack('N',$n);
}


sub tag {
  my @f = @_;
  my $t = '';
  my ($a,$l) = 0;
  while ($a = shift @f) {
    $t .= shift @f;
    $l += $a;
  }
  $l = &size($l);
  return "$MGC$ID$VER$FLT$l$t";
}


# ==>	MAIN PROGRAM

# ==>	SET VALUES
$DICTIONARY = '/home/nowplayd/rbds_dictionary.db';
$DEFAULT = 'WZZZ-FM';
$STATION_NAME = ' WZZZ-FM';
$LOG = '/home/nowplayd/log';
$OUTITLE = '/home/nowplayd/log/outitle.txt';
$DELAY = 24;	# There is a 24 second delay on the audio feed
$INTERVAL = 5;
$PORT = '/dev/ttyS0';
$FILE = '/var/www/rbds/rbds.txt';
@PADDEFAULT = ('91.9 FM','WZZZ','91.9 FM');
$EXCITER = '192.168.1.111';
$PADPORT = 10000;
$< = $>;	#real UID = effective UID

# ==>   MAGICAL INCANTATION
$MGC = chr(0x00).chr(0x00).chr(0x0a).chr(0x02).chr(0x00).chr(0x00).
chr(0x00).chr(0x00).chr(0x00).chr(0x00).chr(0x00).chr(0x00).
chr(0x00).chr(0x00).chr(0x51);

# ==>   TAG HEADER
$ID  = 'ID3';
$VER = chr(0x03).chr(0x00);
$FLT = chr(0x00);
$FLF = chr(0x00).chr(0x00).chr(0x00);
$Z   = chr(0x00);

# ==>   FRAME HEADERS
$FRAME{'Title'}      = 'TIT2';
$FRAME{'Artist'}     = 'TPE1';
$FRAME{'Album'}      = 'TALB';
$FRAME{'Genre'}      = 'TCON';
$FRAME{'Comment'}    = 'COMM';
$FRAME{'Commercial'} = 'COMR';
$FRAME{'Reference'}  = 'UFID';

if (open (OUTITLE,"<$OUTITLE")) {
  $outitle = <OUTITLE>;
  close OUTITLE;
}
if (! &already) {
  while (1) {
    if ($a = fork) {
#     print "Started updaterbds child process $a\n";
      wait();
    } else {
      &child_process_remote;
      die "Process terminated\n";
    }
  }
}