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

# -*- cperl -*-

# Audio::OSS - Less DWIM, more useful than Audio::DSP
#
# Copyright (c) 2000 Cepstral LLC. All rights Reserved.
#
# This module is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
#
# Written by David Huggins-Daines

package Audio::OSS;
use strict;

# We should maybe generate these in Makefile.PL, but they don't use
# any types that are likely to change alignment or size between
# platforms.
use constant CINFO_TMPL => 'lll';
use constant BINFO_TMPL => 'llll';
use constant MINFO_TMPL => 'a16 a32 l';

use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS @DevNames);
require Exporter;
@ISA = qw(Exporter);

BEGIN {
    # Defines constants, which is why it needs to be done in BEGIN{}
    # Also creates @EXPORT_OK, hence the push below
    require Audio::OSS::Constants;

    # Special-case a few useful constants
    unless (defined(&AFMT_S16_NE)) {
	if (unpack("L", pack("C*", 1, 2, 3, 4)) == 0x01020304) {
	    *AFMT_S16_NE = sub () { AFMT_S16_BE() };
	} else {
	    *AFMT_S16_NE = sub () { AFMT_S16_LE() };
	}
    }
    # Pseudo-ioctls (we assume that various OSes will form these the
    # same way...)
    *SOUND_MIXER_READ = sub () { SOUND_MIXER_READ_VOLUME() - SOUND_MIXER_VOLUME() };
    *SOUND_MIXER_WRITE = sub () { SOUND_MIXER_WRITE_VOLUME() - SOUND_MIXER_VOLUME() };
    push @EXPORT_OK, qw(SOUND_MIXER_READ SOUND_MIXER_WRITE);
    push @{$EXPORT_TAGS{mixer}}, qw(SOUND_MIXER_READ SOUND_MIXER_WRITE);
}

# Don't bother getting this from the header file
@DevNames = qw(
	       vol bass treble synth pcm speaker line
	       mic cd mix pcm2 rec igain ogain line1 line2
	       line3 dig1 dig2 dig3 phin phout video radio monitor
	      );

# Use push, because BEGIN blocks may frob these
push @EXPORT_OK, qw(dsp_sync dsp_reset set_fragment get_fmt
		    get_outbuf_ptr get_inbuf_ptr
		    get_outbuf_info get_inbuf_info
		    mixer_read mixer_write @DevNames);
push @{$EXPORT_TAGS{funcs}},
    qw[
       dsp_sync
       dsp_reset
       set_fragment
       get_fmt
       get_outbuf_ptr
       get_inbuf_ptr
       get_outbuf_info
       get_inbuf_info
       mixer_read
       mixer_write
      ];

$VERSION=0.05_01;

sub dsp_reset {
    my $dsp = shift;
    ioctl $dsp, SNDCTL_DSP_SYNC, 0 or return undef;
    ioctl $dsp, SNDCTL_DSP_RESET, 0;
}

sub dsp_sync {
    my $dsp = shift;
    ioctl $dsp, SNDCTL_DSP_SYNC, 0;
}

sub get_fmt {
    my $dsp = shift;
    my $sfmt = pack "L", AFMT_QUERY;
    ioctl $dsp, SNDCTL_DSP_SETFMT, $sfmt or return undef;
    return unpack "L", $sfmt;
}

sub set_fragment {
    my ($dsp, $shift, $max) = @_;

    # This is not really documented, but the code of the sound drivers
    # says that this is two halfwords packed together in host byte
    # order, the MSW being the shift (assuming this means size log 2),
    # the lower being the maximum number.  In general it seems that
    # shift must be 4 <= shift < 16, maxfrags must be >= 4.

    my $sfrag = pack "L", (($max << 16) | $shift);
    ioctl $dsp, SNDCTL_DSP_SETFRAGMENT, $sfrag;
}

sub get_outbuf_ptr {
    my $dsp = shift;
    my $cinfo = pack CINFO_TMPL;
    ioctl($dsp, SNDCTL_DSP_GETOPTR, $cinfo) or return undef;
    return unpack CINFO_TMPL, $cinfo;
}

sub get_inbuf_ptr {
    my $dsp = shift;
    my $cinfo = pack CINFO_TMPL;
    ioctl($dsp, SNDCTL_DSP_GETIPTR, $cinfo) or return undef;
    return unpack CINFO_TMPL, $cinfo;
}

sub get_outbuf_info {
    my $dsp = shift;
    my $binfo = pack BINFO_TMPL;
    ioctl($dsp, SNDCTL_DSP_GETOSPACE, $binfo) or return undef;
    return unpack BINFO_TMPL, $binfo;
}

sub get_inbuf_info {
    my $dsp = shift;
    my $binfo = pack BINFO_TMPL;
    ioctl($dsp, SNDCTL_DSP_GETISPACE, $binfo) or return undef;
    return unpack BINFO_TMPL, $binfo;
}

# Some constants may not be defined, don't define their subs either
BEGIN {
    if (defined &SOUND_MIXER_INFO) {
	*get_mixer_info = sub {
	    my $mixer = shift;
	    my $minfo = pack MINFO_TMPL;
	    ioctl($mixer, SOUND_MIXER_INFO(), $minfo) or return undef;
	    return unpack MINFO_TMPL, $minfo;
	};
	push @EXPORT_OK, 'get_mixer_info';
	push @{$EXPORT_TAGS{funcs}}, 'get_mixer_info';
    }
}

# Templated ioctls that just read or write a single integer value
BEGIN {
    no strict 'refs';
    my @rw_ioctls = (
		     dsp_get_caps => SNDCTL_DSP_GETCAPS,
		     get_supported_fmts => SNDCTL_DSP_GETFMTS,
		     set_sps => SNDCTL_DSP_SPEED,
		     set_fmt => SNDCTL_DSP_SETFMT,
		     set_stereo => SNDCTL_DSP_STEREO,
		     mixer_read_devmask => SOUND_MIXER_READ_DEVMASK,
		     mixer_read_recmask => SOUND_MIXER_READ_RECMASK,
		     mixer_read_stereodevs => SOUND_MIXER_READ_STEREODEVS,
		     mixer_read_caps => SOUND_MIXER_READ_CAPS,
		    );
    while (my ($sub, $ioctl) = splice @rw_ioctls, 0, 2) {
	*$sub = sub {
	    my $fh = shift;
	    my $in = shift || 0;
	    my $out = pack "L", $in;
	    ioctl($fh, $ioctl, $out) or return undef;
	    return unpack "L", $out;
	};
	push @EXPORT_OK, $sub;
	push @{$EXPORT_TAGS{funcs}}, $sub;
    }
}

sub mixer_read {
    my ($mixer, $channel) = @_;
    my $vol = pack "L";
    ioctl($mixer, SOUND_MIXER_READ + $channel, $vol) or return undef;
    return unpack "L", $vol;
}

sub mixer_write {
    my ($mixer, $channel, $left, $right) = @_;
    my $vol = pack("L", $left | ($right << 8));
    ioctl($mixer, SOUND_MIXER_WRITE + $channel, $vol) or return undef;
    return unpack "L", $vol;
}

1;
__END__