File Coverage

blib/lib/Audio/OSS.pm
Criterion Covered Total %
statement 36 88 40.9
branch 2 26 7.6
condition 0 2 0.0
subroutine 9 23 39.1
pod 0 10 0.0
total 47 149 31.5


line stmt bran cond sub pod time code
1             # -*- cperl -*-
2              
3             # Audio::OSS - Less DWIM, more useful than Audio::DSP
4             #
5             # Copyright (c) 2000 Cepstral LLC. All rights Reserved.
6             #
7             # This module is free software; you can redistribute it and/or modify
8             # it under the same terms as Perl itself.
9             #
10             # Written by David Huggins-Daines
11              
12             package Audio::OSS;
13 1     1   613 use strict;
  1         2  
  1         35  
14              
15             # We should maybe generate these in Makefile.PL, but they don't use
16             # any types that are likely to change alignment or size between
17             # platforms.
18 1     1   4 use constant CINFO_TMPL => 'lll';
  1         2  
  1         67  
19 1     1   5 use constant BINFO_TMPL => 'llll';
  1         9  
  1         35  
20 1     1   4 use constant MINFO_TMPL => 'a16 a32 l';
  1         2  
  1         39  
21              
22 1     1   5 use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS @DevNames);
  1         1  
  1         292  
23             require Exporter;
24             @ISA = qw(Exporter);
25              
26             BEGIN {
27             # Defines constants, which is why it needs to be done in BEGIN{}
28             # Also creates @EXPORT_OK, hence the push below
29 1     1   539 require Audio::OSS::Constants;
30              
31             # Special-case a few useful constants
32 1 50       10 unless (defined(&AFMT_S16_NE)) {
33 0 0       0 if (unpack("L", pack("C*", 1, 2, 3, 4)) == 0x01020304) {
34 0         0 *AFMT_S16_NE = sub () { AFMT_S16_BE() };
  0         0  
35             } else {
36 0         0 *AFMT_S16_NE = sub () { AFMT_S16_LE() };
  0         0  
37             }
38             }
39             # Pseudo-ioctls (we assume that various OSes will form these the
40             # same way...)
41 1     0   8 *SOUND_MIXER_READ = sub () { SOUND_MIXER_READ_VOLUME() - SOUND_MIXER_VOLUME() };
  0         0  
42 1     0   4 *SOUND_MIXER_WRITE = sub () { SOUND_MIXER_WRITE_VOLUME() - SOUND_MIXER_VOLUME() };
  0         0  
43 1         2 push @EXPORT_OK, qw(SOUND_MIXER_READ SOUND_MIXER_WRITE);
44 1         1 push @{$EXPORT_TAGS{mixer}}, qw(SOUND_MIXER_READ SOUND_MIXER_WRITE);
  1         514  
45             }
46              
47             # Don't bother getting this from the header file
48             @DevNames = qw(
49             vol bass treble synth pcm speaker line
50             mic cd mix pcm2 rec igain ogain line1 line2
51             line3 dig1 dig2 dig3 phin phout video radio monitor
52             );
53              
54             # Use push, because BEGIN blocks may frob these
55             push @EXPORT_OK, qw(dsp_sync dsp_reset set_fragment get_fmt
56             get_outbuf_ptr get_inbuf_ptr
57             get_outbuf_info get_inbuf_info
58             mixer_read mixer_write @DevNames);
59             push @{$EXPORT_TAGS{funcs}},
60             qw[
61             dsp_sync
62             dsp_reset
63             set_fragment
64             get_fmt
65             get_outbuf_ptr
66             get_inbuf_ptr
67             get_outbuf_info
68             get_inbuf_info
69             mixer_read
70             mixer_write
71             ];
72              
73             $VERSION=0.05_01;
74              
75             sub dsp_reset {
76 0     0 0   my $dsp = shift;
77 0 0         ioctl $dsp, SNDCTL_DSP_SYNC, 0 or return undef;
78 0           ioctl $dsp, SNDCTL_DSP_RESET, 0;
79             }
80              
81             sub dsp_sync {
82 0     0 0   my $dsp = shift;
83 0           ioctl $dsp, SNDCTL_DSP_SYNC, 0;
84             }
85              
86             sub get_fmt {
87 0     0 0   my $dsp = shift;
88 0           my $sfmt = pack "L", AFMT_QUERY;
89 0 0         ioctl $dsp, SNDCTL_DSP_SETFMT, $sfmt or return undef;
90 0           return unpack "L", $sfmt;
91             }
92              
93             sub set_fragment {
94 0     0 0   my ($dsp, $shift, $max) = @_;
95              
96             # This is not really documented, but the code of the sound drivers
97             # says that this is two halfwords packed together in host byte
98             # order, the MSW being the shift (assuming this means size log 2),
99             # the lower being the maximum number. In general it seems that
100             # shift must be 4 <= shift < 16, maxfrags must be >= 4.
101              
102 0           my $sfrag = pack "L", (($max << 16) | $shift);
103 0           ioctl $dsp, SNDCTL_DSP_SETFRAGMENT, $sfrag;
104             }
105              
106             sub get_outbuf_ptr {
107 0     0 0   my $dsp = shift;
108 0           my $cinfo = pack CINFO_TMPL;
109 0 0         ioctl($dsp, SNDCTL_DSP_GETOPTR, $cinfo) or return undef;
110 0           return unpack CINFO_TMPL, $cinfo;
111             }
112              
113             sub get_inbuf_ptr {
114 0     0 0   my $dsp = shift;
115 0           my $cinfo = pack CINFO_TMPL;
116 0 0         ioctl($dsp, SNDCTL_DSP_GETIPTR, $cinfo) or return undef;
117 0           return unpack CINFO_TMPL, $cinfo;
118             }
119              
120             sub get_outbuf_info {
121 0     0 0   my $dsp = shift;
122 0           my $binfo = pack BINFO_TMPL;
123 0 0         ioctl($dsp, SNDCTL_DSP_GETOSPACE, $binfo) or return undef;
124 0           return unpack BINFO_TMPL, $binfo;
125             }
126              
127             sub get_inbuf_info {
128 0     0 0   my $dsp = shift;
129 0           my $binfo = pack BINFO_TMPL;
130 0 0         ioctl($dsp, SNDCTL_DSP_GETISPACE, $binfo) or return undef;
131 0           return unpack BINFO_TMPL, $binfo;
132             }
133              
134             # Some constants may not be defined, don't define their subs either
135             BEGIN {
136 1 50   1   4 if (defined &SOUND_MIXER_INFO) {
137             *get_mixer_info = sub {
138 0     0   0 my $mixer = shift;
139 0         0 my $minfo = pack MINFO_TMPL;
140 0 0       0 ioctl($mixer, SOUND_MIXER_INFO(), $minfo) or return undef;
141 0         0 return unpack MINFO_TMPL, $minfo;
142 1         3 };
143 1         2 push @EXPORT_OK, 'get_mixer_info';
144 1         1 push @{$EXPORT_TAGS{funcs}}, 'get_mixer_info';
  1         29  
145             }
146             }
147              
148             # Templated ioctls that just read or write a single integer value
149             BEGIN {
150 1     1   5 no strict 'refs';
  1         1  
  1         137  
151 1     1   3 my @rw_ioctls = (
152             dsp_get_caps => SNDCTL_DSP_GETCAPS,
153             get_supported_fmts => SNDCTL_DSP_GETFMTS,
154             set_sps => SNDCTL_DSP_SPEED,
155             set_fmt => SNDCTL_DSP_SETFMT,
156             set_stereo => SNDCTL_DSP_STEREO,
157             mixer_read_devmask => SOUND_MIXER_READ_DEVMASK,
158             mixer_read_recmask => SOUND_MIXER_READ_RECMASK,
159             mixer_read_stereodevs => SOUND_MIXER_READ_STEREODEVS,
160             mixer_read_caps => SOUND_MIXER_READ_CAPS,
161             );
162 1         4 while (my ($sub, $ioctl) = splice @rw_ioctls, 0, 2) {
163             *$sub = sub {
164 0     0   0 my $fh = shift;
165 0   0     0 my $in = shift || 0;
166 0         0 my $out = pack "L", $in;
167 0 0       0 ioctl($fh, $ioctl, $out) or return undef;
168 0         0 return unpack "L", $out;
169 9         40 };
170 9         11 push @EXPORT_OK, $sub;
171 9         8 push @{$EXPORT_TAGS{funcs}}, $sub;
  9         165  
172             }
173             }
174              
175             sub mixer_read {
176 0     0 0   my ($mixer, $channel) = @_;
177 0           my $vol = pack "L";
178 0 0         ioctl($mixer, SOUND_MIXER_READ + $channel, $vol) or return undef;
179 0           return unpack "L", $vol;
180             }
181              
182             sub mixer_write {
183 0     0 0   my ($mixer, $channel, $left, $right) = @_;
184 0           my $vol = pack("L", $left | ($right << 8));
185 0 0         ioctl($mixer, SOUND_MIXER_WRITE + $channel, $vol) or return undef;
186 0           return unpack "L", $vol;
187             }
188              
189             1;
190             __END__