Apache-MP3
view release on metacpan or search on metacpan
local $CGI::XHTML = 0;
# check that we aren't running under PerlSetupEnv Off
if ($ENV{MOD_PERL} && !$ENV{SCRIPT_FILENAME}) {
warn "CGI.pm cannot run with 'PerlSetupEnv Off', please set it to On";
}
# this is called to show a help screen
return $self->help_screen if param('help_screen');
# generate directory listing
return $self->process_directory($r->filename)
if -d $r->filename; # should be $r->finfo, but STILL problems with this
# simple download of file
return $self->download_file($r->filename) unless param;
# this is called to stream a file
if(param('stream')){
return $self->stream;
}
# this is called to generate a playlist on the current directory
return $self->send_playlist($self->find_mp3s)
if param('Play All');
# this is called to generate a playlist on the current directory
# and everything beneath
return $self->send_playlist($self->find_mp3s('recursive'))
if param('Play All Recursive') ;
# this is called to generate a shuffled playlist of current directory
return $self->send_playlist($self->find_mp3s,'shuffle')
if param('Shuffle');
# this is called to generate a shuffled playlist of current directory
return $self->send_playlist($self->find_mp3s,'shuffle')
if param('Shuffle All');
# this is called to generate a shuffled playlist of current directory
# and everything beneath
return $self->send_playlist($self->find_mp3s('recursive'),'shuffle')
if param('Shuffle All Recursive');
# this is called to generate a playlist for one file
if (param('play')) {
my $dot3 = '.m3u|.pls';
my($basename,$ext) = $r->uri =~ m!([^/]+?)($dot3)?$!;
$basename = quotemeta($basename);
my @matches;
if (-e $self->r->filename) {
# If the actual .m3u file exists (it's a playlist), then we read it
# to get the list of files to send
@matches = $self->load_playlist($self->r->filename);
} else {
# find the MP3 file that corresponds to basename.m3u
@matches = grep { m!/$basename[^/]*$! } @{$self->find_mp3s};
}
if($r->content_type eq 'audio/x-scpls'){
open(FILE,$r->filename) || return 404;
$r->send_fd(\*FILE);
close(FILE);
} else {
$self->send_playlist(\@matches);
}
$self->send_playlist();
return OK;
}
# this is called to generate a playlist for selected files
if (param('Play Selected')) {
return HTTP_NO_CONTENT unless my @files = param('file');
my $uri = dirname($r->uri);
$uri =~ s!/?search/?!/!;
$self->send_playlist([map { "$uri/$_" } @files]);
return OK;
}
if (param('Shuffle Selected')) {
return HTTP_NO_CONTENT unless my @files = param('file');
my $uri = dirname($r->uri);
$uri =~ s!/?search/?!/!;
my $list = [map {"$uri/$_"} @files];
$self->shuffle($list);
$self->send_playlist($list);
return OK;
}
# otherwise don't know how to deal with this
$self->r->log_reason('Invalid parameters -- possible attempt to circumvent checks.');
return FORBIDDEN;
}
sub escape {
my $uri = CGI::escape(shift);
# unescape slashes so directories work right with mozilla
$uri =~ s!\%2F!/!gi;
return $uri;
}
# this generates the top-level directory listing
sub process_directory {
my $self = shift;
my $dir = shift;
return $self->list_directory($dir);
}
# this downloads the file
sub download_file {
my $self = shift;
my $file = shift;
my $type = $self->r->content_type;
my $is_audio = $self->supported_type ($self->r->content_type);
if ($is_audio && !$self->download_ok) {
$self->r->log_reason('File downloading is forbidden');
( run in 2.379 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )