r16564 - in /trunk/libaudio-wav-perl: Changes README Wav.pm Wav/Read.pm Wav/Tools.pm Wav/Write.pm Wav/Write/Header.pm debian/changelog

dmn at users.alioth.debian.org dmn at users.alioth.debian.org
Thu Mar 6 10:13:10 UTC 2008


Author: dmn
Date: Thu Mar  6 10:13:09 2008
New Revision: 16564

URL: http://svn.debian.org/wsvn/?sc=1&rev=16564
Log:
* Really use 0.06 upstream sources. Previous debian releases contained a
  patch that reverted the module to 0.04

Modified:
    trunk/libaudio-wav-perl/Changes
    trunk/libaudio-wav-perl/README
    trunk/libaudio-wav-perl/Wav.pm
    trunk/libaudio-wav-perl/Wav/Read.pm
    trunk/libaudio-wav-perl/Wav/Tools.pm
    trunk/libaudio-wav-perl/Wav/Write.pm
    trunk/libaudio-wav-perl/Wav/Write/Header.pm
    trunk/libaudio-wav-perl/debian/changelog

Modified: trunk/libaudio-wav-perl/Changes
URL: http://svn.debian.org/wsvn/trunk/libaudio-wav-perl/Changes?rev=16564&op=diff
==============================================================================
--- trunk/libaudio-wav-perl/Changes (original)
+++ trunk/libaudio-wav-perl/Changes Thu Mar  6 10:13:09 2008
@@ -28,3 +28,9 @@
 0.05  Tue Oct 25 12:20:00 2005
   - Audio::Wav::Read::position_samples should have divided by block_align, rather than multiplied (thanks David Brandt).
   - Fixed bug where unknown blocks weren't skipped (thanks Robert Hiller).
+
+0.06  Wed Mar 22 12:00:00 2006
+  - Fixed a circular reference in Audio::Wav::Write::Header that was causing memory to leak (thanks Sumitro Chowdhury).
+  - Tidied up bits and pieces.
+  - Added very basic support for WAVEFORMATEXTENSIBLE.
+  - When writing files, finish() will now be called by DESTROY if necessary.

Modified: trunk/libaudio-wav-perl/README
URL: http://svn.debian.org/wsvn/trunk/libaudio-wav-perl/README?rev=16564&op=diff
==============================================================================
--- trunk/libaudio-wav-perl/README (original)
+++ trunk/libaudio-wav-perl/README Thu Mar  6 10:13:09 2008
@@ -1,5 +1,5 @@
 ---------------------------------------------------------------------
-                  README file for Audio::Wav (0.05).
+                  README file for Audio::Wav (0.06).
 ---------------------------------------------------------------------
 
 Modules for reading & writing Microsoft WAV files.
@@ -8,8 +8,8 @@
                              INSTALLATION
 ---------------------------------------------------------------------
 
-tar zxvf Audio-Wav-0.05.tar.gz
-cd Audio-Wav-0.05
+tar zxvf Audio-Wav-0.06.tar.gz
+cd Audio-Wav-0.06
 perl Makefile.PL
 make test
 make install
@@ -26,6 +26,7 @@
     Audio::Wav - Modules for reading & writing Microsoft WAV files.
 
 SYNOPSIS
+    # copying a file and adding some cue points to the output file
     use Audio::Wav;
     my $wav = new Audio::Wav;
     my $read = $wav -> read( 'input.wav' );
@@ -34,7 +35,8 @@
 
     $write -> set_info( 'software' => 'Audio::Wav' );
     my $data;
-    while ( defined( $data = $read -> read_raw( $buffer ) ) ) {
+    #read 512 bytes
+    while ( defined( $data = $read -> read_raw( 512 ) ) ) {
 	$write -> write_raw( $data );
     }
     my $length = $read -> length_samples();
@@ -47,9 +49,48 @@
     $write -> add_cue( $half, "cue label 1", "cue note 1" );
     $write -> finish();
 
+    # splitting a multi-channel file to seperate mono files (slowly!);
+    use Audio::Wav;
+    my $read = $wav -> read( '4ch.wav' );
+    my $details = $read -> details();
+    my %out_details = map { $_ => $details -> {$_} } 'bits_sample', 'sample_rate';
+    $out_details{'channels'} = 1;
+    my @out_files;
+    my $in_channels = $details -> {'channels'};
+    foreach my $channel ( 1 .. $in_channels ) {
+	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] );
+	}
+    }
+
+    # 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();
+    }
+
 NOTES
     All sample positions are now in sample offsets (unless option
     '.01compatible' is true).
