#!/usr/bin/perl -w

$| =1;

####!/usr/bin/perl -w -d:ptkdb
####sub BEGIN { $ENV{'DISPLAY'} = "deanna:0.0"; };

#######################################################################
# OpenSource SpeechSynth by Stefan Marti, started May 2000.
#
# Verion 1.2: March 28. 2001:
#     + Runs now on a different machine, in frames
#     + Added documentation, log file access, and plan to release source
# Version 1.14: Feb 15, 2001:
#     + Words with "'" in them are now stored with a proper file name,
#       e.g., "can't" as "cant_t" ("'" can't be part of a UNIX file name)
# Version 1.13: Jan 29, 2001:
#     + Fixed bug with resultfile concatenation
# Version 1.12: Jan 25, 2001:
#     + Words of a vocabulary can be deleted
# Version 1.11: Jan 24, 2001:
#     + Allow "'" and some other special chars in new words 
#     + Example sentence "This is a good example to say hello!" only
#       if language is set to English.
# Version 1.1: Sept 26, 2000:
#     + Log file keeps track of all user actions
#     + Prevents users from uploading files bigger than 1MB
#     + Prevents users from submitting sentences longer than 500 characters
#     + Copies older audio files to backup files
#     + Keeps older resultfiles
# Version 1.0: July 13, 2000:
#     + Language switching is enabled
# Version 0.4:
#     + Different vocabulary list design
# Version 0.3:
#     + Noise gate for word samples, getting rid of leading
#       and trailing silence
# Version 0.2:
#     + All entries are visible immediately, without reloading
#     + Synthsize button sends back the WAV file directly
# 
########################################################################


use CGI qw(:standard :html3);

##new 7/13/2000
if (param('language'))  {

   $current_language = param('language');           # set the language variable
   print "Set-Cookie:language=$current_language\n"; # set the cookie
   &WriteLog("Switched language to \"$current_language\".");

}else{
    # read cookies
    if ($ENV{'HTTP_COOKIE'}) {
      @cookies = split (/;/,$ENV{'HTTP_COOKIE'});
      foreach $cookie (@cookies) {
        ($name, $value) = split (/=/, $cookie);
        $crumbs{$name} = $value;
      }
      $current_language = $crumbs{'language'};
    }else{
      $current_language = "english";
    }
}
##end new 7/13/2000


$hostname    = "http://www.media.mit.edu/~stefanm/osss/";

$audio_dir   = "audio/";
$image_dir   = "images/";

$www_audio   = $hostname  . $audio_dir . $current_language . "/";
$www_images  = $hostname  . $image_dir;
$result_url  = $www_audio . "_result.wav";

$html_path   = "/mas/speech/stefanm/public_html/osss/";

$langu_file  = $html_path. "_langu.txt"; ##new

$pause_file  = $html_path. $audio_dir . "_pause.wav";

$audio_path  = $html_path. $audio_dir . $current_language ."/";

$result_file = $audio_path. "_result.wav";
$vocab_file  = $audio_path. "_vocab.txt";



$bg             = $www_images . "background.jpg";
$logo           = $www_images . "logo2.jpg";

$dbug = 1;

$bytesread = 0;

$LOCK_EX           = 2;   # needed for locking
$LOCK_UN           = 8;   # needed for locking




