File Coverage

blib/lib/Audio/Analyzer.pm

Criterion	Covered	Total	%
statement	243	328	74.0
branch	32	74	43.2
condition	2	9	22.2
subroutine	47	56	83.9
pod	5	12	41.6
total	329	479	68.6

package Audio::Analyzer;

our $VERSION = '0.22';

use strict;
use warnings;

use Carp qw(croak);

use Math::FFT;

use constant DEFAULT_DFT_SIZE => 2 ** 11;
use constant DEFAULT_SAMPLE_RATE => 44100;
use constant DEFAULT_CHANNELS => 2;
use constant DEFAULT_BITS_PER_SAMPLE => 16;

#value can be undef if fileless operation is being used
use constant INPUT => 0;
use constant FILE_NAME => 1;
use constant DFT_SIZE => 2;
use constant SEEK_STEP => 3;
use constant READ_SIZE => 4;
use constant CHANNELS => 5;
use constant BYTES_PER_SAMPLE => 6;
use constant SAMPLE_RATE => 7;
use constant FFT => 8;
use constant FREQ_CACHE => 9;
use constant SCALER => 10;
use constant BYTES => 11;
use constant EOF_FOUND => 12;
use constant FILELESS_BUFFER => 13;

sub new {
	my ($class, %opts) = @_;

	my $self = [];

	bless($self, $class);

	$self->init(%opts);

	return $self;
}

sub add_samples {
    my ($self, @samples) = @_;
    push(@{$self->[FILELESS_BUFFER]}, @samples);
    return;
}

sub sample_buffer_size {
    my ($self) = @_;
    return scalar(@{$self->[FILELESS_BUFFER]});
}

sub next {
	my ($self) = @_;
	my @samples;
	my $chunk;

	if (defined($self->[INPUT])) {
        my $pcm = $self->read_pcm;

        if (! defined($pcm)) {
            return undef;
        }

        @samples = $self->convert_pcm($pcm);

	} else {
	    @samples = $self->get_fileless_samples;
	    return undef unless @samples;
	}


	my $channels = $self->split_channels(@samples);

	$chunk = Audio::Analyzer::Chunk->new($self, $channels);

	return $chunk;
}

sub progress {
	my ($self) = @_;
	my $bytes = $self->[BYTES];
	my $input = $self->[INPUT];
	my $size = (stat($input))[7];

	return int($bytes / $size * 100);
}

sub freqs {
	my ($self) = @_;
	my $sample_rate = $self->[SAMPLE_RATE];
	my $dft_size = $self->[DFT_SIZE];
	my $freq_cache = $self->[FREQ_CACHE];
	my @freqs;

	if (defined($freq_cache)) {
		return $freq_cache;
	}

	for(my $i = 0; $i < $dft_size / 2; $i++) {
		$freqs[$i] = $i / $dft_size * $sample_rate;
	}

	$self->[FREQ_CACHE] = \@freqs;

	return $self->[FREQ_CACHE];
}

#private interface starts here