+
+    There is now *very* basic support for WAVEFORMATEXTENSIBLE (in fact it
+    only recognises that the file is in this format). The key 'wave-ex' is
+    used in the detail hash to denote this format when reading or writing.
+    I'd like to do more with this, but don't have any hardware or software
+    to test these files, also don't really have any spare time to do the
+    implementation at present.
+
+    One day I plan to learn enough C to do the sample reading/ writing in
+    XS, but for the time being it's done using pack/ unpack in Perl and is
+    slow. Working with the raw format doesn't suffer in this way.
+
+    It's likely that reading/ writing files with bit-depth greater than 16
+    won't work properly, I need to look at this at some point.
 
 DESCRIPTION
     These modules provide a method of reading & writing uncompressed
@@ -93,17 +134,17 @@
     message), and 'warning'. If no error handler is set, die and warn will
     be used.
 
-    sub myErrorHandler {
-	my( %parameters ) = @_;
-	if ( $parameters{'warning'} ) {
-	    # This is a non-critical warning
-	    warn "Warning: $parameters{'filename'}: $parameters{'message'}\n";
-	} else {
-	    # Critical error!
-	    die "ERROR: $parameters{'filename'}: $parameters{'message'}\n";
-	}
-    }
-    $wav -> set_error_handler( \&myErrorHandler );
+        sub myErrorHandler {
+            my( %parameters ) = @_;
+            if ( $parameters{'warning'} ) {
+                # This is a non-critical warning
+                warn "Warning: $parameters{'filename'}: $parameters{'message'}\n";
+            } else {
+                # Critical error!
+                die "ERROR: $parameters{'filename'}: $parameters{'message'}\n";
+            }
+        }
+        $wav -> set_error_handler( \&myErrorHandler );
 
 ---------------------------------------------------------------------
                            Audio::Wav::Read
@@ -114,13 +155,18 @@
     Audio::Wav::Read - Module for reading Microsoft WAV files.
 
 SYNOPSIS
-        use Audio::Wav;
-        my $wav = new Audio::Wav;
-        my $read = $wav -> read( 'filename.wav' );
-        my $details = $read -> details();
+    use Audio::Wav;
+    my $wav = new Audio::Wav;
+    my $read = $wav -> read( 'filename.wav' );
+    my $details = $read -> details();
 
 DESCRIPTION
     Reads Microsoft Wav files.
+
+SEE ALSO
+    Audio::Wav
+
+    Audio::Wav::Write
 
 NOTES
     This module shouldn't be used directly, a blessed object can be returned
@@ -301,6 +347,11 @@
 DESCRIPTION
     Currently only writes to a file.
 
+SEE ALSO
+    Audio::Wav
+
+    Audio::Wav::Read
+
 NOTES
     This module shouldn't be used directly, a blessed object can be returned
     from Audio::Wav.