if (param('submitsentence')) {

    &openaudiodir;


    if (-e $result_file) {
	$current_secs = time;
        $backup_resultfile = $result_file . "\." . $current_secs;
        `cp $result_file $backup_resultfile`;
        WriteLog("Before synthesizing new sentence, I copied\n   \"$result_file\" to\n   \"$backup_resultfile\"");
        unlink $result_file;

    }

    $thesentence = param('inputsentence');

    $sentence_length = length($thesentence);

    if ($sentence_length > 500) {
    
       print header();
       print start_html(-title=>"OpenSource SpeechSynth", 
                        -background=>$bg);
       print p("Sorry, this sentence is too long. For security reasons, I am not allowed to synthesize sentences that have more than 500 characters, and yours has $sentence_length. To go back, please press the BACK button on your browser.");
       print end_html();
       &WriteLog("REJECTED submitted sentence to synthesize, it is too long, $sentence_length characters:\n----------start rejected sentence----------\n$thesentence\n----------end rejected sentence--------");
       exit;
  
    }else{

      $thesentence = lc($thesentence);

      #new 2/15/2001
      $thesentence =~ s/\'/_/g;  # replace all "'" with "_" ("_" will not split)
      #end 2/15/2001

      @textarray = split(/\b/, $thesentence);

       for ($t=0; $t <= $#textarray; $t++) {
         if ($textarray[$t] =~ /^\.|\,|\;|:/) {
             $textarray[$t] = "_pause";
         }
       }

      $firstword  = 1;

      $noiseg = 0;
      $noiseg = int(param('noisegate'));

      &WriteLog("Submitted sentence to synthesize (noisegate is \"$noiseg\"):\n   \"$thesentence\".");

      foreach $a_single_word (@textarray) {

            #new 2/15/2001
            # &WriteLog("Checking word \"$a_single_word\" (1).");
            $a_single_word =~ s/_/\'/g;   # set back all "_" to "'"
            # &WriteLog("Checking word \"$a_single_word\" (2).");
            #end 2/15/2001

	if (exists($allfiles{$a_single_word})) { 

            #new 2/15/2001
            # &WriteLog("-->Coool! Word \"$a_single_word\" exists as a file!");
            $a_single_word =~ s/\'/_/g;  # and setting again all "'" back to "_"
            #end 2/15/2001

	    $file_to_add = $audio_path . $a_single_word . ".wav";

            # &WriteLog("Adding file \"$file_to_add\"!");

            if ($firstword) {
		`perl concat_first.perl $file_to_add $result_file $noiseg`;
                $firstword  = 0;
            }else{
                if ($file_to_add =~ /_pause/) {  # don't eliminate pause!
                  `perl concat_noiseg.perl $result_file $pause_file $result_file 0`;
	        }else{
                  `perl concat_noiseg.perl $result_file $file_to_add $result_file $noiseg`;
                }
	    }
        }else{
           #if ($a_single_word !~ /^\s$/) {
           #   $file_to_add = $audio_path .  "_pause.wav";
           #   `perl concat_noiseg.perl $result_file $file_to_add $result_file 0`;
	   #}
        }
      } # end of loop through all words

      if (-e $result_file) {
         `chmod 744 $result_file`;
         $file_size = (-s $result_file);
         &WriteLog("Length of result file is $file_size bytes.");
         print redirect(-type=>'audio/x-wav',
                        -expires=>'now',
                        -location=>$result_url);
      }else{
         print header();
         print start_html(-title=>"OpenSource SpeechSynth", 
                          -background=>$bg);
         print p("Sorry, there is no synthesized file. You probably have asked me for a sentence with all words that I have never heard of. To go back, please press the BACK button on your browser.");
         print end_html();
         &WriteLog("There was no result file to send back!?");
         exit;
      }
   } # end of If sentence is not longer than 500 characters
 
}else{


# Normal web page starts here:

print header(), start_html(-title=>"OpenSource SpeechSynth.", 
                           -background=>$bg);

print "<STYLE TYPE=\"text/css\">
<!--
A:ACTIVE {text-decoration:none; background:\#d0d0a0}
A:LINK, A:VISITED {text-decoration:none}
H2 {font-family:Helvetica, Arial, sans-serif; font-size:large}
H3 {font-family:Helvetica, Arial, sans-serif; font-size:medium}
H4 {font-family:Helvetica, Arial, sans-serif; font-size:x-small}
P, FORM {font-family:Helvetica, Arial, sans-serif; font-size:small}
TD {font-family:Helvetica, Arial, sans-serif; font-size:small; white-space:nowrap; vertical-align:top}
-->
</STYLE>";

print "<h2>Welcome the OpenSource SpeechSynth!</h2><p>This project is based on the idea that everybody can contribute to a fully Web based speech synthesizer for languages without existing commercial speech synthesizers. The synthesis is on word level. Everybody can contribute sound files for the vocabulary of this synthesizer. Just look down what words are still missing, record a WAV soundfile for it, and upload it to this web page! If there are enough soundfiles for words, you can submit any text, and this synthesizer will send you back the sound file. (Words that are not (yet) in the vocabulary are just ignored.)";

print "<p>If you would like to know more about this project, please have a look at the <a href='http://www.media.mit.edu/~stefanm/osss/OpenSourceSpeechSynthesizer.pdf' target=\"_blank\">project report (.PDF)</a>";

print "<p>This is OpenSource SpeechSynth Version 1.2 of March 28, 2001. [<a href='http://www.media.mit.edu/~stefanm/osss/versions.txt' target=\"blank\">version history (.TXT)</a>]</p>\n";


print br;

if (open(LANGU, "<$langu_file")) {
    flock(LANGU, $LOCK_EX);
    while ($line = <LANGU>) {
	chomp $line;           # take the endchar off
        ($lang_dir, $lang_name) = split(/\t/, $line);
        $lang_dir =~ s/\s//g;  # erase all space characters
        $lang_dir =~ s/\W//g;  # erase all non-word characters
        $languages{$lang_dir} = $lang_name;
    }
    flock(LANGU, $LOCK_UN);
    close LANGU;
  }else{ # end of If open successful
    print "WARNING: I can't read $langu_file: $!\n";
    print "I will try to continue with the default values\n";
    # such as??
} # end of If open fails


if (param('submit_new_language')) {
  $the_new_language = param('new_language');

  &WriteLog("Submitted new language \"$the_new_language\".");
  $the_new_language = "\u$the_new_language";      # make first letter uppercase
  $new_language_dir = $the_new_language;
  $new_language_dir = lc($new_language_dir);      # lowercase
  $new_language_dir =~ s/\W//g;                   # erase all non-word characters
  $new_language_dir =~ s/\_//g;                   # erase all underscore
  $new_language_dir =~ s/\s//g;                   # erase all space
  if (!(exists($languages{$new_language_dir}))) { # that's a new entry!
      $languages{$new_language_dir} = $the_new_language;  # add entry to hash
      open (LANGU, ">$langu_file");               # write to _langu.txt
      flock(LANGU, $LOCK_EX);
         foreach $alanguage (sort byvalue keys %languages) {
           print LANGU "$alanguage\t", $languages{$alanguage},"\n";
         }
         flock(LANGU, $LOCK_UN);
         close LANGU;
         `chmod 744 $langu_file`;
  }else{ # end of It's a new entry 
      WriteLog("REJECTED newly submitted language \"$the_new_language\": already there!");
  }

} # end of param submint_new_language

print start_form;
print "Now, what language would you like to work on: &nbsp;&nbsp;&nbsp;";
print "<SELECT NAME='language'>";

sub byvalue { $languages{$a} cmp $languages{$b}; }

foreach $alanguage (sort byvalue keys %languages) {
    if ($alanguage eq $current_language)  {
       print "<option selected value='",$alanguage,"'>",$languages{$alanguage},"\n";
    }else{
       print "<option value='",$alanguage,"'>",$languages{$alanguage},"\n";
    }
}

print "</SELECT>";
print submit(-name=>'submitlanguage',
             -value=>'1',
             -label=>'Switch language');
print end_form;

print start_form;
print "Couldn't find your language? No problemo, add it!  ";
print textfield(-name=>'new_language',
                -default=>'',
                -size=>14,
                -maxlength=>50);
print submit(-name=>'submit_new_language',
             -value=>'1',
             -label=>'Add my language!');
print end_form;


# Take a WAV file and store it 

if (param('upload')) {

   $filename_upload = param('upload');
   $which_word      = param('wordupload');

#new 2/15/2001
   #print "<br><br>Word to upload is (1): '$which_word'.\n";
   $which_word =~ s/\'/_/g;  # transform "'" to "_", so that they can be part of the file name
   #print "<br><br>Word to upload is (2): '$which_word'.\n";
#end 2/15/2001

   $upload_filesize = (-s $filename_upload);

   if ($upload_filesize > 1000000) {
     print "<br><h2>Sorry, the file you just wanted to upload is too big!<br>I can't accept files bigger than 1 Megabyte!<br>Your file \"$filename_upload\" would be $upload_filesize bytes!</h2><br>\n";
     WriteLog("REJECTED file to upload: too big, $upload_filesize bytes.\n   File name was: \"$filename_upload\".\n   It was supposed for \"$which_word\" in language \"$current_language\".");

   }else{ 

     if (!($which_word =~ /^--/))  {
  
       $filename_save   = $audio_path . $which_word . "\.wav";

       if (-e $filename_save) {
	   $current_secs = time;
           $backup_filename = $filename_save . "\." . $current_secs;
           `cp $filename_save $backup_filename`;
           WriteLog("Before uploading, I copied\n   \"$filename_save\" to\n   \"$backup_filename\"");
       }

       open (NEWFILE, ">$filename_save");
       flock(NEWFILE, $LOCK_EX);

       while ($bytesread = read($filename_upload, $buffer, 1024)) {
          print NEWFILE $buffer;
       }
       flock(NEWFILE, $LOCK_UN);
       close NEWFILE;

       print "<br><br>Just uploaded: $filename_upload<br>\n" if ($dbug);
       print "And saved in: $filename_save<br>\n" if ($dbug);

       $resultfile_size = (-s $filename_save);

       &WriteLog("New soundfile for word \"$which_word\" in language \"$current_language\":\n   Uploaded file name: \"$filename_upload\", saved under\n   \"$filename_save\",\n   file length is $resultfile_size bytes.");

     } # end of If word is not "--"
  } # end of If file size is not too big
} # end of parameter "upload"


# Read the files we already have from the directory
# and put them in an array and a hash

&openaudiodir;

sub openaudiodir {

  if (!(opendir(DIR, $audio_path)))  {
      mkdir($audio_path, 0777);
      `touch $vocab_file`;
      `chmod 744 $vocab_file`; 
  }

  opendir(DIR, $audio_path) or die "Can't open $audio_path: $! \n";
  @files = readdir(DIR);
  closedir(DIR);

  foreach $file (@files) {
    if (($file ne "..") && ($file ne ".") && ($file =~ /\.wav$/i) && ($file !~ /^\_/)) {

      $path_and_file = $www_audio . $file;           # create full URL
      $file_noextension = $file;
      $file_noextension =~ s/^(.*)\..*?$/$1/i;       # remove extension
      $file_noextension = lc($file_noextension);     # lowercase it

      #new 2/15/2001
      $file_noextension =~ s/\_/\'/g;  # replace all "_" with "'"
      #end 2/15/2001

      $allfiles{$file_noextension} = $path_and_file; # create the hash:
                 # key = "can't"
                 # value = http://hyperdrive.media.mit.edu/speechsynth/audio/english/can_t.wav
    }
  }
}


# Load vocabulary file

&LoadVocabularyFile;


sub LoadVocabularyFile {

  @words = ();  # empty and initialize it
  if (open(VOCAB, "<$vocab_file")) {
      flock(VOCAB, $LOCK_EX);
      while ($line = <VOCAB>) {
	  chomp $line;        # take the endchar off
          $line = lc($line);  # lowercase everything
          #$line =~ s/\W//gis; # erase all nonword characters
          push(@words, $line);
      }
      flock(VOCAB, $LOCK_UN);
      close VOCAB;
  }else{ # end of If open successful
     print "WARNING: I can't read $vocab_file: $!\n";
      print "I will try to continue with the default values\n";
      @words = ("food","bad","sleep","am","are","hello","bye","say","i","you","example","for","a","an","to","is", "good");
  } # end of If open fails

} # end of sub LoadVocabularyFile


# Modify vocabulary if necessary

# Add new word
if (param('submit_new_word')) {
  $the_new_words = param('new_word');
  &WriteLog("Submitted new word(s) \"$the_new_words\" for language \"$current_language\".");
  $the_new_words = lc($the_new_words); # lowercase them

  @new_word_list = split(/\s/, $the_new_words);
  foreach $new_word (@new_word_list) {

     #$new_word =~ s/\W//g;  # erase all non-word characters # problem: erases "'" too...

     # let's do it the hard way:
     $new_word =~ s/\,//g; 
     $new_word =~ s/\.//g; 
     $new_word =~ s/\///g; 

     $new_word =~ s/\<//g; 
     $new_word =~ s/\>//g; 
     $new_word =~ s/\?//g; 

     $new_word =~ s/\;//g; 
     #$new_word =~ s/\'//g; 
     $new_word =~ s/\://g; 
     $new_word =~ s/\"//g; 

     $new_word =~ s/\[//g; 
     $new_word =~ s/\]//g; 
     $new_word =~ s/\\//g; 

     $new_word =~ s/\{//g; 
     $new_word =~ s/\}//g; 
     $new_word =~ s/\|//g; 

     $new_word =~ s/\~//g; 
     #$new_word =~ s/\`//g; 

     $new_word =~ s/\!//g; 
     $new_word =~ s/\@//g; 
     $new_word =~ s/\#//g; 
     $new_word =~ s/\$//g; 
     $new_word =~ s/\%//g; 
     $new_word =~ s/\^//g; 
     #$new_word =~ s/\&//g; 
     $new_word =~ s/\*//g; 
     $new_word =~ s/\(//g; 
     $new_word =~ s/\)//g; 
     $new_word =~ s/\_//g;
     #$new_word =~ s/\+//g;
     $new_word =~ s/\=//g; 
     $new_word =~ s/\_//g; 


     $is_new = 1;
     foreach $word (@words) {
	if ($new_word eq $word) { $is_new = 0; }
     }
     if ($is_new)  {
	 push(@words, $new_word);
         open (VOCAB, ">$vocab_file");
         flock(VOCAB, $LOCK_EX);
         foreach $word (@words) {
	    print VOCAB "$word\n";
         }
         flock(VOCAB, $LOCK_UN);
         close VOCAB;
         `chmod 744 $vocab_file`;      
     }else{
         &WriteLog("REJECTED newly submitted word \"$new_word\" for language \"$current_language\": it's already there!");
     } # end of Not a new word!
  } # end of Loop through all newly submitted words
} # enf of If param submit_new_word


# Delete word
if (param('delete_word')) {
  $the_word_to_delete = param('worddelete');
  &WriteLog("Deleted word \"$the_word_to_delete\" from language \"$current_language\".");

  # write the vocabulary file, except the word that has to be deleted
  open (VOCAB, ">$vocab_file");
  flock(VOCAB, $LOCK_EX);
  foreach $word (@words) {
     if ($word ne $the_word_to_delete) {
        print VOCAB "$word\n";
     }
  }
  flock(VOCAB, $LOCK_UN);
  close VOCAB;
  `chmod 744 $vocab_file`;  

  # reload the vocabulary file into the @words list
  &LoadVocabularyFile

} # enf of If param delete_word


@words = sort @words;

# Create the table with all words and if we have files for them!

print hr;
print br;
print h2("Vocabulary list of $current_language");
print p("Click on the words with links: they have already a sound file associated with. The other words of this vocabulary still have no sound file.");

print "<table border=1><tr><td>\n";

print "<table border=1>\n";
foreach $alpha ('A' .. 'I'){
  print "<tr><td><b>$alpha</b></td><td>";  
  foreach $word (@words) {
    if ($word =~ /^$alpha/i) {
      if (exists($allfiles{$word})) {  # if word exists as file
         print "<a href='$allfiles{$word}' target='_blank'>$word</a>&nbsp;";
      }else{
         print "$word&nbsp;";
      }
    }
  }
  print "&nbsp;</td></tr>";
}
print "</table>\n";

print "</td><td>\n";

print "<table border=1>\n";
foreach $alpha ('J' .. 'R'){
  print "<tr><td><b>$alpha</b></td><td>";  
  foreach $word (@words) {
    if ($word =~ /^$alpha/i) {
      if (exists($allfiles{$word})) {  # if word exists as file
         print "<a href='$allfiles{$word}' target='_blank'>$word</a>&nbsp;";
      }else{
         print "$word&nbsp;";
      }
    }
  }
  print "&nbsp;</td></tr>";
}
print "</table>\n";

print "</td><td>\n";

print "<table border=1>\n";
foreach $alpha ('S' .. 'Z'){
  print "<tr><td><b>$alpha</b></td><td>";  
  foreach $word (@words) {
    if ($word =~ /^$alpha/i) {
      if (exists($allfiles{$word})) {  # if word exists as file
         print "<a href='$allfiles{$word}' target='_blank'>$word</a>&nbsp;";
      }else{
         print "$word&nbsp;";
      }
    }
  }
  print "&nbsp;</td></tr>";
}
print "</table>\n";


print "</tr></table>\n";

print start_form;
print "Want to expand this vocabulary? Sure, add word(s) here:  ";
print textfield(-name=>'new_word',
                -default=>'',
                -size=>14,
                -maxlength=>100);
print submit(-name=>'submit_new_word',
             -value=>'1',
             -label=>'Add word(s)!');
print end_form;


print start_form;
print "Accidentally added a misspelled word? Delete it here:   ";
print "<SELECT NAME='worddelete'>\n";
print "<option value='--'>--Select a word!--\n";
foreach $aword (@words) {
  if (!(exists($allfiles{$aword}))) {  # if word doesn't have a sound file
    print "<option value=\"",$aword,"\">",$aword,"\n";
  }
}
print "</SELECT>";

print submit(-name=>'delete_word',
             -value=>'1',
             -label=>'Delete word');
print end_form;



print hr;
print h2("Upload area");
print p("If you want to add a soundfile for a word in the above vocabulary list, record it, e.g., with Microsoft SoundRecorder. Store it on your hard drive as a WAV file 16-bit, stereo, 44kHz (only this works right now). Then choose in the drop down menu the word, browse on your hard drive to choose the sound file, and upload it!");

print "<form method=post enctype=multipart/form-data>";
print "For which word do you want to upload a sound? ";
print "<SELECT NAME='wordupload'>\n";
print "<option value='--'>--Select a word!--\n";
foreach $aword (@words) {
   print "<option value=\"",$aword,"\">",$aword,"\n";
}
print "</SELECT><br><br>";

print "What is the sound file? ";
print filefield(-name=>'upload',-size=>20,-maxlength=>80);
print br;
print br;
print "<center>";
print submit(-name=>'And finally: Upload the file!');
print "</center>";
print end_form;

print hr;
print h2("What text would you like to have synthesized?");
print p("I can only say the words in my vocabulary, all other words in your sentence will be ignored.</b>");
print start_form;

if ($current_language eq "english") {
  print textarea(-name=>'inputsentence',
                          -default=>'This is a good example to say hello!',
                          -rows=>5,
                          -columns=>40);
}else{
    print textarea(-name=>'inputsentence',
                          -default=>'',
                          -rows=>5,
                          -columns=>40);
}

print submit(-name=>'submitsentence',
             -value=>'1',
             -label=>'Synthesize it!');
print "<br><b>Eliminating pauses:</b> I have some processing capabilities built in. I can eliminate silent parts at the beginning and end of each word. Sentences usually sound better with shorter pauses.<br>Reduce pauses ";
print "<input type=radio name=noisegate value=0>not";
print "<input type=radio name=noisegate value=2000>a little";
print "<input type=radio name=noisegate value=4000 checked>more";
print "<input type=radio name=noisegate value=6000>quite some";
print "<input type=radio name=noisegate value=8000>a lot";
print end_form;


print br, br, hr;

print h3("Current soundfiles in my directory:\n");

foreach $word (keys %allfiles) { 
     print "<a href='$allfiles{$word}' target='_blank'>$word--";
}

print "<br><br><hr>";
print "<h4>Copyright &copy; 2000 - 2001 by <A href='http://www.media.mit.edu/~stefanm' target=_blank>Stefan Marti</A> and <A href='http://www.media.mit.edu' target=_blank>MIT Media Lab</A>, especially <A href='http://www.media.mit.edu/~dkroy' target=_blank>Deb Roy</A>. All rights reserved. Please send me <a href='mailto:stefanm\@media.mit.edu'>comments</a>!</h4>";


print end_html();

} # end of If it is normal HTML page


sub WriteLog {

  $theaction    = $_[0];
  $thesecs      = time;
  $thedate      = localtime($thesecs);
  $activity_log = "/mas/speech/stefanm/public_html/osss/activity.log";


  if (open(LOG, ">>$activity_log")) {
     flock(LOG, $LOCK_EX);
     print LOG "$thedate: $ENV{'REMOTE_HOST'} $ENV{'REMOTE_ADDR'}\n   $theaction\n";
     flock(LOG, $LOCK_UN);
     close LOG;
  }

} # end sub WriteLog