r52748 - in /branches/upstream/libaudio-wav-perl/current: COPYRIGHT Changes MANIFEST META.yml README Wav.pm Wav/Read.pm Wav/Tools.pm Wav/Write.pm Wav/Write/Header.pm test.pl xt/ xt/perlcritic.t xt/pod-coverage.t xt/pod.t

jawnsy-guest at users.alioth.debian.org jawnsy-guest at users.alioth.debian.org
Sun Feb 14 23:57:04 UTC 2010


Author: jawnsy-guest
Date: Sun Feb 14 23:56:52 2010
New Revision: 52748

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=52748
Log:
[svn-upgrade] Integrating new upstream version, libaudio-wav-perl (0.10)

Added:
    branches/upstream/libaudio-wav-perl/current/COPYRIGHT
    branches/upstream/libaudio-wav-perl/current/xt/
    branches/upstream/libaudio-wav-perl/current/xt/perlcritic.t
    branches/upstream/libaudio-wav-perl/current/xt/pod-coverage.t
    branches/upstream/libaudio-wav-perl/current/xt/pod.t
Modified:
    branches/upstream/libaudio-wav-perl/current/Changes
    branches/upstream/libaudio-wav-perl/current/MANIFEST
    branches/upstream/libaudio-wav-perl/current/META.yml
    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

