| Subject: | Win32::Soundrec dependency missing in ActivePerl 5.10 |
Win32::API::Prototype is not available for ActivePerl 5.10 (as of
January 14, 2009).
The attached file includes changes to use Win32::API instead of
Win32::API::Protype, which works fine on ActivePerl 5.10
| Subject: | SoundRec.pm |
#!/usr/bin/perl
package Win32::SoundRec;
use warnings;
use strict;
use Win32::API;
use vars qw ($VERSION);
$VERSION = 0.03;
my $mciSendString = new Win32::API("winmm.dll", "mciSendString", ['P', 'P', 'N', 'N'], 'N');
my $mciGetErrorString = new Win32::API("winmm.dll", "mciGetErrorString", ['N', 'P', 'N'], 'N');
sub new{
my $proto = shift;
my $char = shift;
my $self = {};
my $class = ref($proto) || $proto;
bless $self, $class;
$self->{alias} = 'mysound';
$self->{bitspersample} = 8;
$self->{samplespersec} = 11025;
$self->{channels} = 1;
$self->{filename} = 'test.wav';
return $self;
}
sub record{
my $self = shift;
my $bitspersample = shift || $self->{bitspersample};
my $samplespersec = shift || $self->{samplespersec};
my $channels = shift || $self->{channels};
my $uReturnLength = 1024;
my $lpstrReturnString = &NewString( $uReturnLength );
my $lpstrBuffer = &NewString( $uReturnLength );
my $Result = $mciSendString->Call("open new type waveaudio alias ".$self->{alias},
$lpstrReturnString,
1024,
0);
if ( $Result != 0 ){
my $eResult = $mciGetErrorString->Call($Result, $lpstrBuffer, 1024);
warn CleanString( $lpstrBuffer ) . "\n";
}
$Result = $mciSendString->Call("set ".$self->{alias}." time format ms bitspersample $bitspersample samplespersec $samplespersec channels $channels",
$lpstrReturnString,
1024,
0);
if ( $Result != 0 ){
my $eResult = $mciGetErrorString->Call($Result, $lpstrBuffer, 1024);
warn CleanString( $lpstrBuffer ) . "\n";
}
$Result = $mciSendString->Call( "record ".$self->{alias},
$lpstrReturnString,
1024,
0);
if ( $Result != 0 )
{
my $eResult = $mciGetErrorString->Call($Result, $lpstrBuffer, 1024);
warn CleanString( $lpstrBuffer ) . "\n";
}
}
sub play
{
my $self = shift;
my $uReturnLength = 1024;
my $lpstrReturnString = NewString( $uReturnLength );
my $lpstrBuffer = NewString( $uReturnLength );
my $Result = $mciSendString->Call( "play ".$self->{alias}." from 1",
$lpstrReturnString,
1024,
0);
if ( $Result != 0 )
{
my $eResult = $mciGetErrorString->Call($Result, $lpstrBuffer, 1024);
warn CleanString( $lpstrBuffer ) . "\n";
}
}
sub stop
{
my $self = shift;
my $uReturnLength = 1024;
my $lpstrReturnString = NewString( $uReturnLength );
my $lpstrBuffer = NewString( $uReturnLength );
my $Result = $mciSendString->Call( "stop ".$self->{alias},
$lpstrReturnString,
1024,
0);
if ( $Result != 0 )
{
my $eResult = $mciGetErrorString->Call($Result, $lpstrBuffer, 1024);
warn CleanString( $lpstrBuffer ) . "\n";
}
}
sub save
{
my $self = shift;
my $filename = shift || $self->{filename};
my $uReturnLength = 1024;
my $lpstrReturnString = NewString( $uReturnLength );
my $lpstrBuffer = NewString( $uReturnLength );
my $Result = $mciSendString->Call( "save ".$self->{alias}." $filename",
$lpstrReturnString,
1024,
0);
if ( $Result != 0 )
{
my $eResult = $mciGetErrorString->Call($Result, $lpstrBuffer, 1024);
warn CleanString( $lpstrBuffer ) . "\n";
}
$Result = $mciSendString->Call( "close ".$self->{alias},
$lpstrReturnString,
1024,
0);
if ( $Result != 0 )
{
my $eResult = $mciGetErrorString->Call($Result, $lpstrBuffer, 1024);
warn CleanString( $lpstrBuffer ) . "\n";
}
}
##################################################
# Subroutines snagged from Win32::API::Prototype #
##################################################
sub NewString
{
my( $Param ) = @_;
my $Size;
my $String = "";
if( $Param =~ /^\d+$/ )
{
$Size = $Param;
} else {
$Size = 0;
$String = $Param;
}
$String .= "\x00" x $Size;
if( Win32::API::IsUnicode() )
{
$String =~ s/(.)/$1\x00/g;
}
return( $String );
}
sub CleanString
{
my( $String, $ForceUnicode ) = @_;
if( Win32::API::IsUnicode() || $ForceUnicode )
{
$String =~ s/(.)\x00/$1/g;
}
$String =~ s/^([^\x00]*).*$/$1/s;
return( $String );
}
##################################################
=pod
=head1 NAME
Win32::SoundRec - Module for recording sound on Win32 platforms
=head1 SYNOPSIS
use Win32::SoundRec;
my $r = Win32::SoundRec->new();
# start recording...
$r->record();
# wait 5 seconds
sleep(5);
# Playback the recording buffer
$r->play();
sleep(5);
# stop record or playback
$r->stop();
# save the recording
$r->save('my.wav');
=head1 DESCRIPTION
This module allows recording of sound on Win32 platforms using the MCI interface (which
depends on winmm.dll).
=head1 PREREQUISITES
An MCI compatible soundcard
=head1 USAGE
=head2 new()
The new() method is the constructor. It connects to the mci interface.
=head2 record([$bitspersample, $samplespersec, $channels])
This method starts recording the audio. After calling the record function, you
should sleep() as long as you want to record.
The three parameters are optional. $bitspersample defaults to 8, $samplespersec
defaults to 11025, $channels defaults to 1.
=head2 play
This method plays back the unsaved recording buffer
=head2 stop
This method stops the playback or record action
=head2 save([$filename])
This methods closes and saves the recording. By default the recording buffer is saved
in 'test.wav'. If you specify a valid $filename, the buffer is saved in that file
=head1 SUPPORT
You can email the author for support on this module.
=head1 AUTHOR
Jouke Visser
jouke@cpan.org
http://jouke.pvoice.org
Based largely on code posted to the perl-win32-users mailinglist by Jeff Slutzky
=head1 COPYRIGHT
Copyright (c) 2003-2005 Jouke Visser. All rights reserved.
This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.
The full text of the license can be found in the
LICENSE file included with this module.
=head1 SEE ALSO
perl(1).
=cut
"Yet Another True Value";
__END__