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