File Coverage

blib/lib/Speech/Speakup.pm

Criterion	Covered	Total	%
statement	13	99	13.1
branch	2	42	4.7
condition	0	6	0.0
subroutine	5	17	29.4
pod	4	12	33.3
total	24	176	13.6

# Speakup::Speakup.pm
#########################################################################
#        This Perl module is Copyright (c) 2002, Peter J Billam         #
#               c/o P J B Computing, www.pjb.com.au                     #
#                                                                       #
#     This module is free software; you can redistribute it and/or      #
#            modify it under the same terms as Perl itself.             #
#########################################################################

package Speech::Speakup;
$VERSION = '1.04';   #
my $stupid_bloody_warning = $VERSION;  # circumvent -w warning
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw();
@EXPORT_OK = qw(speakup_get speakup_set synth_get synth_set);
%EXPORT_TAGS = (ALL => [@EXPORT,@EXPORT_OK]);

no strict; no warnings;

$Speech::Speakup::Message = undef;
$Speech::Speakup::SpDir   = undef;
foreach ('/sys/accessibility/speakup','/proc/speakup') {
    if (-d $_) { $SpDir = $_; }
}
# if (!$SpDir) { die ; }  # results in 100% failure for CPAN-testers :-(
# eval 'require Speech::Speakup';
#  sets $@ to  "Can't locate ..." if Speech::Speakup is not installed
#  sets $@ to  "Compilation failed ..." if $SpDir is not present

use open ':locale';  # the open pragma was introduced in 5.8.6

sub speakup_get { get($SpDir,   @_); }
sub speakup_set { set($SpDir,   @_); }
sub synth_get   { get(synthdir(),@_); }
sub synth_set   { set(synthdir(),@_); }

sub set { my ($dir, $param, $value) = @_;
	if (! $param) {  # return a list of all settable params
		if (! opendir(D,$dir)) {
			$Message = "can't opendir $dir: ";
			return undef;
		}
		my @l = sort grep
		  { (!/^\./) && (-f "$dir/$_") && is_w("$dir/$_") } readdir(D);
		closedir D;
		$Message = undef;
		return @l;
	}
	if (! open(F, '>', "$dir/$param")) {
		$Message = "can't open $dir/$param: $!";
		return undef;
	} else {
		print F "$value\n"; close F;
		$Message = undef;
		return 1;
	}
}

sub get { my ($dir, $param) = @_;
	if (! $param) {  # return a list of all gettable params
		if (! opendir(D,$dir)) {
			$Message = "can't opendir $dir: ";
			return undef;
		}
		my @l = sort grep
		  { (!/^\./) && (-f "$dir/$_") && is_r("$dir/$_") } readdir(D);
		closedir D;
		$Message = undef;
		return @l;
	}
	if (! open(F, '<', "$dir/$param")) {
		$Message = "can't open $dir/$param: $!";
		return undef;
	} else {
		my @lines = (); close F;
		$Message = undef;
		# 1.03 keymap is 65 lines long ! the others are only one line.
		if (1 < @lines) { return join('', @lines);
		} else { my $value = $lines[$[]; $value =~ s/\s+$//; return $value;
		}
	}
}

sub synthdir {
	my $sd = get($SpDir,'synth');
	if (! $sd) { warn "can't find the synth directory\n"; return ''; }
	my $d = "$SpDir/$sd";
	if (! -e $d) { warn "synth directory $d does not exist\n"; return ''; }
	if (! -d $d) { warn "synth directory $d is not a directory\n"; return ''; }
	return $d;
}

sub is_w {
	# because -w as root reports yes regardless of file permissions
	my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
	  $atime,$mtime,$ctime,$blksize,$blocks) = stat($_[$[]);
	return $mode & 2;
}
sub is_r {
	my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
	  $atime,$mtime,$ctime,$blksize,$blocks) = stat($_[$[]);
	return $mode & 4;
}

sub enter_speakup_silent {   # 1.62
	# echo 7 > /sys/accessibility/speakup/silent  if it exists
	if (!$SpeakUpSilentFile) { return 0; }
	if ($IsSpeakUpSilent) {
		warn "enter_speakup_silent but already IsSpeakUpSilent\r\n"; return 1 ;
	}
	if (open(S, '>', $SpeakUpSilentFile)) { print S "7\n"; close S; }
	$IsSpeakUpSilent = 1;
	return 1;
}
sub leave_speakup_silent {   # 1.62
	# echo 4 > /sys/accessibility/speakup/silent  if it exists
	if (!$SpeakUpSilentFile) { return 0; }
	if (!$IsSpeakUpSilent) {
		warn "leave_speakup_silent but not IsSpeakUpSilent\r\n"; return 1 ;
	}
	if (open(S, '>', $SpeakUpSilentFile)) { print S "4\n"; close S; }
	$IsSpeakUpSilent = 0;
	return 1;
}

sub which {
	my $f;
	foreach $d (split(":",$ENV{'PATH'})) {$f="$d/$_[$[]"; return $f if -x $f;}
}
%SpeakMode = ();
sub END {
	if ($Eflite_FH) { print $Eflite_FH "s\nq { }\n"; close $Eflite_FH;
	} elsif ($Espeak_PID) { kill SIGHUP, $Espeak_PID; wait;
	}
}

1;

__END__