view release on metacpan or  search on metacpan

OSS.pm  view on Meta::CPAN

	       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__

=head1 NAME

Audio::OSS - pure-perl interface to OSS (open sound system) audio devices

=head1 SYNOPSIS

  use Audio::OSS qw(:funcs :formats :mixer);

  my $dsp = IO::Handle->new("</dev/dsp") or die "open failed: $!";
  dsp_reset($dsp) or die "reset failed: $!";