usr.sbin/spkrtest/spkrtest.pl

   1 #!/usr/bin/perl
   2 #
   3 # Copyright (c) May 1995 Wolfram Schneider <wosch@FreeBSD.org>. Berlin.
   4 # All rights reserved.
   5 #
   6 # Redistribution and use in source and binary forms, with or without
   7 # modification, are permitted provided that the following conditions
   8 # are met:
   9 # 1. Redistributions of source code must retain the above copyright
  10 #    notice, this list of conditions and the following disclaimer.
  11 # 2. Redistributions in binary form must reproduce the above copyright
  12 #    notice, this list of conditions and the following disclaimer in the
  13 #    documentation and/or other materials provided with the distribution.
  14 #
  15 # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
  16 # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  17 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  18 # ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
  19 # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  20 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
  21 # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  22 # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  23 # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  24 # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  25 # SUCH DAMAGE.
  26 #
  27 # spkrtest - Test script for the speaker driver
  28 #
  29 # v1.0 by Eric S. Raymond (Feb 1990)
  30 # v1.1 rightstuff contributed by Eric S. Tiedemann (est@snark.thyrsus.com)
  31 # v2.0 dialog+perl by Wolfram Schneider <wosch@FreeBSD.org>, May 1995
  32 #
  33 # NOTE for iso-* (latin1) fonts: use TERM=cons25-iso8859-1
  34 #
  35 # $FreeBSD: src/usr.sbin/spkrtest/spkrtest.pl,v 1.7 1999/08/28 01:20:02 peter Exp $
  36 # $DragonFly: src/usr.sbin/spkrtest/Attic/spkrtest.pl,v 1.2 2003/06/17 04:30:03 dillon Exp $
  37
  38 $title = qq{
  39 reveille   -- Reveille
  40 contact    -- Contact theme from Close Encounters
  41 dance      -- Lord of the Dance (aka Simple Gifts)
  42 loony      -- Loony Toons theme
  43 sinister   -- standard villain's entrance music
  44 rightstuff -- a trope from "The Right Stuff" score by Bill Conti
  45 toccata    -- opening bars of Bach's Toccata and Fugue in D Minor
  46 startrek   -- opening bars of the theme from Star Trek Classic
  47 };
  48
  49 $music = qq{
  50 reveille   -- t255l8c.f.afc~c.f.afc~c.f.afc.f.a..f.~c.f.afc~c.f.afc~c.f.afc~c.f..
  51 contact    -- <cd<a#~<a#>f
  52 dance      -- t240<cfcfgagaa#b#>dc<a#a.~fg.gaa#.agagegc.~cfcfgagaa#b#>dc<a#a.~fg.gga.agfgfgf.
  53 loony      -- t255cf8f8edc<a>~cf8f8edd#e~ce8cdce8cd.<a>c8c8c#def8af8
  54 sinister   -- mst200o2ola.l8bc.~a.~>l2d#
  55 rightstuff -- olcega.a8f>cd2bgc.c8dee2
  56 toccata    -- msl16oldcd4mll8pcb-agf+4.g4p4<msl16dcd4mll8pa.a+f+4p16g4
  57 startrek   -- l2b.f+.p16a.c+.p l4mn<b.>e8a2mspg+e8c+f+8b2
  58 };
  59
  60 @checklist = ('/usr/bin/dialog', '--title',  'Speaker test', '--checklist',
  61     'Please select the melodies you wish to play (space for select)',
  62     '-1', '-1', '10');
  63
  64 $speaker = '/dev/speaker';
  65
  66 sub Exit {
  67     unlink $tmp if $tmp; exit;
  68 }
  69
  70 $SIG{'INT'} = $SIG{'HUP'} = $SIG{'TRAP'} = $SIG{'QUIT'} =
  71     $SIG{'TERM'} = '&Exit';
  72
  73
  74 # make assoc array from variable 'var'
  75 # 'name -- description' -> $var{$name} = $description
  76 sub splitconfig {
  77     local(*var) = @_;
  78     local($t, $name, $description);
  79
  80     foreach $t (split('\n', $var)) {
  81         ($name, $description) = split('--', $t);
  82
  83         $name =~ s/^\s+//; $name =~ s/\s+$//;
  84         $description =~ s/\s+//; $description =~ s/\s+$//;
  85
  86         $var{$name} = $description if $name && $description;
  87     }
  88 }
  89
  90 &splitconfig(*title);
  91 &splitconfig(*music);
  92
  93 foreach (sort keys %title) {
  94     push(@checklist, ($_, $title{$_}, 'OFF'));
  95 }
  96
  97 srand;
  98 $tmp = ($ENV{'TMP'} || "/tmp") . "/_spkrtest" . rand(9999);
  99
 100 if (!open(SPEAKER, "> $speaker")) {
 101     warn "You have no write access to $speaker or the speaker device is not " .
 102         "enabled\nin kernel. Cannot play any melody! See spkr(4).\a\n";
 103     sleep 2;
 104 }
 105
 106 open(SAVEERR, ">&STDERR") || die "open >&STDERR: $!\n";
 107 open(STDERR, "> $tmp") || do { die "open > $tmp: $!\n"; };
 108 system @checklist;              # start dialog
 109 open(STDERR, ">&SAVEERR") || die "open >&SAVEERR: $!\n";
 110 $return = $? >> 8;
 111
 112 # die if speaker device not avaiable
 113 if (fileno(SPEAKER) eq "") {
 114     print "\nSorry, cannot play any melody!!!\n"; &Exit;
 115 }
 116
 117
 118 if (!$return) {                 # not cancel
 119     select(SPEAKER); $| = 1;
 120     select(STDOUT);  $| = 1;
 121
 122     if (! -z $tmp) {            # select melod(y/ies)
 123         print STDOUT "\n";
 124         open(STDIN, $tmp) || do { die "open $tmp: $!\n"; };
 125         foreach $melody (split($", <STDIN>)) {
 126             $melody =~ s/^"//; $melody =~ s/"$//;
 127             print STDOUT "$title{$melody}\n";
 128             print SPEAKER "$music{$melody}";
 129             sleep 1;
 130         }
 131     } else {                    # use default melody
 132         $melody = (sort keys %title)[0];
 133         print STDOUT "Use default melody: $title{$melody}\n";
 134         print SPEAKER "$music{$melody}";
 135     }
 136     close SPEAKER;
 137 }
 138
 139 &Exit;