Merge branch 'master' of git+ssh://github.com/adefaria/clearscm
[clearscm.git] / lib / Speak.pm
1 =pod
2
3 =head1 NAME $RCSfile: Speak.pm,v $
4
5 Convert text to speach using Google's engine and play it on speakers
6
7 =head1 VERSION
8
9 =over
10
11 =item Author
12
13 Andrew DeFaria <Andrew@DeFaria.com>
14
15 =item Revision
16
17 $Revision: 1.0 $
18
19 =item Created
20
21 Wed 24 Feb 2021 11:05:36 AM PST
22
23 =item Modified
24
25
26 =back
27
28 =head1 SYNOPSIS
29
30 This module offers subroutines to convert text into speach and speak them.
31
32 =head2 DESCRIPTION
33
34 This module exports subroutines to process text to speach and speak them.
35
36 =head1 ROUTINES
37
38 The following routines are exported:
39
40 =cut
41
42 package Speak;
43
44 use strict;
45 use warnings;
46
47 use base 'Exporter';
48
49 use FindBin;
50 use Clipboard;
51
52 use lib "$FindBin::Bin/../lib";
53
54 use Display;
55 use Logger;
56 use Utils;
57
58 our @EXPORT = qw(speak);
59
60 sub speak (;$$) {
61   my ($msg, $log) = @_;
62
63 =pod
64
65 =head2 speak($msg, $log)
66
67 Convert $msg to speach.
68
69 Note this currently uses an external script to do the conversion. I intend to
70 re-write that into Perl here eventually.
71
72 Parameters:
73
74 =for html <blockquote>
75
76 =over
77
78 =item $msg:
79
80 Message to speak. If $msg is defined and scalar then that is the message
81 to speak. If it is a file handle then the text will be read from that file.
82 Otherwise the text in the clipboard will be used.
83
84 =item $log
85
86 If provided, errors and messages will be logged to the logfile, otherwise stdout
87
88 =back
89
90 =for html </blockquote>
91
92 Returns:
93
94 =for html <blockquote>
95
96 =over
97
98 =item Nothing
99
100 =back
101
102 =for html </blockquote>
103
104 =cut
105
106   if (-f "$FindBin::Bin/shh") {
107     $msg .= ' [silent]';
108     if ($log) {
109       $log->msg($msg);
110     } else {
111       verbose $msg;
112     } # if
113
114     return;
115   } # if
116
117   # Handle the case where $msg is not passed in. Then use the clipboard;
118   $msg = Clipboard->paste unless $msg;
119
120   # Handle the case where $msg is a filehandle
121   $msg = <$msg> if ref $msg eq 'GLOB';
122
123   # We can't have two speakers going at the same time so if we have an error
124   # backoff a little and try again.
125   my $attempts   = 0;
126   my $maxretries = 3;
127   my $backoff    = 2;
128
129   my ($status, @output);
130
131   while ($attempts++ < $maxretries) {
132     ($status, @output) = Execute "/usr/local/bin/gt \"$msg\"";
133
134     if ($status) {
135       my $errmsg = "Unable to speak (Status: $status) - " . join "\n", @output;
136
137       if ($log) {
138         $log->err($errmsg);
139       } else {
140         error $errmsg;
141       } # if
142
143       sleep $backoff++;
144     } else {
145       return; # We said our piece...
146     } # if
147   } # while
148
149   my $errmsg = 'Maximum retries exceeded - terminating';
150
151   if ($log) {
152     $log->err($errmsg, $status);
153   } else {
154     error $errmsg, $status;
155   } # if
156
157   return;
158 } # speak
159
160 1;
161
162 =pod
163
164 =head1 CONFIGURATION AND ENVIRONMENT
165
166 DEBUG: If set then $debug is set to this level.
167
168 VERBOSE: If set then $verbose is set to this level.
169
170 TRACE: If set then $trace is set to this level.
171
172 =head1 DEPENDENCIES
173
174 =head2 Perl Modules
175
176 L<File::Spec|File::Spec>
177
178 L<Term::ANSIColor|Term::ANSIColor>
179
180 =head1 INCOMPATABILITIES
181
182 None yet...
183
184 =head1 BUGS AND LIMITATIONS
185
186 There are no known bugs in this module.
187
188 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
189
190 =head1 LICENSE AND COPYRIGHT
191
192 This Perl Module is freely available; you can redistribute it and/or
193 modify it under the terms of the GNU General Public License as
194 published by the Free Software Foundation; either version 2 of the
195 License, or (at your option) any later version.
196
197 This Perl Module is distributed in the hope that it will be useful,
198 but WITHOUT ANY WARRANTY; without even the implied warranty of
199 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
200 General Public License (L<http://www.gnu.org/copyleft/gpl.html>) for more
201 details.
202
203 You should have received a copy of the GNU General Public License
204 along with this Perl Module; if not, write to the Free Software Foundation,
205 Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
206 reserved.
207
208 =cut