sub init {
	my ($self, %opts) = @_;
	my $file;
	my $dft_size;
	my $seek_step;
	my $channels;
	my $bits_per_sample;
	my $sample_rate;
	my $read_size;
	my $scaler;
	my $fps;

    if (exists($opts{'file'})) {
        if (! defined($file = $opts{'file'})) {
            croak "if the file option is given it must have a value";
        }
    } elsif (! defined $opts{fileless}) {
        croak "no file was specified and fileless operation is not configured";
    }

	if (! defined($dft_size = $opts{'dft_size'})) {
		$dft_size = DEFAULT_DFT_SIZE;
	}

	if (! defined($sample_rate = $opts{'sample_rate'})) {
		$sample_rate = DEFAULT_SAMPLE_RATE;
	}

	if (! defined($channels = $opts{'channels'})) {
		$channels = DEFAULT_CHANNELS;
	}

	if (defined($bits_per_sample = $opts{'bits_per_sample'})) {
		if ($bits_per_sample != 8 && $bits_per_sample != 16) {
			croak("bits_per_sample must be 8 or 16");
		}
	} else {
		$bits_per_sample = DEFAULT_BITS_PER_SAMPLE;
	}

	$read_size = $dft_size * $channels * $bits_per_sample / 8;

	if (defined($fps = $opts{'fps'})) {
	    croak "unable to use audio/visual sync with fileless operation"
	       unless defined $file;
		$seek_step = $sample_rate / $fps * $bits_per_sample / 8 * $channels;
	} elsif (defined $seek_step && ! defined $file) {
        croak "unable to use seek_step with fileless operation";
	} elsif (! defined($seek_step = $opts{'seek_step'})) {
		$seek_step = $read_size;
	}

    if (defined($file)) {
        if (ref($file) eq 'GLOB') {
            $self->[INPUT] = $file;
            $self->[FILE_NAME] = scalar($file);
        } else {
            croak "could not open $file: $!" unless open(PCM, $file);

            $self->[INPUT] = \*PCM;
            $self->[FILE_NAME] = $file;
        }
    }

	$self->[BYTES_PER_SAMPLE] = $bits_per_sample / 8;
	$self->[CHANNELS] = $channels;
	$self->[SAMPLE_RATE] = $sample_rate;
	$self->[DFT_SIZE] = $dft_size;
	$self->[SEEK_STEP] = $seek_step;
	$self->[READ_SIZE] = $read_size;
	$self->[BYTES] = 0;
	$self->[EOF_FOUND] = 0;

	unless(defined($file)) {
	    $self->[FILELESS_BUFFER] = [];
	}

	if (! exists($opts{scaler})) {
		$scaler = Audio::Analyzer::ACurve->new($self);
	} elsif(defined($opts{scaler})) {
		my $requested = $opts{scaler};

		$scaler = $requested->new($self);
	}

	$self->[SCALER] = $scaler;

	return $self;
}

sub split_channels {
	my ($self, @samples) = @_;
	my $channels = $self->[CHANNELS];
	my @split;
	my $size = scalar(@samples);

	for(my $i = 0; $i < $size; $i++) {
		my $chan = int($i % $channels);
		push(@{$split[$chan]}, $samples[$i]);
	}

	return \@split;
}


#converts PCM into floating point representation
sub convert_pcm {
	my ($self, $pcm) = @_;
	my $bytes_per_sample = $self->[BYTES_PER_SAMPLE];
	my @samples;

	if ($bytes_per_sample == 2) {
		while(length($pcm) >= 2) {
			my $sample = unpack('s<', substr($pcm, 0, 2, ''));
			push(@samples, $sample);
		}
	} else {
		die "8 bit PCM isn't implemented yet";
	}

	return @samples;
}

sub get_fileless_samples {
    my ($self) = @_;
    my $input = $self->[INPUT];
    my $read_size = $self->[READ_SIZE];
    my $fileless_buffer = $self->[FILELESS_BUFFER];
    my $samples_needed = $read_size / $self->[BYTES_PER_SAMPLE];

    if (defined $input) {
        die "read_buffer() was called for fileless operation but there was an input file ref?";
    }

    return () unless scalar(@$fileless_buffer) >= $samples_needed;
    return splice(@$fileless_buffer, 0, $samples_needed);
}

sub read_pcm {
	my ($self) = @_;
	my $input = $self->[INPUT];
	my $read_size = $self->[READ_SIZE];
	my $seek_step = $self->[SEEK_STEP];
	my $bytes = $self->[BYTES];
	my $EOF_found = $self->[EOF_FOUND];
	my $buf;
	my $ret;
	my $rewind;

	die "there was no input filehandle ref" unless defined $input;

	$ret = read($input, $buf, $read_size);

	if (! defined($ret)) {
		die "could not read: $!";
	} elsif ($ret == 0) {
		return undef;
	} elsif ($ret < $read_size) {
		#hit the end and did not get enough data for the FFT - seek
		#backwards a whole read_size and finish the last reading
		#as best as possible
		my $size = (stat($input))[7];

		$self->[EOF_FOUND] = 1;

		seek($input, $size - $read_size, 0) or die "could not seek: $!";

		return $self->read_pcm;
	}

	$bytes += $seek_step;

	$rewind = $read_size - $seek_step;

	if ($rewind && ! $EOF_found) {
		seek($input, $rewind * -1, 1) or die "could not seek: $!";
	}

	$self->[BYTES] = $bytes;

	return $buf;
}

sub scaler {
	my ($self) = @_;

	return $self->[SCALER];
}

package Audio::Analyzer::Chunk;

our $VERSION = '0.02';

use strict;
use warnings;