@@ -393,7 +444,7 @@
 ---------------------------------------------------------------------
 
     Nick Peskett (see http://www.peskett.co.uk/ for contact details).
-    Kurt George Gjerde <kurt.gjerde at media.uib.no>. (from 0.02)
+    Kurt George Gjerde <kurt.gjerde at media.uib.no>. (0.02-0.03)
 
 ---------------------------------------------------------------------
                                 END

Modified: trunk/libaudio-wav-perl/Wav.pm
URL: http://svn.debian.org/wsvn/trunk/libaudio-wav-perl/Wav.pm?rev=16564&op=diff
==============================================================================
--- trunk/libaudio-wav-perl/Wav.pm (original)
+++ trunk/libaudio-wav-perl/Wav.pm Thu Mar  6 10:13:09 2008
@@ -4,7 +4,7 @@
 use Audio::Wav::Tools;
 
 use vars qw( $VERSION );
-$VERSION = '0.04';
+$VERSION = '0.06';
 
 =head1 NAME
 
@@ -12,6 +12,7 @@
 
 =head1 SYNOPSIS
 
+    # copying a file and adding some cue points to the output file
     use Audio::Wav;
     my $wav = new Audio::Wav;
     my $read = $wav -> read( 'input.wav' );
@@ -20,7 +21,8 @@
 
     $write -> set_info( 'software' => 'Audio::Wav' );
     my $data;
-    while ( defined( $data = $read -> read_raw( $buffer ) ) ) {
+    #read 512 bytes
+    while ( defined( $data = $read -> read_raw( 512 ) ) ) {
 	$write -> write_raw( $data );
     }
     my $length = $read -> length_samples();
@@ -33,9 +35,45 @@
     $write -> add_cue( $half, "cue label 1", "cue note 1" );
     $write -> finish();
 
+
+    # splitting a multi-channel file to seperate mono files (slowly!);
+    use Audio::Wav;
+    my $read = $wav -> read( '4ch.wav' );
+    my $details = $read -> details();
+    my %out_details = map { $_ => $details -> {$_} } 'bits_sample', 'sample_rate';
+    $out_details{'channels'} = 1;
+    my @out_files;
+    my $in_channels = $details -> {'channels'};
+    foreach my $channel ( 1 .. $in_channels ) {
+	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] );
+	}
+    }
+
+    # 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();
+    }
+
+
 =head1 NOTES
 
 All sample positions are now in sample offsets (unless option '.01compatible' is true).
+
+There is now *very* basic support for WAVEFORMATEXTENSIBLE (in fact it only recognises that the file is in this format).
+The key 'wave-ex' is used in the detail hash to denote this format when reading or writing.
+I'd like to do more with this, but don't have any hardware or software to test these files, also don't really have any spare time to do the implementation at present.
+
+One day I plan to learn enough C to do the sample reading/ writing in XS, but for the time being it's done using pack/ unpack in Perl and is slow.
+Working with the raw format doesn't suffer in this way.
+
+It's likely that reading/ writing files with bit-depth greater than 16 won't work properly, I need to look at this at some point.
 
 =head1 DESCRIPTION
 
@@ -146,7 +184,7 @@
 =head1 AUTHORS
 
     Nick Peskett (see http://www.peskett.co.uk/ for contact details).
-    Kurt George Gjerde <kurt.gjerde at media.uib.no>. (from 0.02)
+    Kurt George Gjerde <kurt.gjerde at media.uib.no>. (0.02-0.03)
 
 =cut
 

Modified: trunk/libaudio-wav-perl/Wav/Read.pm
URL: http://svn.debian.org/wsvn/trunk/libaudio-wav-perl/Wav/Read.pm?rev=16564&op=diff
==============================================================================
--- trunk/libaudio-wav-perl/Wav/Read.pm (original)
+++ trunk/libaudio-wav-perl/Wav/Read.pm Thu Mar  6 10:13:09 2008
@@ -4,7 +4,7 @@
 use FileHandle;
 
 use vars qw( $VERSION );
-$VERSION = '0.04';
+$VERSION = '0.06';
 
 =head1 NAME
 
@@ -67,6 +67,17 @@
     return $self;
 }
 
+# just in case there's any memory leaks
+sub DESTROY {
+    my $self = shift;
+    return unless $self;
+    if ( exists $self -> {'handle'} ) {
+	$self -> {'handle'} -> close();
+    }
+    if ( exists $self -> {'tools'} ) {
+	delete $self -> {'tools'};
+    }
+}
 
 =head2 file_name
 
