#!/usr/bin/perl -w
use strict;
use warnings;
use Data::Dumper;
use Speech::Synthesis;
use Getopt::Easy;             # Exports: get_options() and %O


my $engine  = 'SAPI5'; # SAPI5|'SAPI4'|'MSAgent'|'MacSpeech'|'Festival
+' 
my @voices  = Speech::Synthesis->InstalledVoices( engine => $engine);
my @avatars = Speech::Synthesis->InstalledAvatars(engine => $engine);
my $ss;

### ===========================================================
### void test_voices(void)
### ===========================================================
sub test_voices {
   
   foreach my $voice (@voices) {
      
      # Construct new Speech::Synthesis object ($ss)
      my %params = (  engine   => $engine,
                      avatar   => undef,
                      language => $voice->{language},
                      voice    => $voice->{id},
                      async    => 0
                   );
      my $ss = Speech::Synthesis->new( %params );
      
      # Print Voice info and speak description
      print "\n\tId\t=\t"     .  $voice->{id},
            "\n\tName\t=\t"   .  $voice->{name},
            "\n\tVoice\t=\t"  .  $voice->{description},
            "\n\tLang.\t=\t"  .  $voice->{language},
            "\n\tGender\t=\t" .  $voice->{gender},
            "\n\tAge\t=\t"    .  $voice->{age};
      $ss->speak($voice->{description}|| "test");
    }
}


### ===========================================================
### ss set_voice(name)
### ===========================================================
sub set_voice {
   my $name = shift || 'Default';
   
   # Build hash of available voices (name->id, cf. test_voices)
   my $reg = 'HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Speech\Voices\Toke
+ns';
   my %voices = (
      ATTCrystal  => $reg . '\ATT-DT-14-Crystal16',
      ATTMike     => $reg . '\ATT-DT-14-Mike16',
      CMUKal      => $reg . '\CMUKal',
      MSMary      => $reg . '\MSMary',
      MSMike      => $reg . '\MSMike',
      MSSam       => $reg . '\MSSam',
      Default     => $reg . '\ATT-DT-14-Crystal16',
   );
   
   # lookup name->id, and set $voice_id
   my $voice_id = $voices{Default};
   foreach my $key (sort keys %voices) {
      if ($key =~ /$name/i) { $voice_id = $voices{$key}; last; }
   }
   
   # Construct new Speech::Synthesis object ($ss) for $voice_id
   my %params = (
      engine   => $engine,
      voice    => $voice_id,
      async    => 0
   );
   $ss = Speech::Synthesis->new( %params );
}


### ===========================================================
### IO
### ===========================================================
sub is_interactive {     # called from shell (1) or via pipe (0) ?
   return -t STDIN && -t STDOUT;
}

sub slurp_STDIN {       # return piped stream as string
   local($/); return <STDIN>;
}


### ===========================================================
### unit test
### ===========================================================
=cut
test_voices();

set_voice('ATTMike');
$ss->speak("hello Mike");
set_voice('ATTCrystal');
$ss->speak("hello Crystal");
=cut


### ===========================================================
### main
### ===========================================================
get_options "v-voice=", "usage: say [-v voice] sentence";
# print Dumper(\%O);

set_voice($O{voice});
my $sentence = is_interactive() ? shift : slurp_STDIN;
$sentence ||= "Please provide a text to speak!";

$ss->speak($sentence);
[download]