#!/usr/bin/perl -w
# Copyright © 2002, 2003, 2004, 2005 Jamie Zawinski <jwz@dnalounge.com>
#
# Converts infoline.sable to infoline.mp3 for use as the phone announcement.
#
# Permission to use, copy, modify, distribute, and sell this software and its
# documentation for any purpose is hereby granted without fee, provided that
# the above copyright notice appear in all copies and that both that
# copyright notice and this permission notice appear in supporting
# documentation.  No representations are made about the suitability of this
# software for any purpose.  It is provided "as is" without express or 
# implied warranty.
#
# Created:  6-Apr-2002.

require 5;
use diagnostics;
use strict;
use POSIX;

my $progname = $0; $progname =~ s@.*/@@g;
my $exec_dir = $0; $exec_dir =~ s@/[^/]*$@@g;
my $version = q{ $Revision: 1.15 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/;

my $verbose = 0;

$ENV{PATH} = ("$exec_dir:" .
              "/opt/local/bin:" .
              "/sw/bin:" .
              $ENV{PATH});

my $busy = "$exec_dir/fastbusy.mp3";

my $tmp_sable = "/tmp/infoline.sable";
my $tmp_wave  = "/tmp/infoline.wav";

my @mp3_encoder = ("lame", "--quiet",
                   "-a", "-m", "mono",
                   "-h", "--cbr", "-b", "32");

my @mp3_tagger  = ("id3tag",
                   "--artist=" . "DNA Lounge Infoline Robot",
                   "--song="   . strftime ("%a, %b %d %l:%M %p", localtime),
                   "--year="   . strftime ("%Y", localtime),
                   "--genre="  . "101",
                   );

my $max_length = ((60 * 3) - 10);   # a bit less than three minutes

#my $converter = "text2wave";

my @play_effects = ();
#@play_effects = ("echo", "0.8", "0.9", "100.0", "0.3");


# delete all the tmp files we may have written
sub cleanup() {
  my @files = ($tmp_sable, $tmp_wave);
  if ($verbose > 3) {
    foreach (@files) {
      print STDERR "$progname: rm $_\n" if (-e $_);
    }
  }
  unlink @files;
}

sub signal_cleanup($) {
  my ($sig) = @_;
  cleanup;
  exit 1;
}

sub catch_signals() {
  $SIG{HUP}  = \&signal_cleanup;
  $SIG{INT}  = \&signal_cleanup;
  $SIG{QUIT} = \&signal_cleanup;
  $SIG{ABRT} = \&signal_cleanup;
  $SIG{KILL} = \&signal_cleanup;
  $SIG{TERM} = \&signal_cleanup;
}


# like system() but checks errors, and calls cleanup if there was one.
#
sub clean_system(@) {
  my (@cmd) = @_;

  print STDERR "$progname: executing " . join(' ', @cmd) . "\n"
    if ($verbose > 3);

  system @cmd;
  my $exit_value  = $? >> 8;
  my $signal_num  = $? & 127;
  my $dumped_core = $? & 128;
  cleanup() if ($exit_value || $signal_num || $dumped_core);
  error ("$cmd[0]: core dumped!") if ($dumped_core);
  error ("$cmd[0]: signal $signal_num!") if ($signal_num);
  error ("$cmd[0]: exited with $exit_value!") if ($exit_value);
}


# creates $tmp_wav with the given text.
#
sub generate_wav($$$) {
  my ($head, $body, $tail) = @_;

  my @events = split ("\n\n", $body);
  my $events = $#events+1;

  $body = "$head\n$body\n$tail";
  $body =~ s/\n\n+/\n/gs;

  my @lines = split ("\n", $body);
  my $lines = $#lines + 1;

  print STDERR "$progname: converting $lines lines of text " .
               "($events events) to audio... "
    if ($verbose);
  print STDERR "\n" if ($verbose > 1);

  cleanup();

  local *OUT;
  open (OUT, ">$tmp_sable") || error ("writing $tmp_sable: $!");
  print OUT $body;
  close OUT;
  print STDERR "$progname: wrote $tmp_sable\n" if ($verbose > 2);

  my @cmd = ("say",
             "-o",     $tmp_wave,
             "-f",     $tmp_sable);

  clean_system (@cmd);
  unlink ($tmp_sable);

  print STDERR "done.\n" if ($verbose);
}


# creates $tmp_wav with the given text.
# ensures that it is shorter than $max_length seconds.
# errors out if that is not possible.
#
sub generate_short_wav($$$) {
  my ($head, $body, $tail) = @_;

  while (1) {

    generate_wav ($head, $body, $tail);

    my @st = stat($tmp_wave);
    my $bytes = $st[7];

#    $_ = `file $tmp_wave`;
#    my ($bps, $hz) = m/\b(\d+) bit.*\b(\d+) Hz\b/;
#    error ("no output") unless ($hz);
#    my $secs = $bytes / (($bps / 8) * $hz);
    my $secs = $bytes / 44287;  #### kludge. by inspection...

    my $ssecs = sprintf ("%d:%02d", int($secs / 60), ($secs % 60));

    if ($max_length == 0 || $secs < $max_length) {
      print STDERR "$progname: audio length ok: $ssecs\n" if ($verbose > 1);
      last;
    } else {
      my $n = $secs - $max_length;
      my $nn = sprintf ("%d:%02d", int($n / 60), ($n % 60));
      print STDERR "$progname: audio is $ssecs, which is too long by $nn!\n"
        if ($verbose);

      # take the last paragraph off the body and try again.

      if ($body =~ m/^(.*\n)\n(.*?)$/s) {
        $body = $1;
        $_ = $2;
        s/\n.*$//s;   # delete all but first line
          s/<.*?>//gs;  # lose sable tags
        print STDERR "$progname: deleting final event, \"$_\".\n"
          if ($verbose);
      } else {
        error ("out of text?  even one event is too long?");
      }
    }
  }
}


# generates MP3 audio for the given text.
#
sub write_mp3($$$$) {
  my ($head, $body, $tail, $outfile) = @_;

  generate_short_wav ($head, $body, $tail);

  my @cmd = (@mp3_encoder, $tmp_wave, $outfile);
  $ENV{TERM} = 'dumb';
  clean_system (@cmd);
  cleanup();

  print "$progname: cat $busy >> $outfile\n" if ($verbose > 3);
  system ("cat $busy >> $outfile");

  # id3tag 3.8.3 writes a bunch of noise to stdout, so discard that
  # by redirecting stdout, then putting it back.  We do it this way
  # instead of just doing system("... >/dev/null") so that we don't
  # have to worry about shell-quoting the arguments to the command.
  #
#  local *OLDOUT;
#  if ($verbose <= 2) {
#    open OLDOUT, ">&STDOUT"   || error ("can't dup STDOUT: $!");
#    open STDOUT, ">/dev/null" || error ("can't dup STDOUT: $!");
#  }
#
#  @cmd = (@mp3_tagger, $outfile);
#  clean_system (@cmd);
##
#  if ($verbose <= 2) {
#    open STDOUT, ">&OLDOUT"   || error ("can't restore STDOUT: $!");
#  }

  print STDERR "$progname: wrote $outfile\n" if ($verbose);
}


# Converts the given Sable file to an MP3 file.
#
sub infoline($$) {
  my ($infile, $outfile) = @_;
  my ($head, $tail, $body);

  cleanup();

  $body = '';
  local *IN;
  open (IN, "<$infile") || error ("$infile: $!");
  while (<IN>) { $body .= $_; }
  close IN;
  print STDERR "$progname: read $infile\n" if ($verbose);

  $body =~ s/[ \t]+$//gm;

  if ($body =~ m/^(.*?\n)\n(.*\n)\n(.*?)$/s) {
    ($head, $body, $tail) = ($1, $2, $3);
  } else {
    error ("no text in $infile!");
  }

  write_mp3 ($head, $body, $tail, $outfile);
}


sub error($) {
  my ($err) = @_;
  print STDERR "$progname: $err\n";
  exit 1;
}

sub usage() {
  print STDERR "usage:  $progname [--verbose]\n" .
     "\t\t\t[--no-max] infile.sable outfile.mp3\n\n";
  exit 1;
}

sub main() {
  my $infile;
  my $outfile;
  while ($_ = $ARGV[0]) {
    shift @ARGV;
    if ($_ eq "--verbose") { $verbose++; }
    elsif (m/^-v+$/) { $verbose += length($_)-1; }
    elsif ($_ eq "--no-max") { $max_length = 0; }
    elsif (m/^-./) { usage; }
    elsif (!defined($infile))  { $infile  = $_; }
    elsif (!defined($outfile)) { $outfile = $_; }
    else { usage; }
  }
  usage unless defined($outfile);

  infoline ($infile, $outfile);
}

main();
exit 0;