@@ -436,8 +447,12 @@
 	if ( $head eq 'fmt ' ) {
 	    my $format = $self -> _read_fmt( $chunk_len );
 	    my $comp = delete( $format -> {'format'} );
-	    unless ( $comp == 1 ) {
+	    if ( $comp == 65534 ) {
+		$format -> {'wave-ex'} = 1;
+	    } elsif ( $comp != 1 ) {
 		return $self -> _error( "seems to be compressed, I can't handle anything other than uncompressed PCM" );
+	    } else {
+		$format -> {'wave-ex'} = 0;
 	    }
 	    %details = ( %details, %$format );
 	    next;
@@ -459,8 +474,6 @@
 	} else {
 	    $head =~ s/[^\w]+//g;
 	    $self -> _error( "ignored unknown block type: $head at $self->{pos} for $chunk_len", 'warn' );
-# not sure why this was here
-#	    next if $chunk_len > 100;
 	}
 
 	seek $handle, $chunk_len, 1;
@@ -675,7 +688,7 @@
 =head1 AUTHORS
 
     Nick Peskett (see http://www.peskett.co.uk/ for contact details).
-    Kurt George Gjerde <kurt.gjerde at media.uib.no>. (from 0.02)
+    Kurt George Gjerde <kurt.gjerde at media.uib.no>. (0.02-0.03)
 
 =cut
 

Modified: trunk/libaudio-wav-perl/Wav/Tools.pm
URL: http://svn.debian.org/wsvn/trunk/libaudio-wav-perl/Wav/Tools.pm?rev=16564&op=diff
==============================================================================
--- trunk/libaudio-wav-perl/Wav/Tools.pm (original)
+++ trunk/libaudio-wav-perl/Wav/Tools.pm Thu Mar  6 10:13:09 2008
@@ -3,7 +3,7 @@
 use strict;
 
 use vars qw( $VERSION );
-$VERSION = '0.04';
+$VERSION = '0.06';
 
 sub new {
     my $class = shift;

Modified: trunk/libaudio-wav-perl/Wav/Write.pm
URL: http://svn.debian.org/wsvn/trunk/libaudio-wav-perl/Wav/Write.pm?rev=16564&op=diff
==============================================================================
--- trunk/libaudio-wav-perl/Wav/Write.pm (original)
+++ trunk/libaudio-wav-perl/Wav/Write.pm Thu Mar  6 10:13:09 2008
@@ -5,10 +5,7 @@
 use Audio::Wav::Write::Header;
 
 use vars qw( $VERSION );
-$VERSION = '0.04';
-
-my @needed = qw( bits_sample channels sample_rate );
-my @wanted = qw( block_align bytes_sec info);
+$VERSION = '0.06';
 
 =head1 NAME
 
@@ -94,6 +91,7 @@
 	'details'	=> $details,
 	'block_align'	=> $details -> {'block_align'},
 	'tools'		=> $tools,
+	'done_finish'	=> 0,
     };
 
     bless $self, $class;
@@ -120,6 +118,13 @@
     return $self;
 }
 
+sub DESTROY {
+    my $self = shift;
+    return unless $self;
+    return if $self -> {'done_finish'};
+    $self -> finish();
+}
+
 =head2 finish
 
 Finishes off & closes the current wav file.
@@ -131,11 +136,9 @@
 sub finish {
     my $self = shift;
     $self -> _purge_cache() if $self -> {'use_cache'};
-    my $length = $self -> {'pos'};
-    my $header = $self -> {'header'};
-    $header -> finish( $length );
+    $self -> {'header'} -> finish( $self -> {'pos'} );
     $self -> {'handle'} -> close();
-    my $filename = $self -> {'out_file'};
+    $self -> {'done_finish'} = 1;
 }
 
 =head2 add_cue
@@ -325,7 +328,7 @@
 sub _start_file {
     my $self = shift;
     my( $file, $details, $tools, $handle ) = map $self -> {$_}, qw( out_file details tools handle );
-    my $header = Audio::Wav::Write::Header -> new( $file, $details, $tools, $handle, $self );
+    my $header = Audio::Wav::Write::Header -> new( $file, $details, $tools, $handle );
     $self -> {'header'} = $header;
     my $data = $header -> start();
     $self -> write_raw( $data );
@@ -347,6 +350,9 @@
     my $details = $self -> {'details'};
     my $output = {};
     my @missing;
+    my @needed = ( 'bits_sample', 'channels', 'sample_rate' );
+    my @wanted = ( 'block_align', 'bytes_sec', 'info', 'wave-ex' );
+
     foreach my $need ( @needed ) {
 	if ( exists( $details -> {$need} ) && $details -> {$need} ) {
 	    $output -> {$need} = $details -> {$need};
@@ -416,7 +422,7 @@
 =head1 AUTHORS
 
     Nick Peskett (see http://www.peskett.co.uk/ for contact details).
-    Kurt George Gjerde <kurt.gjerde at media.uib.no>. (from 0.02)
+    Kurt George Gjerde <kurt.gjerde at media.uib.no>. (0.02-0.03)
 
 =cut
 

Modified: trunk/libaudio-wav-perl/Wav/Write/Header.pm
URL: http://svn.debian.org/wsvn/trunk/libaudio-wav-perl/Wav/Write/Header.pm?rev=16564&op=diff
==============================================================================
--- trunk/libaudio-wav-perl/Wav/Write/Header.pm (original)
+++ trunk/libaudio-wav-perl/Wav/Write/Header.pm Thu Mar  6 10:13:09 2008
@@ -3,7 +3,7 @@
 use strict;
 
 use vars qw( $VERSION );
-$VERSION = '0.04';
+$VERSION = '0.06';
 
 sub new {
     my $class = shift;
@@ -11,7 +11,6 @@
     my $details = shift;
     my $tools = shift;
     my $handle = shift;
-    my $parent = shift;
     my $self = {
 	'file'		=> $file,
 	'data'		=> undef,
@@ -19,7 +18,6 @@
 	'tools'		=> $tools,
 	'handle'	=> $handle,
 	'whole_offset'	=> 4,
-	'parent'	=> $parent,
     };
     bless $self, $class;
     return $self;
@@ -65,16 +63,14 @@
     my $whole_num = pack( 'V', $self -> {'total'} + $data_size + $data_pad + $extra );  #includes padding
     my $len_long = length( $whole_num );
 
-    my $parent = $self -> {'parent'};
-
     # RIFF-length
     my $seek_to = $self -> {'whole_offset'};
-    seek( $handle, $seek_to, 0 ) || return $parent -> _error( "unable to seek to $seek_to ($!)" );
+    seek( $handle, $seek_to, 0 ) || return $self -> _error( "unable to seek to $seek_to ($!)" );
     syswrite( $handle, $whole_num, $len_long );
 
     # data-length
     $seek_to = $self -> {'data_offset'};
-    seek( $handle, $seek_to, 0 ) || return $parent -> _error( "unable to seek to $seek_to ($!)" );
+    seek( $handle, $seek_to, 0 ) || return $self -> _error( "unable to seek to $seek_to ($!)" );
     my $data_num = pack( 'V', $data_size );
     syswrite( $handle, $data_num, $len_long );
     return 1;
@@ -266,7 +262,8 @@
     my $self = shift;
     my $details = $self -> {'details'};
     my $types = $self -> {'tools'} -> get_wav_pack();
-    $details -> {'format'} = 1;
+    my $wave_ex = exists( $details -> {'wave-ex'} ) && $details -> {'wave-ex'} ? 1 : 0;
+    $details -> {'format'} = $wave_ex ? 65534 : 1;
     my $output;
     foreach my $type ( @{ $types -> {'order'} } ) {
 	$output .= pack( $types -> {'types'} -> {$type}, $details -> {$type} );

Modified: trunk/libaudio-wav-perl/debian/changelog
URL: http://svn.debian.org/wsvn/trunk/libaudio-wav-perl/debian/changelog?rev=16564&op=diff
==============================================================================
--- trunk/libaudio-wav-perl/debian/changelog (original)
+++ trunk/libaudio-wav-perl/debian/changelog Thu Mar  6 10:13:09 2008
@@ -21,6 +21,8 @@
 
   [ Damyan Ivanov ]
   * drop unneeded call to dh_installdirs
+  * Really use 0.06 upstream sources. Previous debian releases contained a
+    patch that reverted the module to 0.04
 
  -- gregor herrmann <gregor+debian at comodo.priv.at>  Tue, 26 Feb 2008 21:44:56 +0100
 




More information about the Pkg-perl-cvs-commits mailing list