view release on metacpan or  search on metacpan

MP3.pm  view on Meta::CPAN

package Apache::MP3;
# $Id: MP3.pm,v 1.52 2006/01/03 19:37:52 lstein Exp $

use strict;
use warnings;

use Apache2::RequestRec ();
use Apache2::ServerRec ();
use Apache2::RequestIO ();
use Apache2::Access ();
use Apache2::SubRequest ();
use Apache2::ServerUtil ();
use Apache2::Connection ();
use Apache2::Log ();
use Apache2::Const qw(:common REDIRECT HTTP_NO_CONTENT HTTP_NOT_MODIFIED);
use Apache::MP3::L10N;
use APR::Table;
use IO::File;
use Socket 'sockaddr_in';
use CGI qw(:standard *table *td *TR *blockquote *center center *h1);
use CGI::Carp 'fatalsToBrowser';

use File::Basename 'dirname','basename','fileparse';
use File::Path;
use vars qw($VERSION);

$VERSION = '3.06';
my $CRLF = "\015\012";

use constant DIR_MAGIC_TYPE => 'httpd/unix-directory';
use constant DEBUG => 0;

# defaults:
use constant BASE_DIR     => '/apache_mp3';
use constant STYLESHEET   => 'apache_mp3.css';
use constant PARENTICON   => 'back.gif';
use constant PLAYICON     => 'play.gif';
use constant SHUFFLEICON  => 'shuffle.gif';
use constant CDICON       => 'cd_icon.gif';
use constant CDLISTICON   => 'cd_icon_small.gif';
use constant PLAYLISTICON => 'playlist.gif';
use constant COVERIMAGE   => 'cover.jpg';
use constant COVERIMAGESMALL   => 'cover_small.jpg';
use constant PLAYLISTIMAGE=> 'playlist.jpg';
use constant SONGICON     => 'sound.gif';
use constant ARROWICON    => 'right_arrow.gif';
use constant SUBDIRCOLUMNS => 1; #was 3 -allen
use constant PLAYLISTCOLUMNS => 3;
use constant HELPIMGURL   => 'apache_mp3_fig1.gif:374x292';
my %FORMAT_FIELDS = (
		     a => 'artist',
		     c => 'comment',
		     d => 'duration',
		     f => 'filename',
		     g => 'genre',
		     l => 'album',
		     m => 'min',
		     n => 'track',
		     q => 'samplerate',
		     r => 'bitrate',
		     s => 'sec',
		     S => 'seconds',
		     t => 'title',
		     y => 'year',
		     );


my $NO  = '^(no|false)$';  # regular expression
my $YES = '^(yes|true)$';  # regular expression

sub handler : method {
  my $class = shift;
  my $obj = $class->new(@_) or die "Can't create object: $!";
  return $obj->run();
}

sub new {
  my $class = shift;
  my $r = shift if @_ == 1;
  my $self = bless {@_}, ref($class) || $class;
  $self->{r}   ||= $r if $r;

  my @lang_tags;
  push @lang_tags,split /,\s+/,$r->headers_in->{'Accept-language'}
    if $r->headers_in->{'Accept-language'};
  push @lang_tags,$r->dir_config('DefaultLanguage') || 'en-US';

  $self->{'lh'} ||=
    Apache::MP3::L10N->get_handle(@lang_tags)
	|| die "No language handle?";  # shouldn't ever happen!