File Coverage

blib/lib/Speech/Speakup.pm
Criterion Covered Total %
statement 10 96 10.4
branch 2 42 4.7
condition 0 6 0.0
subroutine 4 16 25.0
pod 4 12 33.3
total 20 172 11.6


line stmt bran cond sub pod time code
1             # Speakup::Speakup.pm
2             #########################################################################
3             # This Perl module is Copyright (c) 2002, Peter J Billam #
4             # c/o P J B Computing, www.pjb.com.au #
5             # #
6             # This module is free software; you can redistribute it and/or #
7             # modify it under the same terms as Perl itself. #
8             #########################################################################
9              
10             package Speech::Speakup;
11             $VERSION = '1.05'; #
12             my $stupid_bloody_warning = $VERSION; # circumvent -w warning
13             require Exporter;
14             @ISA = qw(Exporter);
15             @EXPORT = qw();
16             @EXPORT_OK = qw(speakup_get speakup_set synth_get synth_set);
17             %EXPORT_TAGS = (ALL => [@EXPORT,@EXPORT_OK]);
18              
19 1     1   9740 no strict; no warnings;
  1     1   2  
  1         22  
  1         3  
  1         1  
  1         59  
20              
21             $Speech::Speakup::Message = undef;
22             $Speech::Speakup::SpDir = undef;
23             foreach ('/sys/accessibility/speakup','/proc/speakup') {
24             if (-d $_) { $SpDir = $_; }
25             }
26             # if (!$SpDir) { die ; } # results in 100% failure for CPAN-testers :-(
27             # eval 'require Speech::Speakup';
28             # sets $@ to "Can't locate ..." if Speech::Speakup is not installed
29             # sets $@ to "Compilation failed ..." if $SpDir is not present
30              
31             # /usr/lib/i386-linux-gnu/espeak-data/
32              
33 1     1   488 use open ':locale'; # the open pragma was introduced in 5.8.6
  1         832  
  1         4  
34              
35 0     0 1   sub speakup_get { get($SpDir, @_); }
36 0     0 1   sub speakup_set { set($SpDir, @_); }
37 0     0 1   sub synth_get { get(synthdir(),@_); }
38 0     0 1   sub synth_set { set(synthdir(),@_); }
39              
40 0     0 0   sub set { my ($dir, $param, $value) = @_;
41 0 0         if (! $param) { # return a list of all settable params
42 0 0         if (! opendir(D,$dir)) {
43 0           $Message = "can't opendir $dir: ";
44 0           return undef;
45             }
46             my @l = sort grep
47 0 0 0       { (!/^\./) && (-f "$dir/$_") && is_w("$dir/$_") } readdir(D);
  0            
48 0           closedir D;
49 0           $Message = undef;
50 0           return @l;
51             }
52 0 0         if (! open(F, '>', "$dir/$param")) {
53 0           $Message = "can't open $dir/$param: $!";
54 0           return undef;
55             } else {
56 0           print F "$value\n"; close F;
  0            
57 0           $Message = undef;
58 0           return 1;
59             }
60             }
61              
62 0     0 0   sub get { my ($dir, $param) = @_;
63 0 0         if (! $param) { # return a list of all gettable params
64 0 0         if (! opendir(D,$dir)) {
65 0           $Message = "can't opendir $dir: ";
66 0           return undef;
67             }
68             my @l = sort grep
69 0 0 0       { (!/^\./) && (-f "$dir/$_") && is_r("$dir/$_") } readdir(D);
  0            
70 0           closedir D;
71 0           $Message = undef;
72 0           return @l;
73             }
74 0 0         if (! open(F, '<', "$dir/$param")) {
75 0           $Message = "can't open $dir/$param: $!";
76 0           return undef;
77             } else {
78 0           my @lines = (); close F;
  0            
79 0           $Message = undef;
80             # 1.03 keymap is 65 lines long ! the others are only one line.
81 0 0         if (1 < @lines) { return join('', @lines);
  0            
82 0           } else { my $value = $lines[0]; $value =~ s/\s+$//; return $value;
  0            
  0            
83             }
84             }
85             }
86              
87             sub synthdir {
88 0     0 0   my $sd = get($SpDir,'synth');
89 0 0         if (! $sd) { warn "can't find the synth directory\n"; return ''; }
  0            
  0            
90 0           my $d = "$SpDir/$sd";
91 0 0         if (! -e $d) { warn "synth directory $d does not exist\n"; return ''; }
  0            
  0            
92 0 0         if (! -d $d) { warn "synth directory $d is not a directory\n"; return ''; }
  0            
  0            
93 0           return $d;
94             }
95              
96             sub is_w {
97             # because -w as root reports yes regardless of file permissions
98 0     0 0   my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
99             $atime,$mtime,$ctime,$blksize,$blocks) = stat($_[0]);
100 0           return $mode & 2;
101             }
102             sub is_r {
103 0     0 0   my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
104             $atime,$mtime,$ctime,$blksize,$blocks) = stat($_[0]);
105 0           return $mode & 4;
106             }
107              
108             sub enter_speakup_silent { # 1.62
109             # echo 7 > /sys/accessibility/speakup/silent if it exists
110 0 0   0 0   if (!$SpeakUpSilentFile) { return 0; }
  0            
111 0 0         if ($IsSpeakUpSilent) {
112 0           warn "enter_speakup_silent but already IsSpeakUpSilent\r\n"; return 1 ;
  0            
113             }
114 0 0         if (open(S, '>', $SpeakUpSilentFile)) { print S "7\n"; close S; }
  0            
  0            
115 0           $IsSpeakUpSilent = 1;
116 0           return 1;
117             }
118             sub leave_speakup_silent { # 1.62
119             # echo 4 > /sys/accessibility/speakup/silent if it exists
120 0 0   0 0   if (!$SpeakUpSilentFile) { return 0; }
  0            
121 0 0         if (!$IsSpeakUpSilent) {
122 0           warn "leave_speakup_silent but not IsSpeakUpSilent\r\n"; return 1 ;
  0            
123             }
124 0 0         if (open(S, '>', $SpeakUpSilentFile)) { print S "4\n"; close S; }
  0            
  0            
125 0           $IsSpeakUpSilent = 0;
126 0           return 1;
127             }
128              
129             sub which {
130 0     0 0   my $f;
131 0 0         foreach $d (split(":",$ENV{'PATH'})) {$f="$d/$_[0]"; return $f if -x $f;}
  0            
  0            
132             }
133             %SpeakMode = ();
134             sub END {
135 1 50   1   2919 if ($Eflite_FH) { print $Eflite_FH "s\nq { }\n"; close $Eflite_FH;
  0 50          
  0            
136 0           } elsif ($Espeak_PID) { kill SIGHUP, $Espeak_PID; wait;
  0            
137             }
138             }
139              
140             1;
141              
142             __END__