#!/usr/bin/env perl
use warnings;
use strict;

=head1 Synopsis

B<Turn Perl code into readable text for TTS>

inspired by http://www.perlmonks.org/?node_id=1099742

 Usage: code2words.pl [-t TABLE] [-o OUTPUTMODE] INPUT

C<INPUT> is any of Perl's normal C<E<lt>ARGVE<gt>> stuff.
Use C<-t ?> and C<-o ?> to see available options.
Currently C<-o> may not work with large inputs.

=cut

# note that the code below assumes all table keys are single chars
my %TABLES = (
    default => {split ' ', <<'END'},
        ! bang  " quote  # hash  $ dollar  % percent  & ampersand
        ' apostrophe  ( open_paren  ) close_paren  * star  + plus
        , comma  - dash  . dot  / slash  : colon  ; semicolon.
        < less_than  = equals  > greater_than  ? question  @ at
        [ open_bracket  \ backslash  ] close_bracket  ^ circumflex
        _ underscore  ` backtick  { open_brace  | pipe
        } close_brace  ~ tilde
END
    # by tye, http://www.perlmonks.org/?node_id=1099742
    tye => {split ' ', <<'END'},
        ! bang    | bong    @ bung    & dung
        $ bling   ^ sting   < bring   > brung
        ( sling   ) slung   [ cling   ] clung
        { fling   } flung   : sing    ; sung
        " string  ' strong  ` strang  ~ swing
        = rung    ? rang    . ding    , dang
        / slash   \ sash    - dash    _ lash
        # bash    * splash  % rash    + crash
END
    # by AppleFritter, http://www.perlmonks.org/?node_id=1099750
    AppleFritter => {split ' ', <<'END'},
        ! drink   | grave   @ me     & fiend
        $ gold    ^ trap    < up     > down
        ( tool    ) sword   [ mail   ] strange
        { font    } wet     : newt   ; fish
        " bling   ' clay    ` art    ~ worm
        = ring    ? scroll  . floor  , band
        / wand    \ throne  - wall   _ sanct
        # sink    * gem     % food   + book
END
);
# allow multi-word replacements by replacing _ with space in values
for (values %TABLES) { s/_/ /g for values %$_ }

my %OUTPUTS = (
    google => \&out_google,
    espeak => \&out_espeak,
    festival => \&out_festival,
);

use Getopt::Std 'getopts';
getopts('t:o:',\my %o);
die "No such table '$o{t}', available are: ",
    join(', ', keys %TABLES), "\n"
        if $o{t} && !exists $TABLES{$o{t}};
die "No such output '$o{o}', available are: ",
    join(', ', keys %OUTPUTS), "\n"
        if $o{o} && !exists $OUTPUTS{$o{o}};

my %table = %{$TABLES{default}};
%table = ( %table, %{$TABLES{$o{t}}} ) if $o{t};
my $search = '['.join('', map {quotemeta} keys %table).']';
$search = qr/$search/;

my @words;
while(<>) {
    chomp;
    s/($search)/ $table{$1} /g;
    push @words, grep {length} split;
}

if ($o{o}) {
    $OUTPUTS{$o{o}}->(\@words)
        or warn "Warning: Something went wrong with $o{o}\n";
}
else {
    local $,=" ";
    print @words;
    print "\n";
}

sub out_google {
    my ($words) = @_;
    # kinda hacky way to open a browser to Google, YMMV
    # see also Browser::Open and Speech::Google::TTS
    my $url = 'https://translate.google.com/#en/ja/'
        .join('+',@$words);
    my $cmd = 'x-www-browser';
    if ($^O eq 'darwin') { $cmd = 'open' }
    elsif ($^O eq 'MSWin32') { $cmd = 'start' }
    print STDERR "Attempting to open browser to Google, ",
        "press the \"Listen\" button when it opens\n";
    return system($cmd,$url)==0;
}

sub out_espeak {
    my ($words) = @_;
    return system('espeak',join(' ',@$words))==0;
}

use File::Temp 'tempfile';

sub out_festival {
    my ($words) = @_;
    my ($tfh,$tfn) = tempfile(UNLINK=>1);
    print $tfh join ' ', @$words;
    close $tfh;
    return system('festival','--tts',$tfn)==0;
}
[download]