Added: branches/upstream/libaudio-wav-perl/current/COPYRIGHT
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaudio-wav-perl/current/COPYRIGHT?rev=52748&op=file
==============================================================================
--- branches/upstream/libaudio-wav-perl/current/COPYRIGHT (added)
+++ branches/upstream/libaudio-wav-perl/current/COPYRIGHT Sun Feb 14 23:56:52 2010
@@ -1,0 +1,4 @@
+Copyright (c) 2010 Brian Szymanski <ski-cpan at allafrica.com>
+Copyright (c) 1999-2001,2004-2006 Nick Peskett (http://www.peskett.co.uk/)
+Copyright (c) 2004 Kurt George Gjerde <KJERDE at cpan.org>
+

Modified: branches/upstream/libaudio-wav-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaudio-wav-perl/current/Changes?rev=52748&op=diff
==============================================================================
--- branches/upstream/libaudio-wav-perl/current/Changes (original)
+++ branches/upstream/libaudio-wav-perl/current/Changes Sun Feb 14 23:56:52 2010
@@ -1,39 +1,19 @@
 Revision history for Perl extension Audio::Wav.
 
-0.01  Fri Dec 11 05:54:22 1998
-  - original version; created by h2xs 1.18
+0.10  Sun Feb 14 04:09:00 GMT 2010
+  - add LICENSE information for debian folks
+  - include xt/
 
-0.02  Sat Sep 01 15:15:00 2001
-  - works on big endian machines!
-  - no need for Audio::Tools anymore
-  - added support for info & sampler blocks.
-  - now honours padding bytes
-  - read & read_raw no longer return non-audio data.
-  - added error handler.
-  - slight speed improvement for read & write methods
-  - some other fixes.
+0.09  Thu Feb 11 14:58:37 GMT 2010
+  - Support 24 and 32 bit wav reading w/o Inline::C (from Wolfram humann)
+    ( see https://rt.cpan.org/Public/Bug/Display.html?id=36452 )
+  - add a META.yml and some other easy kwalitee tweaks
+  - Audio::Wav::Read::_has_inline moved to Audio::Wav::_has_inline so
+    it can be queried before instantiating a reader (and later be used
+    internally for Audio::Wav::Write)
 
-0.03  Fri Jun 11 13:29:00 2004
-  - minor bug fix to pass tests with Perl 5.8.3 (thanks to Jeremy Devenport).
-
-0.04  Thu Dec 30 07:47:00 2004
-  - fixed a bug in Audio::Wav::Read::move_to, now adds where the data actually starts to the position given.
-  - Audio::Wav::Read::move_to now rereads data length to see if file has grown since this was last read.
-  - added method Audio::Wav::Read::reread_length, rereads the length of the file in case it is being written to as we are reading it.
-  - added method Audio::Wav::Read::read_raw_samples which will read X samples in raw format.
-  - added method Audio::Wav::Read::position_samples which returns the current audio data position in samples.
-  - in method Audio::Wav::Write::add_cue, if sample position supplied is undefined, then the position will be the current position (end of all data written so far).
-  - in method Audio::Wav::Write, moved the option of not caching data from the write_raw method to new.
-
-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.
+0.08  Tue Feb 09 06:29:43 GMT 2010
+  - fix regression: read() returned bogus samples when Inline::C not available
 
 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
@@ -47,13 +27,48 @@
   - experimental support for reading 24- and 32- bit data (suspected to
     work on little endian machines that use Inline::C)
 
-0.08  Tue Feb 09 06:29:43 GMT 2010
-  - fix regression: read() returned bogus samples when Inline::C not available
+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.
 
-0.09  Thu Feb 11 14:58:37 GMT 2010
-  - Support 24 and 32 bit wav reading w/o Inline::C (from Wolfram humann)
-    ( see https://rt.cpan.org/Public/Bug/Display.html?id=36452 )
-  - add a META.yml and some other easy kwalitee tweaks
-  - Audio::Wav::Read::_has_inline moved to Audio::Wav::_has_inline so
-    it can be queried before instantiating a reader (and later be used
-    internally for Audio::Wav::Write)
+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.04  Thu Dec 30 07:47:00 2004
+  - fixed a bug in Audio::Wav::Read::move_to, now adds where the data
+    actually starts to the position given.
+  - Audio::Wav::Read::move_to now rereads data length to see if file has
+    grown since this was last read.
+  - added method Audio::Wav::Read::reread_length, rereads the length of
+    the file in case it is being written to as we are reading it.
+  - added method Audio::Wav::Read::read_raw_samples which will read X
+    samples in raw format.
+  - added method Audio::Wav::Read::position_samples which returns the
+    current audio data position in samples.
+  - in method Audio::Wav::Write::add_cue, if sample position supplied
+    is undefined, then the position will be the current position (end
+    of all data written so far).
+  - in method Audio::Wav::Write, moved the option of not caching data
+    from the write_raw method to new.
+
+0.03  Fri Jun 11 13:29:00 2004
+  - minor bug fix to pass tests with Perl 5.8.3 (thanks to Jeremy Devenport).
+
+0.02  Sat Sep 01 15:15:00 2001
+  - works on big endian machines!
+  - no need for Audio::Tools anymore
+  - added support for info & sampler blocks.
+  - now honours padding bytes
+  - read & read_raw no longer return non-audio data.
+  - added error handler.
+  - slight speed improvement for read & write methods
+  - some other fixes.
+
+0.01  Fri Dec 11 05:54:22 1998
+  - original version; created by h2xs 1.18
+

Modified: branches/upstream/libaudio-wav-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaudio-wav-perl/current/MANIFEST?rev=52748&op=diff
==============================================================================
--- branches/upstream/libaudio-wav-perl/current/MANIFEST (original)
+++ branches/upstream/libaudio-wav-perl/current/MANIFEST Sun Feb 14 23:56:52 2010
@@ -1,3 +1,4 @@
+COPYRIGHT
 Changes
 MANIFEST
 README
@@ -12,3 +13,7 @@
 Wav/Write.pm
 Wav/Tools.pm
 Wav/Write/Header.pm
+xt/perlcritic.t
+xt/pod-coverage.t
+xt/pod.t
+

Modified: 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=52748&op=diff
==============================================================================
--- branches/upstream/libaudio-wav-perl/current/META.yml (original)
+++ branches/upstream/libaudio-wav-perl/current/META.yml Sun Feb 14 23:56:52 2010
@@ -1,6 +1,6 @@
 --- #YAML:1.0
 name:               Audio-Wav
-version:            0.09
+version:            0.10
 abstract:           ~
 author:  []
 license:            unknown

Modified: branches/upstream/libaudio-wav-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaudio-wav-perl/current/README?rev=52748&op=diff
==============================================================================
--- branches/upstream/libaudio-wav-perl/current/README (original)
+++ branches/upstream/libaudio-wav-perl/current/README Sun Feb 14 23:56:52 2010
@@ -1,5 +1,5 @@
 ---------------------------------------------------------------------
-                  README file for Audio::Wav (0.09).
+                  README file for Audio::Wav (0.10).
 ---------------------------------------------------------------------
 
 Modules for reading & writing Microsoft WAV files.
@@ -13,6 +13,17 @@
 perl Makefile.PL
 make test
 make install
+
+---------------------------------------------------------------------
+                        LICENSE AND COPYRIGHT
+---------------------------------------------------------------------
+
+his program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+Copyright (c) 2010 Brian Szymanski <ski-cpan at allafrica.com>
+Copyright (c) 1999-2001,2004-2006 Nick Peskett (http://www.peskett.co.uk/)
+Copyright (c) 2004 Kurt George Gjerde <KJERDE at cpan.org>
 
 ---------------------------------------------------------------------
                             DOCUMENTATION
@@ -448,7 +459,7 @@
 ---------------------------------------------------------------------
 
     Nick Peskett (see http://www.peskett.co.uk/ for contact details).
-    Brian Szymanski <ski-cpan at allafrica.com> (0.07-0.09)
+    Brian Szymanski <ski-cpan at allafrica.com> (0.07-0.10)
     Wolfram humann (pureperl 24 and 32 bit read support in 0.09)
     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=52748&op=diff
==============================================================================
--- branches/upstream/libaudio-wav-perl/current/Wav.pm (original)
+++ branches/upstream/libaudio-wav-perl/current/Wav.pm Sun Feb 14 23:56:52 2010
@@ -6,7 +6,7 @@
 use Audio::Wav::Tools;
 
 use vars qw( $VERSION );
-$VERSION = '0.09';
+$VERSION = '0.10';
 
 BEGIN {
     eval { require Inline::C };
@@ -34,13 +34,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" );
@@ -56,20 +56,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();
     }
 
 
@@ -104,9 +104,9 @@
 All the parameters are optional and default to 0
 
     my %options = (
-	'.01compatible'		=> 0,
-	'oldcooledithack'	=> 0,
-	'debug'			=> 0,
+        '.01compatible'   => 0,
+        'oldcooledithack' => 0,
+        'debug'           => 0,
     );
     my $wav = Audio::Wav -> new( %options );
 
@@ -119,7 +119,7 @@
         'tools' => $tools,
     };
     bless $self, $class;
-    return $self;
+    return $self; 
 }
 
 =head2 write
@@ -146,7 +146,7 @@
     my ($self, $file, $details, @args) = @_;
     require Audio::Wav::Write;
     my $write;
-    if(ref($self)) {
+    if(ref $self) {
         $write = Audio::Wav::Write -> new( $file, $details, $self -> {'tools'} );
     } else {
         $write = Audio::Wav::Write -> new( $file, Audio::Wav::Tools -> new( @args ) );
@@ -172,7 +172,7 @@
     my ($self, $file, @args) = @_;
     require Audio::Wav::Read;
     my $read;
-    if(ref($self)) {
+    if(ref $self) {
         $read = Audio::Wav::Read -> new( $file, $self -> {'tools'} );
     } else {
         $read = Audio::Wav::Read -> new( $file, Audio::Wav::Tools -> new( @args ) );
@@ -207,10 +207,16 @@
     $self -> {'tools'} -> set_error_handler( @args );
 }
 
+=head1 COPYRIGHT
+
+    Copyright (c) 2010 Brian Szymanski <ski-cpan at allafrica.com>
+    Copyright (c) 1999-2001,2004-2006 Nick Peskett (http://www.peskett.co.uk/)
+    Copyright (c) 2004 Kurt George Gjerde <KJERDE at cpan.org>
+
 =head1 AUTHORS
 
     Nick Peskett (see http://www.peskett.co.uk/ for contact details).
-    Brian Szymanski <ski-cpan at allafrica.com> (0.07-0.09)
+    Brian Szymanski <ski-cpan at allafrica.com> (0.07-0.10)
     Wolfram humann (pureperl 24 and 32 bit read support in 0.09)
     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=52748&op=diff
==============================================================================
--- branches/upstream/libaudio-wav-perl/current/Wav/Read.pm (original)
+++ branches/upstream/libaudio-wav-perl/current/Wav/Read.pm Sun Feb 14 23:56:52 2010
@@ -6,7 +6,7 @@
 use FileHandle;
 
 use vars qw( $VERSION );
-$VERSION = '0.09';
+$VERSION = '0.10';
 
 =head1 NAME
 
@@ -119,16 +119,16 @@
 (for example, a file marked up for use in Audio::Mix)
 
     {
-	'keywords'	=> 'bpm:126 key:a',
-	'name'		=> 'Mission Venice',
-	'artist'	=> 'Nightmares on Wax'
+        'keywords' => 'bpm:126 key:a',
+        'name'     => 'Mission Venice',
+        'artist'   => 'Nightmares on Wax'
     };
 
 =cut
 
 sub get_info {
     my $self = shift;
-    return unless exists( $self -> {'data'} -> {'info'} );
+    return unless exists $self -> {'data'} -> {'info'};
     return $self -> {'data'} -> {'info'};
 }
 
@@ -173,7 +173,7 @@
 
 sub get_cues {
     my $self = shift;
-    return unless exists( $self -> {'data'} -> {'cue'} );
+    return unless exists $self -> {'data'} -> {'cue'};
     my $data = $self -> {'data'};
     my $cues = $data -> {'cue'};
     my $output = {};
@@ -225,8 +225,8 @@
     my $len = shift;
     my $data;
     return unless $len && $len > 0;
-    $self -> {'pos'} += read( $self -> {'handle'}, $data, $len );
-    return $data;
+    $self -> {'pos'} += read $self -> {'handle'}, $data, $len;
+    return $data; 
 }
 
 =head2 read
@@ -245,7 +245,7 @@
 =cut
 
 # read is generated by _init_read_sub
-sub read { die "call _init_read_sub first"; };
+sub read { die "ERROR: can't call read without first calling _init_read_sub"; };
 
 sub _init_read_sub {
     my $self = shift;
@@ -384,7 +384,7 @@
 sub move_to_sample {
     my $self = shift;
     my $pos = shift;
-    return $self -> move_to() unless defined( $pos );
+    return $self -> move_to() unless defined $pos ;
     return $self -> move_to( $pos * $self -> {'data'} -> {'block_align'} );
 }
 
@@ -494,15 +494,15 @@
             # rectify cooledit 96 data-chunk bug
             $head = $walkover . $self -> _read_raw( 3 );
             $walkover = undef;
-            print( "debug: CoolEdit 96 data-chunk bug detected!\n" ) if $debug;
+            print "debug: CoolEdit 96 data-chunk bug detected!\n" if $debug;
         } else {
             $head = $self -> _read_raw( 4 );
         }
         my $chunk_len = $self -> _read_long();
-        printf( "debug: head: '$head' at %6d (%6d bytes)\n", $self->{pos}, $chunk_len ) if $debug;
+        printf "debug: head: '$head' at %6d (%6d bytes)\n", $self->{pos}, $chunk_len if $debug;
         if ( $head eq 'fmt ' ) {
             my $format = $self -> _read_fmt( $chunk_len );
-            my $comp = delete( $format -> {'format'} );
+            my $comp = delete $format -> {'format'};
             if ( $comp == 65534 ) {
                 $format -> {'wave-ex'} = 1;
             } elsif ( $comp != 1 ) {
@@ -574,7 +574,7 @@
     my $pos = 4;
 
     if ( $note eq 'adtl' ) {
-        my %allowed = map { $_, 1 } qw( ltxt note labl );
+        my %allowed = map { $_ => 1 } qw( ltxt note labl );
         while ( $pos < $length ) {
             my $head = $self -> _read_raw( 4 );
             $pos += 4;
@@ -636,7 +636,7 @@
     my $output;
     for ( 1 .. $cues ) {
         my $record = $self -> _decode_block( \@fields, \@plain );
-        my $id = delete( $record -> {'id'} );
+        my $id = delete $record -> {'id'};
         $output -> {$id} = $record;
     }
     return $output; 
@@ -699,7 +699,7 @@
             }
         }
     }
-    my $no_fields = scalar( @{$fields} );
+    my $no_fields = scalar @{$fields};
     my %record;
     for my $id ( 0 .. $#{$fields} ) {
         if ( exists $plain{$id} ) {
@@ -721,7 +721,7 @@
     foreach my $type ( @{$fields} ) {
         $pack_str .= $types -> {'types'} -> {$type};
     }
-    my @data = unpack( $pack_str, $data );
+    my @data = unpack $pack_str, $data;
     my %record;
     for my $id ( 0 .. $#{$fields} ) {
         $record{ $fields -> [$id] } = $data[$id];
@@ -732,7 +732,7 @@
 sub _read_long {
     my $self = shift;
     my $data = $self -> _read_raw( 4 );
-    return unpack( 'V', $data );
+    return unpack 'V', $data; 
 }
 
 sub _error {
@@ -743,7 +743,7 @@
 =head1 AUTHORS
 
     Nick Peskett (see http://www.peskett.co.uk/ for contact details).
-    Brian Szymanski <ski-cpan at allafrica.com> (0.07-0.09)
+    Brian Szymanski <ski-cpan at allafrica.com> (0.07-0.10)
     Wolfram humann (pureperl 24 and 32 bit read support in 0.09)
     Kurt George Gjerde <kurt.gjerde at media.uib.no>. (0.02-0.03)
 

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=52748&op=diff
==============================================================================
--- branches/upstream/libaudio-wav-perl/current/Wav/Tools.pm (original)
+++ branches/upstream/libaudio-wav-perl/current/Wav/Tools.pm Sun Feb 14 23:56:52 2010
@@ -4,7 +4,7 @@
 eval { require warnings; }; #it's ok if we can't load warnings
 
 use vars qw( $VERSION );
-$VERSION = '0.09';
+$VERSION = '0.10';
 
 sub new {
     my ($class, %options) = @_;
@@ -77,7 +77,7 @@
 
 sub get_rev_info_fields {
     my $self = shift;
-    return %{ $self -> {'rev_info_fields'} } if exists( $self -> {'rev_info_fields'} );
+    return %{ $self -> {'rev_info_fields'} } if exists $self -> {'rev_info_fields'};
     my %info_fields = $self -> get_info_fields();
     my %rev_info;
     foreach my $key ( keys %info_fields ) {

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=52748&op=diff
==============================================================================
--- branches/upstream/libaudio-wav-perl/current/Wav/Write.pm (original)
+++ branches/upstream/libaudio-wav-perl/current/Wav/Write.pm Sun Feb 14 23:56:52 2010
@@ -7,7 +7,7 @@
 use Audio::Wav::Write::Header;
 
 use vars qw( $VERSION );
-$VERSION = '0.09';
+$VERSION = '0.10';
 
 =head1 NAME
 
@@ -79,9 +79,9 @@
     my $handle = new FileHandle ">$out_file";
 
     my $use_cache = 1;
-    if ( ref( $details ) eq 'HASH' && exists( $details -> {'no_cache'} ) ) {
-	my $no_cache = delete $details -> {'no_cache'};
-	$use_cache = 0 if $no_cache;
+    if ( ref $details eq 'HASH' && exists $details -> {'no_cache'} ) {
+        my $no_cache = delete $details -> {'no_cache'};
+        $use_cache = 0 if $no_cache;
     }
 
     my $self = {
@@ -100,7 +100,7 @@
 
     unless ( defined $handle ) {
         my $error = $!;
-        chomp( $error );
+        chomp $error;
         $self -> _error( "unable to open file ($error)" );
         return $self;
     }
@@ -267,9 +267,9 @@
     my ($self, @args) = @_;
     my $channels = $self -> {'details'} -> {'channels'};
     if ( $self -> {'use_offset'} ) {
-        return $self -> write_raw( pack( 'C'.$channels, map { $_ + $self -> {'use_offset'} } @args ) );
+        return $self -> write_raw( pack 'C'.$channels, map { $_ + $self -> {'use_offset'} } @args );
     } else {
-        return $self -> write_raw( pack( 'v'.$channels, @args ) );
+        return $self -> write_raw( pack 'v'.$channels, @args );
     }
 }
 
@@ -290,12 +290,12 @@
     my $self = shift;
     my $data = shift;
     my $len = shift;
-    $len = length( $data ) unless $len;
+    $len = length $data unless $len;
     return unless $len;
     my $wrote = $len;
     if ( $self -> {'use_cache'} ) {
         $self -> {'write_cache'} .= $data;
-        my $cache_len = length( $self -> {'write_cache'} );
+        my $cache_len = length $self -> {'write_cache'};
         $self -> _purge_cache( $cache_len ) unless $cache_len < $self -> {'cache_size'};
     } else {
         $wrote = syswrite $self -> {'handle'}, $data, $len;
@@ -341,8 +341,8 @@
     my $len = shift;
     return unless $self -> {'write_cache'};
     my $cache = $self -> {'write_cache'};
-    $len = length( $cache ) unless $len;
-    my $res = syswrite( $self -> {'handle'}, $cache, $len );
+    $len = length $cache unless $len;
+    my $res = syswrite $self -> {'handle'}, $cache, $len;
     $self -> {'write_cache'} = undef;
 }
 
@@ -351,8 +351,8 @@
     my $details = $self -> {'details'};
     my $output = {};
     my @missing;
-    my @needed = ( 'bits_sample', 'channels', 'sample_rate' );
-    my @wanted = ( 'block_align', 'bytes_sec', 'info', 'wave-ex' );
+    my @needed = qw ( bits_sample channels sample_rate );
+    my @wanted = qw ( block_align bytes_sec info wave-ex );
 
     foreach my $need ( @needed ) {
         if ( exists( $details -> {$need} ) && $details -> {$need} ) {
@@ -361,16 +361,15 @@
             push @missing, $need;
         }
     }
-    return $self -> _error("I need the following parameters supplied: " . join( ', ', @missing ) ) if @missing;
+    return $self -> _error('I need the following parameters supplied: ' . join ', ', @missing ) if @missing;
     foreach my $want ( @wanted ) {
         next unless ( exists( $details -> {$want} ) && $details -> {$want} );
         $output -> {$want} = $details -> {$want};
     }
     unless ( exists $details -> {'block_align'} ) {
         my( $channels, $bits ) = map { $output -> {$_} } qw( channels bits_sample );
-        my $mod_bits = $bits % 8;
-        $mod_bits = 1 if $mod_bits;
-        $mod_bits += int( $bits / 8 );
+        my $mod_bits = $bits % 8 ? 1 : 0;
+        $mod_bits += int $bits / 8;
         $output -> {'block_align'} = $channels * $mod_bits;
     }
     unless ( exists $output -> {'bytes_sec'} ) {
@@ -402,7 +401,7 @@
     }
     if ( exists $details -> {'sampler'} ) {
         my $sampler = $details -> {'sampler'};
-        my $loops = delete( $sampler -> {'loop'} );
+        my $loops = delete $sampler -> {'loop'};
         $self -> set_sampler_info( %{$sampler} );
         foreach my $loop ( @{$loops} ) {
             $self -> add_sampler_loop( %{$loop} );

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=52748&op=diff
==============================================================================
--- branches/upstream/libaudio-wav-perl/current/Wav/Write/Header.pm (original)
+++ branches/upstream/libaudio-wav-perl/current/Wav/Write/Header.pm Sun Feb 14 23:56:52 2010
@@ -4,7 +4,7 @@
 eval { require warnings; }; #it's ok if we can't load warnings
 
 use vars qw( $VERSION );
-$VERSION = '0.09';
+$VERSION = '0.10';
 
 sub new {
     my ($class, $file, $details, $tools, $handle) = @_;
@@ -23,14 +23,14 @@
 sub start {
     my $self = shift;
     my $output = 'RIFF';
-    $output .= pack( 'V', 0 );
+    $output .= pack 'V', 0;
     $output .= 'WAVE';
 
     my $format = $self -> _format();
-    $output .= 'fmt ' . pack( 'V', length( $format ) ) . $format;
+    $output .= 'fmt ' . pack( 'V', length $format ) . $format;
     $output .= 'data';
-    my $data_off = length( $output );
-    $output .= pack( 'V', 0 );
+    my $data_off = length $output;
+    $output .= pack 'V', 0;
 
     $self -> {'data_offset'} = $data_off;
     $self -> {'total'} = length( $output ) - 8;
@@ -47,7 +47,7 @@
     my $data_pad=0;
     if ( $data_size % 2 ) {
         my $pad = "\0";
-        syswrite( $handle, $pad, 1 );
+        syswrite $handle, $pad, 1;
         $data_pad = 1; # to add to whole_num, not data_num
     }
 
@@ -57,19 +57,19 @@
     $extra += $self -> _write_display();
     $extra += $self -> _write_sampler_info();
 
-    my $whole_num = pack( 'V', $self -> {'total'} + $data_size + $data_pad + $extra );  #includes padding
-    my $len_long = length( $whole_num );
+    my $whole_num = pack 'V', $self -> {'total'} + $data_size + $data_pad + $extra;  #includes padding
+    my $len_long = length $whole_num;
 
     # RIFF-length
     my $seek_to = $self -> {'whole_offset'};
     seek( $handle, $seek_to, 0 ) || return $self -> _error( "unable to seek to $seek_to ($!)" );
-    syswrite( $handle, $whole_num, $len_long );
+    syswrite $handle, $whole_num, $len_long;
 
     # data-length
     $seek_to = $self -> {'data_offset'};
     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 );
+    my $data_num = pack 'V', $data_size;
+    syswrite $handle, $data_num, $len_long;
     return 1;
 }
 
@@ -82,8 +82,8 @@
 
 sub add_display {
     my ($self, %hash) = @_;
-    unless ( exists( $hash{'id'} ) && exists( $hash{'data'} ) ) {
-        return $self -> _error( "I need fields id & data to add a display block" );
+    unless ( exists $hash{'id'} && exists $hash{'data'} ) {
+        return $self -> _error( 'I need fields id & data to add a display block' );
     }
     push @{ $self -> {'display'} }, { map { $_ => $hash{$_} } qw( id data ) };
     return 1;
@@ -93,7 +93,7 @@
     my ($self, %hash) = @_;
     my %defaults = $self -> {'tools'} -> get_sampler_defaults();
     foreach my $key ( keys %defaults ) {
-        next if exists( $hash{$key} );
+        next if exists $hash{$key};
         $hash{$key} = $defaults{$key};
     }
     $hash{'sample_loops'} = 0;
@@ -113,7 +113,7 @@
     }
     my %defaults = $self -> {'tools'} -> get_sampler_loop_defaults();
     foreach my $key ( keys %defaults ) {
-        next if exists( $hash{$key} );
+        next if exists $hash{$key};
         $hash{$key} = $defaults{$key};
     }
     unless ( exists $self -> {'sampler'} ) {
@@ -122,7 +122,7 @@
     my $sampler = $self -> {'sampler'};
     my $id = scalar( @{ $sampler -> {'loop'} } ) + 1;
     foreach my $key ( qw( id play_count ) ) {
-        next if exists( $hash{$key} );
+        next if exists $hash{$key};
         $hash{$key} = $id;
     }
     push @{ $sampler -> {'loop'} }, \%hash;
@@ -191,30 +191,30 @@
         );
         foreach my $field ( @fields ) {
             my $data = $record{$field};
-            $data = pack( 'V', $data ) unless exists( $plain{$field} );
+            $data = pack 'V', $data unless exists $plain{$field};
             $output .= $data;
         }
     }
-    my $data_len = length( $output );
+    my $data_len = length $output;
     return 0 unless $data_len;
     $output = 'cue ' . pack( 'V', $data_len ) . $output;
     $data_len += 8;
-    syswrite( $self -> {'handle'}, $output, $data_len );
+    syswrite $self -> {'handle'}, $output, $data_len;
     return $data_len; 
 }
 
 sub _write_sampler_info {
     my $self = shift;
-    return 0 unless exists( $self -> {'sampler'} );
+    return 0 unless exists $self -> {'sampler'};
     my $sampler = $self -> {'sampler'};
     my %sampler_fields = $self -> {'tools'} -> get_sampler_fields();
     my $output = '';
     foreach my $field ( @{ $sampler_fields{'fields'} } ) {
-        $output .= pack( 'V', $sampler -> {$field} );
+        $output .= pack 'V', $sampler -> {$field};
     }
     foreach my $loop ( @{ $sampler -> {'loop'} } ) {
         foreach my $loop_field ( @{ $sampler_fields{'loop'} } ) {
-            $output .= pack( 'V', $loop -> {$loop_field} );
+            $output .= pack 'V', $loop -> {$loop_field};
         }
     }
     return $self -> _write_block( 'smpl', $output );
@@ -222,7 +222,7 @@
 
 sub _write_display {
     my $self = shift;
-    return 0 unless exists( $self -> {'display'} );
+    return 0 unless exists $self -> {'display'};
     my $total = 0;
     foreach my $display ( @{ $self -> {'display'} } ) {
         my $data = $display -> {'data'};
@@ -239,14 +239,14 @@
     my $output = shift;
     return unless $output;
     $output = $self->_make_chunk( $header, $output );
-    return syswrite( $self -> {'handle'}, $output, length( $output ) );
+    return syswrite $self -> {'handle'}, $output, length $output; 
 }
 
 sub _make_chunk {
     my $self = shift;
     my $header = shift;
     my $output = shift;
-    my $data_len = length($output);
+    my $data_len = length $output;
     return '' unless $data_len;
     $output .= "\0" if $data_len % 2; # pad byte
     return $header . pack( 'V', $data_len ) . $output; 
@@ -260,7 +260,7 @@
     $details -> {'format'} = $wave_ex ? 65534 : 1;
     my $output;
     foreach my $type ( @{ $types -> {'order'} } ) {
-        $output .= pack( $types -> {'types'} -> {$type}, $details -> {$type} );
+        $output .= pack $types -> {'types'} -> {$type}, $details -> {$type};
     }
     return $output; 
 }

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=52748&op=diff
==============================================================================
--- branches/upstream/libaudio-wav-perl/current/test.pl (original)
+++ branches/upstream/libaudio-wav-perl/current/test.pl Sun Feb 14 23:56:52 2010
@@ -16,6 +16,8 @@
 my $cnt = 0;
 
 print "1..4\n\n";
+
+print "NOTE: ".($Audio::Wav::_has_inline ? 'YES' : 'NOT')." using inline\n";
 
 ### Wav Creation
 
@@ -80,8 +82,6 @@
 print "ok $cnt\n";
 
 ### Wav Copying
-
-print "\nNOTE: ".($Audio::Wav::_has_inline ? 'YES' : 'NOT')." using inline";
 
 print "\nTesting wav copying and shortcut syntax\n";
 

Added: branches/upstream/libaudio-wav-perl/current/xt/perlcritic.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaudio-wav-perl/current/xt/perlcritic.t?rev=52748&op=file
==============================================================================
--- branches/upstream/libaudio-wav-perl/current/xt/perlcritic.t (added)
+++ branches/upstream/libaudio-wav-perl/current/xt/perlcritic.t Sun Feb 14 23:56:52 2010
@@ -1,0 +1,8 @@
+#!perl -w
+
+use strict;
+use Test::More;
+eval "use Test::Perl::Critic (-severity => 1)";
+plan skip_all => "Test::Perl::Critic required for testing PBP compliance" if $@;
+
+Test::Perl::Critic::all_critic_ok();

Added: branches/upstream/libaudio-wav-perl/current/xt/pod-coverage.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaudio-wav-perl/current/xt/pod-coverage.t?rev=52748&op=file
==============================================================================
--- branches/upstream/libaudio-wav-perl/current/xt/pod-coverage.t (added)
+++ branches/upstream/libaudio-wav-perl/current/xt/pod-coverage.t Sun Feb 14 23:56:52 2010
@@ -1,0 +1,7 @@
+#!perl -Tw
+
+use strict;
+use Test::More;
+eval "use Test::Pod::Coverage 1.04";
+plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
+all_pod_coverage_ok( { also_private => [ 'pp_pexists' ] } );

Added: branches/upstream/libaudio-wav-perl/current/xt/pod.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libaudio-wav-perl/current/xt/pod.t?rev=52748&op=file
==============================================================================
--- branches/upstream/libaudio-wav-perl/current/xt/pod.t (added)
+++ branches/upstream/libaudio-wav-perl/current/xt/pod.t Sun Feb 14 23:56:52 2010
@@ -1,0 +1,7 @@
+#!perl -Tw
+
+use strict;
+use Test::More;
+eval "use Test::Pod 1.14";
+plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
+all_pod_files_ok();




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