sub new {
	my ($class, $analyzer, $channels) = @_;
	my $self = {};

	$self->{analyzer} = $analyzer;
	$self->{channels} = $channels;

	bless($self, $class);

	return $self;
}

sub pcm {
	my ($self) = @_;

	return $self->{channels};
}

sub fft {
	my ($self) = @_;
	my $channels = $self->{channels};
	my @mags;

	for(my $i = 0; $i < scalar(@$channels); $i++) {
		$mags[$i] = $self->do_fft($channels->[$i]);
	}

	return \@mags;
}

sub rms {
	my $self = shift(@_);
	my $size = scalar(@_);
	my $sum;

	for(my $i = 0; $i < $size; $i++) {
		$sum += $_[$i] ** 2;
	}

	$sum /= $size;

	return sqrt($sum);
}

sub combine_fft {
	my ($self, $channels) = @_;
	my $num_channels = scalar(@$channels);
	my $length = scalar(@{$channels->[0]});
	my @new;

	for(my $i = 0; $i < $length; $i++) {
		my @row;

		for(my $j = 0; $j < $num_channels; $j++) {
			push(@row, $channels->[$j][$i]);
		}

		$new[$i] = $self->rms(@row);
	}

	return \@new;
}

sub analyzer {
	my ($self) = @_;

	return $self->{analyzer};
}

#private methods

sub do_fft {
	my ($self, $samples) = @_;
	my $fft = Math::FFT->new($samples);
	my $coeff = $fft->rdft;
	my $size = scalar(@$coeff);
	my $k = 0;
	my @mag;

	$mag[$k] = sqrt($coeff->[$k*2]**2);

	for($k = 1; $k < $size / 2; $k++) {
		$mag[$k] = sqrt(($coeff->[$k * 2] ** 2) + ($coeff->[$k * 2 + 1] ** 2));
	}

	$self->scale(\@mag);

	return \@mag;
}

sub scale {
	my ($self, $mags) = @_;
	my $scaler = $self->analyzer->scaler;

	if (defined($scaler)) {
		$scaler->scale($mags);
	}
}

package Audio::Analyzer::ACurve;

our $VERSION = '0.02';

use strict;
use warnings;

use Carp;

use constant SCALE => 5000000; #tested by running some Prodigy
			       #through the system

sub new {
	my ($class, $analyzer) = @_;
	my $self = {};

	$self->{analyzer} = $analyzer;

	if (! defined($analyzer)) {
		croak "I need an analyzer";
	}

	bless($self, $class);

	$self->init;

	return $self;
}

sub init {
	my ($self) = @_;
	my $analyzer = $self->{analyzer};
	my @correction;
	my $freqs = $analyzer->freqs;

	for(my $i = 0; $i < scalar(@$freqs); $i++) {
		my $freq = $freqs->[$i];

		if ($freq < 10000) {
			$correction[$i] = $self->solve_one_A($freq);
		} else {
			$correction[$i] = 1;
		}

	}

	$self->{correction} = \@correction;
}

sub solve_one_A {
	my ($self, $freq) = @_;
	my $term_1 = ($freq ** 2) + (20.6 ** 2);
	my $term_2 = ($freq ** 2) + (12200 ** 2);
	my $term_3 = sqrt(($freq ** 2) + (107.7 ** 2));
	my $term_4 = sqrt(($freq ** 2) + (737.9 ** 2));

	return (12200 ** 2) * ($freq ** 4) / ($term_1 * $term_2 * $term_3 * $term_4);
}

sub scale {
	my ($self, $mags) = @_;
	my $correction = $self->{correction};
	my $size = scalar(@$mags);

	for(my $i = 0; $i < $size; $i++) {
		$mags->[$i] *= $correction->[$i];
		$mags->[$i] /= SCALE;

		if ($mags->[$i] > 1) {
			$mags->[$i] = 1;
		}
	}
}

package Audio::Analyzer::AutoScaler;

our $VERSION = '0.02';

use strict;
use warnings;

sub new {
	my ($class) = @_;
	my $self = {};

	$self->{peak} = 0;

	bless($self, $class);

	return $self;
}

sub scale {
	my ($self, $readings) = @_;
	my $size = scalar(@$readings);

	for(my $i = 0; $i < $size; $i++) {
		my $one = $readings->[$i];

		if ($one > $self->{peak}) {
			$self->{peak} = $one;
		}

		$one /= $self->{peak};

		$readings->[$i] = $one;
	}
}

1;

__END__