c18c2f7feda4c2fc8e4d60ab5286b4d0641d4ec9
[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     if ($log) {
108       $log->msg("Not speaking because we were asked to be quiet - $msg");
109     } else {
110       verbose "Not speaking because we were asked to be quiet - $msg";
111     } # if
112
113     return;
114   } # if
115
116   # Handle the case where $msg is not passed in. Then use the clipboard;
117   $msg = Clipboard->paste unless $msg;
118
119   # Handle the case where $msg is a filehandle
120   $msg = <$msg> if ref $msg eq 'GLOB';
121
122   # We can't have two speakers going at the same time so if we have an error
123   # backoff a little and try again.
124   my $attempts   = 0;
125   my $maxretries = 3;
126   my $backoff    = 2;
127
128   my ($status, @output);
129
130   while ($attempts++ < $maxretries) {
131     ($status, @output) = Execute "/usr/local/bin/gt \"$msg\"";
132
133     if ($status) {
134       my $errmsg = "Unable to speak (Status: $status) - " . join "\n", @output;
135
136       if ($log) {
137         $log->err($errmsg);
138       } else {
139         error $errmsg;
140       } # if
141
142       sleep $backoff++;
143     } else {
144       return; # We said our piece...
145     } # if
146   } # while
147
148   my $errmsg = 'Maximum retries exceeded - terminating';
149
150   if ($log) {
151     $log->err($errmsg, $status);
152   } else {
153     error $errmsg, $status;
154   } # if
155
156   return;
157 } # speak
158
159 1;
160
161 =pod
162
163 =head1 CONFIGURATION AND ENVIRONMENT
164
165 DEBUG: If set then $debug is set to this level.
166
167 VERBOSE: If set then $verbose is set to this level.
168
169 TRACE: If set then $trace is set to this level.
170
171 =head1 DEPENDENCIES
172
173 =head2 Perl Modules
174
175 L<File::Spec|File::Spec>
176
177 L<Term::ANSIColor|Term::ANSIColor>
178
179 =head1 INCOMPATABILITIES
180
181 None yet...
182
183 =head1 BUGS AND LIMITATIONS
184
185 There are no known bugs in this module.
186
187 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
188
189 =head1 LICENSE AND COPYRIGHT
190
191 This Perl Module is freely available; you can redistribute it and/or
192 modify it under the terms of the GNU General Public License as
193 published by the Free Software Foundation; either version 2 of the
194 License, or (at your option) any later version.
195
196 This Perl Module is distributed in the hope that it will be useful,
197 but WITHOUT ANY WARRANTY; without even the implied warranty of
198 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
199 General Public License (L<http://www.gnu.org/copyleft/gpl.html>) for more
200 details.
201
202 You should have received a copy of the GNU General Public License
203 along with this Perl Module; if not, write to the Free Software Foundation,
204 Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
205 reserved.
206
207 =cut