r52440 - in /branches/upstream/libaudio-wav-perl/current: Changes MANIFEST META.yml README Wav.pm Wav/Read.pm Wav/Tools.pm Wav/Write.pm Wav/Write/Header.pm test.pl
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Wed Feb 10 03:48:43 UTC 2010
Author: jawnsy-guest
Date: Wed Feb 10 03:48:29 2010
New Revision: 52440
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=52440
Log:
[svn-upgrade] Integrating new upstream version, libaudio-wav-perl (0.08)
Added:
branches/upstream/libaudio-wav-perl/current/META.yml
Modified:
branches/upstream/libaudio-wav-perl/current/Changes
branches/upstream/libaudio-wav-perl/current/MANIFEST
branches/upstream/libaudio-wav-perl/current/README
branches/upstream/libaudio-wav-perl/current/Wav.pm
branches/upstream/libaudio-wav-perl/current/Wav/Read.pm
branches/upstream/libaudio-wav-perl/current/Wav/Tools.pm
branches/upstream/libaudio-wav-perl/current/Wav/Write.pm
branches/upstream/libaudio-wav-perl/current/Wav/Write/Header.pm
branches/upstream/libaudio-wav-perl/current/test.pl
Modified: branches/upstream/libaudio-wav-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaudio-wav-perl/current/Changes?rev=52440&op=diff
==============================================================================
--- branches/upstream/libaudio-wav-perl/current/Changes (original)
+++ branches/upstream/libaudio-wav-perl/current/Changes Wed Feb 10 03:48:29 2010
@@ -34,3 +34,18 @@
- Tidied up bits and pieces.
- Added very basic support for WAVEFORMATEXTENSIBLE.
- When writing files, finish() will now be called by DESTROY if necessary.
+
+0.07 Sun Feb 07 18:05:41 GMT 2010
+ - change API so you can call Audio::Wav->{read|write} w/o new() if preferred
+ - increase pure perl read speed by a factor of ~2.4
+ * remove unnecessary bounds check
+ * put block in closure, avoiding double hash lookup
+ * put $block assign in _init_read_sub, put read_sub in closure, too
+ * pull $handle into closure:
+ * get rid of closure, and get rid of read() - inline it with $read_sub
+ - use Inline::C (if available) to increase read speed by a factor of ~2.3
+ - experimental support for reading 24- and 32- bit data (suspected to
+ work on little endian machines that use Inline::C)
+
+0.08 Sun Feb 09 06:29:43 GMT 2010
+ - fix regression: read() returned bogus samples when Inline::C not available
Modified: branches/upstream/libaudio-wav-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaudio-wav-perl/current/MANIFEST?rev=52440&op=diff
==============================================================================
--- branches/upstream/libaudio-wav-perl/current/MANIFEST (original)
+++ branches/upstream/libaudio-wav-perl/current/MANIFEST Wed Feb 10 03:48:29 2010
@@ -10,3 +10,4 @@
Wav/Write.pm
Wav/Tools.pm
Wav/Write/Header.pm
+META.yml Module meta-data (added by MakeMaker)
Added: branches/upstream/libaudio-wav-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaudio-wav-perl/current/META.yml?rev=52440&op=file
==============================================================================
--- branches/upstream/libaudio-wav-perl/current/META.yml (added)
+++ branches/upstream/libaudio-wav-perl/current/META.yml Wed Feb 10 03:48:29 2010
@@ -1,0 +1,18 @@
+--- #YAML:1.0
+name: Audio-Wav
+version: 0.08
+abstract: ~
+author: []
+license: unknown
+distribution_type: module
+configure_requires:
+ ExtUtils::MakeMaker: 0
+requires: {}
+no_index:
+ directory:
+ - t
+ - inc
+generated_by: ExtUtils::MakeMaker version 6.48
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
Modified: branches/upstream/libaudio-wav-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaudio-wav-perl/current/README?rev=52440&op=diff
==============================================================================
--- branches/upstream/libaudio-wav-perl/current/README (original)
+++ branches/upstream/libaudio-wav-perl/current/README Wed Feb 10 03:48:29 2010
@@ -37,13 +37,13 @@
my $data;
#read 512 bytes
while ( defined( $data = $read -> read_raw( 512 ) ) ) {
- $write -> write_raw( $data );
+ $write -> write_raw( $data );
}
my $length = $read -> length_samples();
my( $third, $half, $twothirds ) = map int( $length / $_ ), ( 3, 2, 1.5 );
my %samp_loop = (
- 'start' => $third,
- 'end' => $twothirds,
+ 'start' => $third,
+ 'end' => $twothirds,
);
$write -> add_sampler_loop( %samp_loop );
$write -> add_cue( $half, "cue label 1", "cue note 1" );
@@ -58,20 +58,20 @@
my @out_files;
my $in_channels = $details -> {'channels'};
foreach my $channel ( 1 .. $in_channels ) {
- push @out_files, $wav -> write( 'multi_' . $channel . '.wav', \%out_details );
+ push @out_files, $wav -> write( 'multi_' . $channel . '.wav', \%out_details );
}
while ( 1 ) {
- my @channels = $read -> read();
- last unless @channels;
- foreach my $channel_id ( 0 .. $#channels ) {
- $out_files[$channel_id] -> write( $channels[$channel_id] );
- }
+ my @channels = $read -> read();
+ last unless @channels;
+ foreach my $channel_id ( 0 .. $#channels ) {
+ $out_files[$channel_id] -> write( $channels[$channel_id] );
+ }
}
# not entirely neccessary as finish is done in DESTROY now (if the file hasn't been finished already).
foreach my $write ( @out_files ) {
- $write -> finish();
+ $write -> finish();
}
NOTES
@@ -156,8 +156,12 @@
SYNOPSIS
use Audio::Wav;
+
my $wav = new Audio::Wav;
my $read = $wav -> read( 'filename.wav' );
+OR
+ my $read = Audio::Wav -> read( 'filename.wav' );
+
my $details = $read -> details();
DESCRIPTION
@@ -443,6 +447,7 @@
AUTHORS
---------------------------------------------------------------------
+ Brian Szymanski <ski-cpan at allafrica.com> (0.07-0.08)
Nick Peskett (see http://www.peskett.co.uk/ for contact details).
Kurt George Gjerde <kurt.gjerde at media.uib.no>. (0.02-0.03)
Modified: branches/upstream/libaudio-wav-perl/current/Wav.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaudio-wav-perl/current/Wav.pm?rev=52440&op=diff
==============================================================================
--- branches/upstream/libaudio-wav-perl/current/Wav.pm (original)
+++ branches/upstream/libaudio-wav-perl/current/Wav.pm Wed Feb 10 03:48:29 2010
@@ -4,7 +4,7 @@
use Audio::Wav::Tools;
use vars qw( $VERSION );
-$VERSION = '0.06';
+$VERSION = '0.08';
=head1 NAME
@@ -122,6 +122,10 @@
};
my $write = $wav -> write( 'testout.wav', $details );
+ my $write = Audio::Wav -> write( 'testout.wav', $details);
+ my $write = Audio::Wav -> write( 'testout.wav', $details, %options );
+
+where %options is in the form of arguments for L<Audio::Wav::Tools>.
See L<Audio::Wav::Write> for methods.
@@ -132,15 +136,24 @@
my $file = shift;
my $details = shift;
require Audio::Wav::Write;
- my $write = Audio::Wav::Write -> new( $file, $details, $self -> {'tools'} );
- return $write;
+ my $write;
+ if(ref($self)) {
+ $write = Audio::Wav::Write -> new( $file, $details, $self -> {'tools'} );
+ } else {
+ $write = Audio::Wav::Write -> new( $file, Audio::Wav::Tools -> new( @_ ) );
+ }
+ return $write;
}
=head2 read
Returns a blessed Audio::Wav::Read object.
- my $read = $wav -> read( 'testout.wav' );
+ my $read = $wav -> read( 'testin.wav' );
+ my $read = Audio::Wav -> read( 'testin.wav' );
+ my $read = Audio::Wav -> read( 'testin.wav', %options );
+
+where %options is in the form of arguments for L<Audio::Wav::Tools>.
See L<Audio::Wav::Read> for methods.
@@ -150,8 +163,13 @@
my $self = shift;
my $file = shift;
require Audio::Wav::Read;
- my $read = Audio::Wav::Read -> new( $file, $self -> {'tools'} );
- return $read;
+ my $read;
+ if(ref($self)) {
+ $read = Audio::Wav::Read -> new( $file, $self -> {'tools'} );
+ } else {
+ $read = Audio::Wav::Read -> new( $file, Audio::Wav::Tools -> new( @_ ) );
+ }
+ return $read;
}
@@ -183,6 +201,7 @@
=head1 AUTHORS
+ Brian Szymanski <ski-cpan at allafrica.com> (0.07-0.08)
Nick Peskett (see http://www.peskett.co.uk/ for contact details).
Kurt George Gjerde <kurt.gjerde at media.uib.no>. (0.02-0.03)
Modified: branches/upstream/libaudio-wav-perl/current/Wav/Read.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaudio-wav-perl/current/Wav/Read.pm?rev=52440&op=diff
==============================================================================
--- branches/upstream/libaudio-wav-perl/current/Wav/Read.pm (original)
+++ branches/upstream/libaudio-wav-perl/current/Wav/Read.pm Wed Feb 10 03:48:29 2010
@@ -4,7 +4,7 @@
use FileHandle;
use vars qw( $VERSION );
-$VERSION = '0.06';
+$VERSION = '0.08';
=head1 NAME
@@ -13,8 +13,12 @@
=head1 SYNOPSIS
use Audio::Wav;
+
my $wav = new Audio::Wav;
my $read = $wav -> read( 'filename.wav' );
+#OR
+ my $read = Audio::Wav -> read( 'filename.wav' );
+
my $details = $read -> details();
=head1 DESCRIPTION
@@ -44,30 +48,50 @@
my $handle = new FileHandle "<$file";
my $self = {
- 'real_size' => $size,
- 'file' => $file,
- 'handle' => $handle,
- 'tools' => $tools,
+ 'real_size' => $size,
+ 'file' => $file,
+ 'handle' => $handle,
+ 'tools' => $tools,
};
- bless $self, $class;
+ bless $self, $class;
unless ( defined $handle ) {
- $self -> _error( "unable to open file ($!)" );
- return $self;
- }
-
- binmode $handle;
+ $self -> _error( "unable to open file ($!)" );
+ return $self;
+ }
+
+ binmode $handle;
+
+BEGIN {
+ eval { require Inline::C };
+ if($@) {
+ $Audio::Wav::Read::_has_inline = 0;
+ } else {
+ $Audio::Wav::Read::_has_inline = 1;
+ }
+}
+
+ if( $Audio::Wav::Read::_has_inline ) {
+ local $/ = undef;
+ my $c_string = <DATA>;
+ Inline->import(C => $c_string);
+ } else {
+ #TODO: do we have a reference to $tools here if using shortcuts?
+ if( $tools && $tools -> is_debug() ) {
+ warn "can't load Inline, using slow pure perl reads\n";
+ }
+ }
$self -> {'data'} = $self -> _read_file();
my $details = $self -> details();
$self -> _init_read_sub();
$self -> {'pos'} = $details -> {'data_start'};
$self -> move_to();
- return $self;
-}
-
-# just in case there's any memory leaks
+ return $self;
+}
+
+# just in case there are any memory leaks
sub DESTROY {
my $self = shift;
return unless $self;
@@ -223,42 +247,53 @@
The numbers will be in the range;
where $samp_max = ( 2 ** bits_per_sample ) / 2
- -$samp_max to +$samp_max
-
-=cut
-
-sub read {
- my $self = shift;
- my $val;
- my $block = $self -> {'data'} -> {'block_align'};
- return () if $self -> {'pos'} + $block > $self -> {'data'} -> {'data_finish'};
- $self -> {'pos'} += read( $self -> {'handle'}, $val, $block );
- return () unless defined( $val );
- return &{ $self -> {'read_sub'} }( $val );
-}
+ -$samp_max to +$samp_max
+
+=cut
+
+# read is generated by _init_read_sub
+sub read { die "call _init_read_sub first"; };
sub _init_read_sub {
my $self = shift;
- my $details = $self -> {'data'};
- my $channels = $details -> {'channels'};
- my $sub;
+ my $handle = $self -> {'handle'};
+ my $details = $self -> {'data'};
+ my $channels = $details -> {'channels'};
+ my $block = $details -> {'block_align'};
+ my $read_op;
if ( $details -> {'bits_sample'} <= 8 ) {
- my $offset = ( 2 ** $details -> {'bits_sample'} ) / 2;
- $sub = sub { return map $_ - $offset, unpack( 'C'.$channels, shift() ) };
+ my $offset = ( 2 ** $details -> {'bits_sample'} ) / 2;
+ $read_op = q{ return map $_ - } . $offset . q{, unpack( 'C'.$channels, $val ) };
} else {
- if ( $self -> {'tools'} -> is_big_endian() ) {
- $sub = sub {
- return unpack( 's' . $channels, # 3. unpack native as signed short
- pack( 'S' . $channels, # 2. pack native unsigned short
- unpack( 'v' . $channels, shift() ) # 1. unpack little-endian unsigned short
- )
- );
- };
- } else {
- $sub = sub { return unpack( 's' . $channels, shift() ) };
- }
- }
- $self -> {'read_sub'} = $sub;
+ if ( $self -> {'tools'} -> is_big_endian() ) {
+ $read_op = q{
+ return unpack( 's' . $channels, # 3. unpack native as signed short
+ pack( 'S' . $channels, # 2. pack native unsigned short
+ unpack( 'v' . $channels, $val ) # 1. unpack little-endian unsigned short
+ )
+ );
+ };
+ } else {
+ $read_op = q{ return unpack( "s" . $channels, $val ) };
+ }
+ }
+ $self -> {'read_sub_string'} = q[
+ sub {
+ my $val;
+ $self -> {'pos'} += read( $handle, $val, $block );
+ return () unless defined( $val );
+ ] . $read_op . q[
+ };
+ ];
+ if( $Audio::Wav::Read::_has_inline ) {
+ init( $handle, $details->{'bits_sample'}/8, $channels,
+ $self -> {'tools'} -> is_big_endian() ? 1 : 0);
+ *read = \&read_c;
+ } else {
+ my $read_sub = eval $self -> {'read_sub_string'};
+ $self -> {'read_sub'} = $read_sub; #in case any legacy code peaked at that
+ *read = \&$read_sub;
+ }
}
=head2 position
@@ -687,9 +722,115 @@
=head1 AUTHORS
+ Brian Szymanski <ski-cpan at allafrica.com> (0.07-0.08)
Nick Peskett (see http://www.peskett.co.uk/ for contact details).
Kurt George Gjerde <kurt.gjerde at media.uib.no>. (0.02-0.03)
=cut
1;
+
+__DATA__
+
+//NOTE: 16, 32 bit audio do *NOT* work on big-endian platforms yet!
+//verified formats (output is identical output to pureperl):
+// 1 channel signed 16 little endian
+// 2 channel signed 16 little endian
+// 1 channel unsigned 8 little endian
+// 2 channel unsigned 8 little endian
+//verified "looks right" on these formats:
+// 1 channel signed 32 little endian
+// 2 channel signed 32 little endian
+// 1 channel signed 24 little endian
+// 2 channel signed 24 little endian
+
+//maximum number of channels per audio stream
+#define MAX_CHANNELS 10
+//maximum number of bytes per sample (in one channel)
+#define MAX_SAMPLE 4
+
+FILE *handle;
+int sample_size;
+int channels;
+int big_end;
+int is_signed;
+char buf[MAX_SAMPLE];
+SV* retvals[MAX_CHANNELS];
+
+void init(FILE *fh, int ss, int ch, int be) {
+ int i;
+ handle = fh;
+ sample_size = ss;
+ channels = ch;
+ big_end = be;
+ is_signed = (ss != 1); //TODO: is this really right?
+ for(i=0; i<MAX_CHANNELS; i++) {
+ retvals[i] = newSV(0);
+ }
+}
+
+void read_c(void *self) {
+ int samples[MAX_CHANNELS];
+ int nread;
+ Inline_Stack_Vars;
+ Inline_Stack_Reset;
+ int i, s;
+ for(i=0; i<channels; i++) {
+ // having fread in the loop is probably slightly less efficient,
+ // but it avoids byte alignment problems and fread is buffered,
+ // so it "shouldn't be a problem" (tm). more info:
+ // http://www.eventhelix.com/RealtimeMantra/ByteAlignmentAndOrdering.htm
+ nread = fread( buf, sample_size, 1, handle );
+ if( !nread ) {
+ if( feof( handle ) && i ) {
+ perror("got EOF mid-sample!");
+ } else if( ferror( handle ) ) {
+ perror("io error");
+ }
+ break;
+ }
+ switch(sample_size) {
+ case 4:
+ if(big_end) {
+ s = buf[0]; buf[0] = buf[3]; buf[3] = s;
+ s = buf[1]; buf[1] = buf[2]; buf[2] = s;
+ }
+ s = is_signed ?
+ *((int32_t *)buf) :
+ *((uint32_t *)buf)-2147483648;
+ break;
+ case 3:
+ //TODO: test this!
+ if(big_end) { s = buf[0]; buf[0] = buf[2]; buf[2] = s; }
+ s = *((uint32_t *)buf);
+ if(big_end) { s = (s & 0xffffff00) >> 8; }
+ else { s = s & 0x00ffffff; }
+ //make negative via 2s compliment if data is signed
+ //and the sign bit is set
+ if ( is_signed ) {
+ if ( s & 0x00800000 ) {
+ s = -((~s & 0x00ffffff)+1);
+ }
+ } else {
+ //we *always* return signed data
+ s -= 8388608;
+ }
+ break;
+ case 2:
+ if(big_end) { s = buf[0]; buf[0] = buf[1]; buf[1] = s; }
+ s = is_signed ?
+ *((int16_t *)buf) :
+ *((uint16_t *)buf)-32768;
+ break;
+ case 1:
+ //note: Audio::Wav *always* returns signed data
+ s = is_signed ?
+ *((int8_t *)buf) :
+ *((uint8_t *)buf)-128;
+ break;
+ }
+ sv_setiv(retvals[i], s);
+ Inline_Stack_Push(retvals[i]);
+ }
+ Inline_Stack_Done;
+}
Modified: branches/upstream/libaudio-wav-perl/current/Wav/Tools.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaudio-wav-perl/current/Wav/Tools.pm?rev=52440&op=diff
==============================================================================
--- branches/upstream/libaudio-wav-perl/current/Wav/Tools.pm (original)
+++ branches/upstream/libaudio-wav-perl/current/Wav/Tools.pm Wed Feb 10 03:48:29 2010
@@ -3,7 +3,7 @@
use strict;
use vars qw( $VERSION );
-$VERSION = '0.06';
+$VERSION = '0.08';
sub new {
my $class = shift;
Modified: branches/upstream/libaudio-wav-perl/current/Wav/Write.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaudio-wav-perl/current/Wav/Write.pm?rev=52440&op=diff
==============================================================================
--- branches/upstream/libaudio-wav-perl/current/Wav/Write.pm (original)
+++ branches/upstream/libaudio-wav-perl/current/Wav/Write.pm Wed Feb 10 03:48:29 2010
@@ -5,7 +5,7 @@
use Audio::Wav::Write::Header;
use vars qw( $VERSION );
-$VERSION = '0.06';
+$VERSION = '0.08';
=head1 NAME
Modified: branches/upstream/libaudio-wav-perl/current/Wav/Write/Header.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaudio-wav-perl/current/Wav/Write/Header.pm?rev=52440&op=diff
==============================================================================
--- branches/upstream/libaudio-wav-perl/current/Wav/Write/Header.pm (original)
+++ branches/upstream/libaudio-wav-perl/current/Wav/Write/Header.pm Wed Feb 10 03:48:29 2010
@@ -3,7 +3,7 @@
use strict;
use vars qw( $VERSION );
-$VERSION = '0.06';
+$VERSION = '0.08';
sub new {
my $class = shift;
Modified: branches/upstream/libaudio-wav-perl/current/test.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaudio-wav-perl/current/test.pl?rev=52440&op=diff
==============================================================================
--- branches/upstream/libaudio-wav-perl/current/test.pl (original)
+++ branches/upstream/libaudio-wav-perl/current/test.pl Wed Feb 10 03:48:29 2010
@@ -81,9 +81,9 @@
### Wav Copying
-print "\nTesting wav copying\n";
-
-my $read = $wav -> read( $file_out );
+print "\nTesting wav copying and shortcut syntax\n";
+
+my $read = Audio::Wav -> read( $file_out );
# print Data::Dumper->Dump([ $read -> details() ]);
More information about the Pkg-perl-cvs-commits
mailing list