view release on metacpan or  search on metacpan

MP3/Resample.pm  view on Meta::CPAN

package Apache::MP3::Resample;

# $Id: Resample.pm,v 1.7 2003/10/06 14:10:30 lstein Exp $
# Resamples (downsamples) on the fly

use strict;
use vars qw(@ISA $VERSION);
use Apache2::Const -compile => qw(:common);
use IO::File;
use CGI qw(:standard *table *TR *td escape);
use CGI::Cookie;
use Apache::MP3::Playlist;
use File::Basename;
$VERSION = 1.0;

@ISA = 'Apache::MP3::Playlist';

use constant ENCODE => qq(%Dlame%I %b -%F);

my @DECOMPRESSOR_DEFAULTS = ("audio/shorten" => "shorten -x %f -|",
			     "audio/flac" => "flac -d -c -s %f|");

my @PRESET_DEFAULTS = (
	       '24 kbps' => '-b24 --lowpass 4.0  --highpass 0.1  --resample 8',
	       '40 kbps' => '-b40 --lowpass 4.0  --resample 16',
	       '56 kbps' => '-b56 --lowpass 12.0 --resample 22.05',
	       '64 kbps' => '-b64 --lowpass 15.0 --resample 22.05',
	       '96 kbps' => '-b96 --lowpass 15.0',
	       '128 kbps' => '-b128 --lowpass 18',
	       '160 kbps' => '-b160',
	       '192 kbps' => '-b192',
	      );

my (%PRESETS,@PRESETS,%DECOMPRESSORS,@DECOMPRESSORS);

sub new {
   my $proto = shift;
   my $class = ref ($proto) || $proto;
   my $self = $class->SUPER::new (@_);

   # Add to suffix list and supported type hash
   push (@{$self->{'suffixes'}}, ".shn", ".SHN", ".flac", ".FLAC");
   $self->{'supported_types'}->{'audio/shorten'} = 'read_shorten';
   $self->{'supported_types'}->{'audio/flac'} = 'read_flac';

   bless ($self, $class);
   $self;
}

sub run {
  my $self = shift;
  $self->process_cookies;
  $self->SUPER::run();
}

sub process_cookies {
  my $self = shift;
  my $r = $self->r;

  # don't set cookies for ordinary MP3 file downloads.
  return if !param() && !-d $r->filename;

  if (my $cookies = CGI::Cookie->parse($r->headers_in('Cookie'))) {
    $self->bitrate($cookies->{bitrate}->value)
      if $cookies->{bitrate};
  }
  $self->bitrate(param('bitrate')) if defined param('bitrate');
  my $c = CGI::Cookie->new(-name  => 'bitrate',
			   -value => $self->bitrate,
			   -expires => '+90d'
			  );
  tied(%{$r->err_headers_out})->add('Set-Cookie' => $c);
  param(bitrate => $self->bitrate);
}

sub bitrate {
  my $self = shift;
  my $g    = $self->{bitrate};
  $self->{bitrate} = shift if @_;
  return unless $self->presets($g);
  $g;
}

sub stream_parms {
  my $self = shift;
  my $p =  $self->SUPER::stream_parms;
  my $rate = escape($self->bitrate);
  $p .= ";bitrate=$rate" if $rate;
  $p;
}

sub presets {
  my $self = shift;
  unless (%PRESETS) {
    my @p;
    if (my $conf = $self->r->dir_config('ResamplePresets')) {
      @p = split /\s*(?:=>|,)\s*/,$conf;
    } else {
      @p = @PRESET_DEFAULTS;
    }
    my @i = map {$_*2} (0..(@p-1)/2);
    %PRESETS    = @p;
    @PRESETS = @p[@i];
  }
  my $bitrate = shift or return @PRESETS;
  return $PRESETS{$bitrate};
}

sub decompressor {
  my $self = shift;
  unless (%DECOMPRESSORS) {
    my @p;
    if (my $conf = $self->r->dir_config('DecompressorPresets')) {
      @p = split /\s*(?:=>|,)\s*/,$conf;
    } else {
      @p = @DECOMPRESSOR_DEFAULTS;
    }
    my @i = map {$_*2} (0..(@p-1)/2);
    %DECOMPRESSORS    = @p;
    @DECOMPRESSORS = @p[@i];
  }
  my $mime = shift or return @DECOMPRESSORS;
  return $DECOMPRESSORS{$mime};
}

sub sample_popup {
  my $self = shift;
  my @bitrates = $self->presets;
  unshift @bitrates,0;
  my %labels = (0 => '--');
  return (
	  start_form(-name=>'form'),