Apache-MP3
view release on metacpan or search on metacpan
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!
$self->{'supported_types'} =
{
# type condition handler method
'audio/mpeg' => eval "use MP3::Info; 1;" && 'read_mpeg',
'audio/mpeg4' => eval "use MP4::Info; 1;" && 'read_mpeg4',
'application/x-ogg' => eval "use Ogg::Vorbis; 1;" && 'read_vorbis_ogg' ||
eval "use Ogg::Vorbis::Header::PurePerl; 1;"
&& 'read_vorbis_hp',
'audio/x-wav' => eval "use Audio::Wav; 1;" && 'read_wav'
};
$self->{'suffixes'} = [ qw(.ogg .OGG .wav .WAV .mp3 .MP3 .mpeg .MPEG .m4a .mp4 .m4p)];
return $self;
}
sub x { # maketext plus maybe escape. The "x" for "xlate"
my $x = (my $lh = shift->{'lh'})->maketext(@_);
$x =~ s/([^\x00-\x7f])/'&#'.ord($1).';'/eg
if $x =~ m/[^\x00-\x7f]/ and $lh->must_escape;
return $x;
}
sub lh { return shift->{lh} } # language handle
sub aright { -align => shift->{lh}->right }
# align "right" (or, in case of Arabic (etc), really left).
sub aleft { -align => shift->{lh}->left }
# align "light" (or, in case of Arabic (etc), really right).
sub r { return shift->{r} }
sub html_content_type {
my $self = shift;
return 'text/html; charset=' . $self->lh->encoding
}
sub help_screen {
my $self = shift;
$self->r->content_type( $self->html_content_type );
return OK if $self->r->header_only;
print start_html(
-lang => $self->lh->language_tag,
-title => $self->x('Quick Help Summary'),
-dir => $self->lh->direction,
-head => meta({-http_equiv => 'Content-Type',
-content => $self->html_content_type
}
),
-script =>{-src=>$self->default_dir.'/functions.js'},
);
my $help_img_url = $self->help_img_url; # URL for the image
my ($url,$width,$height) = $help_img_url=~/(.+):(\d+)x(\d+)/;
$url ||= $help_img_url;
$width ||= 500;
$height ||= 400;
print img({-src => $url,
-alt => "",
-height => $height,
-width => $width,
$self->aleft,
}), "\n";
print join "\n".br(),
$self->help_figure_list
;
print "\n", end_html();
return;
}
sub help_figure_list {
my $self = shift;
# Provide a legend for the items in the figure
return(
b("A"). $self->x("= Stream all songs"),
b("B"). $self->x("= Shuffle-play all Songs"),
# 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');
return FORBIDDEN;
} else {
return DECLINED; # allow Apache to do its standard thing
}
}
# stream the indicated file
sub stream {
my $self = shift;
my $r = $self->r;
return DECLINED unless -e $r->filename; # should be $r->finfo
unless ($self->stream_ok) {
$r->log_reason('AllowStream forbidden');
return FORBIDDEN;
}
if ($self->check_stream_client and !$self->is_stream_client) {
my $useragent = $r->headers_in->{'User-Agent'};
$r->log_reason("CheckStreamClient is true and $useragent is not a streaming client");
return FORBIDDEN;
}
my $mime = $r->content_type;
my $file = $r->filename;
my $url = $r->uri;
my $info = $self->fetch_info($file,$mime);
return DECLINED unless $info; # not a legit mp3 file?
my $fh = $self->open_file($file) || return DECLINED;
binmode($fh); # to prevent DOS text-mode foolishness
my $size = -s $file;
my $bitrate = $info->{bitrate};
$r->assbackwards(1);
$r->connection->keepalive(1);
$r->connection->keepalives($r->connection->keepalives+1);
$r->print("ICY ". ($range ? 206 : 200) ." OK$CRLF");
$r->print("icy-notice1: <BR>This stream requires a shoutcast/icecast compatible player.<BR>$CRLF");
$r->print("icy-notice2: Apache::MP3<BR>$CRLF");
$r->print("icy-name: $description$CRLF");
$r->print("icy-genre: $genre$CRLF");
$r->print("icy-url:$icyurl$CRLF");
$r->print("icy-pub:1$CRLF");
$r->print("icy-br:$bitrate$CRLF");
$r->print("Accept-Ranges: bytes$CRLF");
$r->print("Content-Range: bytes $range-" . ($size-1) . "/$size$CRLF")
if $range;
$r->print("Content-Length: $size$CRLF");
$r->print("Content-Type: $mime$CRLF");
$r->print("$CRLF");
return OK if $r->header_only;
if (my $timeout = $self->stream_timeout) {
my $seconds = $info->{seconds};
$seconds ||= 60; # shouldn't happen
my $fraction = $timeout/$seconds;
my $bytes = int($fraction * $size);
while ($bytes > 0) {
my $data;
my $b = read($fh,$data,2048) || last;
$bytes -= $b;
$r->print($data);
}
return OK;
} else {
my $data;
$r->print($data) while read($fh,$data,2048);
}
return OK;
}
# this generates a playlist for the MP3 player
sub send_playlist {
my $self = shift;
my ($urls,$shuffle) = @_;
return HTTP_NO_CONTENT unless $urls && @$urls;
my $r = $self->r;
my $base = $self->stream_base;
$r->content_type('audio/mpegurl');
return OK if $r->header_only;
# local user
my $local = $self->playlocal_ok && $self->is_local;
$self->shuffle($urls) if $shuffle;
$r->print("#EXTM3U$CRLF");
my $stream_parms = $self->stream_parms;
foreach (@$urls) {
$self->path_escape(\$_);
my $subr = $r->lookup_uri($_) or next;
my $file = $subr->filename;
my $type = $subr->content_type;
my $data = $self->fetch_info($file,$type);
my $format = $self->r->dir_config('DescriptionFormat');
if ($format) {
$r->print('#EXTINF:' , $data->{seconds} , ',');
(my $description = $format) =~ s{%([atfglncrdmsqS%])}
{$1 eq '%' ? '%' : $data->{$FORMAT_FIELDS{$1}}}gxe;
print $description;
print $CRLF;
} else {
$r->print('#EXTINF:' , $data->{seconds} ,
',', $data->{title},
' - ',$data->{artist},
' (',$data->{album},')',
$CRLF);
}
if ($local) {
$r->print($file,$CRLF);
} else {
$r->print ("$base$_?$stream_parms$CRLF");
}
}
return OK;
}
sub stream_parms {
my $self = shift;
return "stream=1";
}
# load the contents of a playlist (.m3u) from disk
sub load_playlist {
my $self = shift;
my $playlist = shift;
my @mp3s = ();
my $uri = dirname($self->r->uri);
local $_;
my $fh = IO::File->new($playlist)
or die "Failed to open $playlist";
while(<$fh>) {
chomp;
s/\#.*//; # get rid of comment and hint lines
s/\s+$//; # get rid of whitespace at end of lines
next unless $_;
push @mp3s, "$uri/$_";
}
$fh->close;
return @mp3s
}
# shuffle an array
sub shuffle {
my $self = shift;
my $list = shift;
for (my $i=0; $i<@$list; $i++) {
my $rand = rand(scalar @$list);
($list->[$i],$list->[$rand]) = ($list->[$rand],$list->[$i]); # swap
}
my $title = $self->r->uri;
my $links;
print start_table({-width => '100%'}), start_TR;
print start_td({-width=>'100%'});
if ($self->path_style eq 'staircase') {
$links = $self->generate_navpath_staircase($title);
} elsif ($self->path_style eq 'arrows') {
$links = $self->generate_navpath_arrows($title);
} elsif ($self->path_style eq 'slashes') {
$links = $self->generate_navpath_slashes($title);
}
print a({-href=>'./playlist.m3u?Play+All+Recursive=1'},
img({-src => $self->cd_icon($dir), $self->aleft, -alt=>
$self->x('Stream All'),
-border=>0})),
$links,
a({-href=>'./playlist.m3u?Shuffle+All+Recursive=1'},
font({-class=>'directory'}, '[',
$self->x('Shuffle All'),
']'
))
.' '.
a({-href=>'./playlist.m3u?Play+All+Recursive=1'},
font({-class=>'directory'}, '[',
$self->x('Stream All'),
']'
)),
br({-clear=>'ALL'}),;
if (my $t = $self->stream_timeout) {
print p(strong(
$self->x('Note:')
),' ',
$self->x("In this demo, streaming is limited to approximately [quant,_1,second,seconds].", $t),
"\n"
);
}
print end_td;
print end_TR, end_table;
}
# staircase style path
sub generate_navpath_staircase {
my $self = shift;
my $uri = shift;
my $home = $self->home_label;
my $indent = 3.0;
my @components = split '/',$uri;
unshift @components,'' unless @components;
my ($path,$links) = ('',br());
my $current_style = "line-height: 1.2; font-weight: bold; color: red;";
my $parent_style = "line-height: 1.2; font-weight: bold;";
for (my $c=0; $c < @components-1; $c++) {
$path .= escape($components[$c]) ."/";
my $idt = $c * $indent;
my $l = a({-href=>$path},$components[$c] || ($home.br({-clear=>'all'})));
$links .= div({-style=>"text-indent: ${idt}em; $parent_style"},
font({-size=>'+1'},$l))."\n";
}
my $idt = (@components-1) * $indent;
$links .= div({-style=>"text-indent: ${idt}em; $current_style"},
font({-size=>'+1'},$components[-1] || $home))."\n";
return $links;
}
# alternative display on one line using arrows
sub generate_navpath_slashes {
my $self = shift;
my $uri = shift;
my $home = $self->home_label;
my @components = split '/',$uri;
unshift @components,'' unless @components;
my $path;
my $links = br . ' ' ; #start_h1();
for (my $c=0; $c < @components-1; $c++) {
$links .= ' / ' if $path;
$path .= escape($components[$c]) . "/";
$links .= a({-href=>$path},font({-size=>'+1'},$components[$c] || $home));
}
$links .= ' / ' if $path;
$links .= font({-size=>'+1',-style=>'color: red'},($components[-1] || $home));
$links .= br;
return $links;
}
# alternative display on one line using arrows
sub generate_navpath_arrows {
my $self = shift;
my $uri = shift;
my $home = $self->home_label;
my @components = split '/',$uri;
unshift @components,'' unless @components;
my $path;
my $links = br . ' ' ; #start_h1();
my $arrow = $self->arrow_icon;
for (my $c=0; $c < @components-1; $c++) {
$links .= ' ' . img({-src=>$arrow}) if $path;
$path .= escape($components[$c]) . "/";
$links .= ' ' . a({-href=>$path},$components[$c] || $home);
}
$links .= ' ' . img({-src=>$arrow}) if $path;
$links .= " ". ($components[-1] || $home);
$links .= br;#end_h1();
return $links;
}
# print the HTML at the bottom of the page
sub directory_bottom {
my $self = shift;
my $dir = shift; # actually not used
my $mp3s = shift;
#allow masking of 'Authored by Lincoln...' and helplink.
return if $self->r->dir_config('SuppressCredits');
print
table({-width=>'100%',-border=>0},
TR(
td({$self->aleft},
#address( # Unpredictable and/or flaky rendering
$self ->x( "_CREDITS_before_author" )
.
a({-href=>'http://stein.cshl.org'},
$self->x( "_CREDITS_author" )
)
.
$self ->x( "_CREDITS_after_author" )
#)
),
td({$self->aright},$self->get_help))
);
print "<!--",
sprintf("\n %s v%s", __PACKAGE__, $VERSION || '0'),
(ref($self) eq __PACKAGE__) ? () :
sprintf("\n %s v%s", ref($self), $self->VERSION || '0'),
"\n ", $self->x('_VERSION'), " (", ref($self->lh), ")",
"\n -->",
;
print end_html();
}
# print the HTML at the top of the list of subdirs
sub subdir_list_top {
my $self = shift;
my $subdirs = shift; # array reference
print "\n", hr;
print "\n\n", h2({-class=>'CDdirectories'},
$self->x('CD Directories ([_1])',
scalar @$subdirs),
), "\n";
}
# print the HTML at the bottom of the list of subdirs
sub subdir_list_bottom {
my $self = shift;
my $subdirs = shift; # array reference
}
my $subdirs = shift; #array reference
my @subdirs = $self->sort_subdirs($subdirs);
my $cols = $self->subdir_columns;
my $rows = int(0.99 + @subdirs/$cols);
print start_table({-border=>0,-id=>'diroutertable'}),"\n";
if($self->subdir_columns == 1){
my $statsheader = '';
if($self->r->dir_config('CacheStats') && $self->r->dir_config('CacheDir')){
$statsheader = td(b('Last Accessed')). td(b('Times Accessed'));
}
print TR(
td(b('Directory')),
td(b('Play Options')),
td(b('Last Modified')),
$statsheader,
);
}
for (my $row=0; $row < $rows; $row++) {
print start_TR({-valign=>'BOTTOM',-align=>'LEFT'});
for (my $col=0; $col<$cols; $col++) {
my $i = $col * $rows + $row;
my $contents = $subdirs[$i] ? $self->format_subdir($subdirs[$i]) : ' ';
#only assume wrap in td() if multiple columns. should td() be moved to format_subdir() ?
print $self->subdir_columns == 1 ? $contents : td($contents);
}
print end_TR,"\n";
}
print end_table;
}
# given a list of CD directories, sort them
sub sort_subdirs {
my $self = shift;
my $subdirs = shift;
return sort @$subdirs; # alphabetic sort by default
}
# format a subdir entry and return its HTML
sub format_subdir {
my $self = shift;
my $subdir = shift;
my $subdirpath = $self->r->filename .'/'. $subdir;
# special handling if subdir is fully pathed
if (substr($subdir, -1) eq "/") {
chop $subdir;
$subdirpath = $self->r->lookup_uri($subdir)->filename;
}
my $nb = ' ';
(my $title = $subdir) =~ s/\s/$nb/og; # replace whitespace with
$title =~ s!^.*(/[^/]+/[^/]+)$!...$1!; # if dir is fully pathed, only keep 2 parts for title
my $uri = escape($subdir);
my $result;
my($atime,$mtime) = (stat($subdirpath))[8,9];
my($last,$times);
if($self->r->dir_config('CacheStats')){
($last,$times) = $self->stats($self->r->filename,$subdir);
}
if($self->subdir_columns == 1){
$result = td(
a({-href=>$uri.'/playlist.m3u?Play+All+Recursive=1'},
img({-src=>$self->cd_list_icon($subdir),
-align=>'ABSMIDDLE',
-class=>'subdir',
-alt=>$self->x('Stream'),
-border=>0})),
a({-href=>$uri.'/'},font({-class=>'subdirectory'},$title))
)
.td(
a({-class=>'subdirbuttons',
-href=>$uri.'/playlist.m3u?Shuffle+All+Recursive=1'},
'[' .
$self->x('Shuffle')
.']')
.$nb.
a({-class=>'subdirbuttons',
-href=>$uri.'/playlist.m3u?Play+All+Recursive=1'},
'['.
$self->x('Stream')
.']')."\n"
)
.td(
scalar(localtime($mtime))
);
if($self->r->dir_config('CacheStats')){
$result .= td($last) . td($times);
}
} else {
$result = start_table({-border=>0,-alight=>'LEFT'}).start_TR().td(
a({-href=>$uri.'/playlist.m3u?Play+All+Recursive=1'},
img({-src=>$self->cd_list_icon($subdir),
-align=>'LEFT',
-class=>'subdir',
-alt=>$self->x('Stream'),
-border=>0}))
).td({-valign => 'CENTER', -align => 'LEFT'},
a({-href=>$uri.'/'},font({-class=>'subdirectory'},$title)).
br."\n".
a({-class=>'subdirbuttons',
-href=>$uri.'/playlist.m3u?Shuffle+All+Recursive=1'},
'['.$self->x('Shuffle').']')
.$nb.
a({-class=>'subdirbuttons',
-href=>$uri.'/playlist.m3u?Play+All+Recursive=1'},
'['.$self->x('Stream').']')."\n"
).end_TR().end_table();
}
my $self = shift;
warn join ' ', @_;
}
sub times_accessed {
my $self = shift;
warn join ' ', @_;
}
sub playlist_list_top {
my $self = shift;
my $playlists = shift; # array ref
print hr;
print "\n\n", h2({-class=>'CDdirectories'},
$self->x('Playlists ([_1])',
scalar @$playlists));
}
# print the HTML at the bottom of the list of playlists
sub playlist_list_bottom {
my $self = shift;
my $playlists = shift; # array ref
}
# print the HTML to format the list of playlists
sub playlist_list {
my $self = shift;
my $playlists = shift; # array ref
my $cols = $self->playlist_columns;
my $rows = int(0.99 + @$playlists / $cols);
# print start_center;
print start_table({-border => 0, -width => '95%'}), "\n";
for(my $row = 0; $row < $rows; $row++) {
print start_TR({-valign => 'BOTTOM'});
for(my $col = 0; $col < $cols; $col++) {
my $i = $col * $rows + $row;
my $contents = $playlists->[$i]
? $self->format_playlist( $playlists->[$i] )
: ' ';
print td($contents);
}
print end_TR, "\n";
}
print end_table;
# print end_center;
}
# format a playlist entry and return its HTML
sub format_playlist {
my $self = shift;
my $playlist = shift;
my $nb = ' ';
my $dot3 = '.m3u|.pls';
my($param) = $playlist =~ /\.m3u$/ ? '?play=1' : '';
(my $title = $playlist) =~ s/$dot3$//;
$title =~ s/\s/$nb/og;
my $url = escape($playlist) . $param;
return p(a({-href => $url},
img({-src => $self->playlist_icon,
-align => 'ABSMIDDLE',
-class => 'subdir',
-alt =>
$self->x('Playlist'),
-border => 0}))
. $nb .
a({-href => $url},
font({-class => 'subdirectory'},
$title)));
}
# This generates the link for help
sub get_help {
my $self = shift;
return a({-href => "?help_screen=1",}, $self->x('Quick Help Summary'));
}
sub txtfile_list_top {
my $self = shift;
my $txtfiles = shift; # array ref
print hr;
print h2({-class=>'CDdirectories'},
sprintf('Text Files (%d)', scalar @$txtfiles));
}
# print the HTML to format the list of playlists
sub txtfile_list {
my $self = shift;
my $txtfiles = shift; # array ref
my $cols = $self->playlist_columns;
my $rows = int(0.99 + @$txtfiles / $cols);
print start_table({-border => 0, -width => '95%'}), "\n";
for(my $row = 0; $row < $rows; $row++) {
print start_TR({-valign => 'BOTTOM'});
for(my $col = 0; $col < $cols; $col++) {
my $i = $col * $rows + $row;
my $contents = $txtfiles->[$i] ? $self->format_txtfile($txtfiles->[$i]) : ' ';
print td($contents);
}
print end_TR, "\n";
}
print end_table;
# print end_center;
}
# format a txtfile entry and return it's HTML
sub format_txtfile {
my $self = shift;
my $txtfile = shift;
my $nb = ' ';
(my $title = $txtfile) =~ s/\.(txt|nfo)$//;
$title =~ s/\s/$nb/og;
my $url = escape($txtfile);
return p(a({-href => $url},
img({-src => "/icons/text.gif", # $self->playlist_icon,
-align => 'ABSMIDDLE',
-class => 'subdir',
-alt => 'Text File',
-border => 0}))
. $nb .
a({-href => $url},
font({-class => 'subdirectory'},
$title)));
}
# this is called to display the subdirs (subdirectories) within the current directory
sub list_subdirs {
my $self = shift;
my $subdirs = shift; # arrayref
$self->subdir_list_top($subdirs);
$self->subdir_list($subdirs);
$self->subdir_list_bottom($subdirs);
}
# this is called to display the playlists within the current directory
sub list_playlists {
my $self = shift;
my $playlists = shift; # arrayref
$self->playlist_list_top($playlists);
$self->playlist_list($playlists);
$self->playlist_list_bottom($playlists);
}
# this is called to display the text files within the current directory
sub list_txtfiles {
my $self = shift;
my $txtfiles = shift; # arrayref
$self->txtfile_list_top($txtfiles);
$self->txtfile_list($txtfiles);
$self->playlist_list_bottom($txtfiles);
}
# this is called to display the MP3 files within the current directory
sub list_mp3s {
my $self = shift;
my $mp3s = shift; #hashref
my $mode = shift; #how should we construct the urls?
$mode ||= '';
$self->mp3_list_top( $mp3s,$mode);
$self->mp3_list( $mp3s,$mode);
$self->mp3_list_bottom($mp3s,$mode);
}
# top of MP3 file listing
sub mp3_list_top {
my $self = shift;
my $mp3s = shift; #hashref
my $mode = shift;
print hr;
my $uri = $self->r->uri; # for self referencing
sub format_table_fields {
my $self = shift;
return map {
$self->x(ucfirst($_))
} $self->fields;
}
# bottom of MP3 file listing
sub mp3_list_bottom {
my $self = shift;
my $mp3s = shift; #hashref
my $mode = shift;
print TR(td(),
td({$self->aleft,-colspan=>10},$self->control_buttons($mode)))
if $self->stream_ok;
print end_table,"\n";
print end_form;
print hr;
}
# each item of the list
sub mp3_list {
my $self = shift;
my $mp3s = shift; #hashref
my $mode = shift;
my @f = $self->sort_mp3s($mp3s);
my $count = 0;
for my $song (@f) {
my $class = $count % 2 ? 'even' : 'odd';
my $contents = $self->format_song($song,$mp3s->{$song},$count,$mode);
print TR({
-class => $class,
-onMouseOver => "hiliteRow(this,true)",
-onMouseOut => "hiliteRow(this,false)",
-onMouseDown => "toggleRow(this)",
},td($contents)), "\n";
$count++;
}
}
# return the contents of the table for each mp3
sub format_song {
my $self = shift;
my ($song,$info,$count,$mode) = @_;
my @contents = ($self->format_song_controls($song,$info,$count,$mode),
$self->format_song_fields ($song,$info,$count));
return \@contents;
}
# Format the control part of each mp3 in the listing (checkbox, etc).
# Each list item becomes a cell in the table.
sub format_song_controls {
my $self = shift;
my ($song,$info,$count,$mode) = @_;
my $song_title = sprintf("%3d. %s", $count, $info->{title} || $song);
my $url = escape($song);
#my $url = $song;
warn $mode if DEBUG;
(my $play = $url) =~ s/(\.[^.]+)?$/.m3u?play=1/;
(my $urldir = $url) =~ s!/[^/]+$!/!;
my $controls = '';
my $cancel = "event.cancelBubble='true'";
$controls .= checkbox(-name =>'file',
-value =>$song,
-label =>'',
-onClick => "toggleCheckbox(this)", # works on most platforms
) if $self->stream_ok;
$controls .= a({-href=>$url,-class => 'fetch',-onMouseDown=>$cancel}, b(' ['.
$self->x('fetch')
.']'
))
if $self->download_ok;
$controls .= a({-href=>$play,-onMouseDown=>$cancel},b(' ['. # TODO: make an nbsp joiner?
$self->x('stream')
.']'
))
if $self->stream_ok;
return (
$self->stream_ok ? a({-href=>$play},
img({-src => $self->song_icon,-alt =>
$self->x('stream'),
-border => 0}))
: img({-src => $self->song_icon})
, $controls
);
}
# format the fields of each mp3 in the listing (artist, bitrate, etc)
sub format_song_fields {
my $self = shift;
my ($song,$info,$count) = @_;
return map { ($info->{lc($_)}||'') =~ /^\d+$/ ?
$info->{lc($_)} : # Do NOT use p(), it makes the cells huge in some browsers.
($info->{lc($_)} || ' ') } $self->fields;
}
# read a single directory, returning lists of subdirectories and MP3 files
sub read_directory {
my $self = shift;
my $dir = shift;
my (@directories,%seen,%mp3s,@playlists,@txtfiles);
opendir D,$dir or return;
while (defined(my $d = readdir(D))) {
next if $self->skip_directory($d);
# skip if file is unreadable
next unless -r "$dir/$d";
my $mime = $self->r->lookup_file("$dir/$d")->content_type;
};
sub read_vorbis_hp {
my $self = shift;
my ($file,$data) = @_;
my $ogg = Ogg::Vorbis::Header::PurePerl->load($file) or return;
my $comments = $ogg->$_comments;
my $info = $ogg->info;
my $sec = int $info->{length};
#THESE ARE ALPHABETIZED. KEEP THEM IN ORDER!
%$data = (
album => $comments->{album} || $comments->{ALBUM} || '',
artist => $comments->{artist} || $comments->{ARTIST} || '',
bitrate => int $info->{bitrate_nominal}/1000,
comment => $comments->{comment} || $comments->{COMMENT} || '',
duration => sprintf("%d:%2.2d", int($sec/60), $sec%60),
genre => $comments->{genre} || $comments->{GENRE} || '',
min => int $sec/60,
samplerate => $info->{rate},
sec => $sec%60,
seconds => $sec,
title => $comments->{title} || $comments->{TITLE} || '',
track => $comments->{tracknumber} || $comments->{TRACKNUMBER} || '',
year => $comments->{year} || $comments->{YEAR} || '',
);
return;
}
}
sub read_wav {
my $self = shift;
my ($file,$data) = @_;
my $wav = Audio::Wav->new;
my $reader = $wav->read($file);
my $comments = $reader->get_info() || {};
my $details = $reader->details() || {};
my $sec = $reader->length_seconds;
#THESE ARE ALPHABETIZED. KEEP THEM IN ORDER!
%$data = (
album => $comments->{album} || $comments->{ALBUM} || '',
artist => $comments->{artist} || $comments->{ARTIST} || '',
bitrate => int($details->{bytes_sec}*8/1024),
comment => $comments->{comment} || $comments->{COMMENT} || '',
duration => sprintf("%d:%2.2d", int $sec/60,$sec%60),
genre => $comments->{genre} || $comments->{GENRE} || '',
min => int $sec/60,
samplerate => $details->{sample_rate},
sec => $sec %60,
seconds => $sec,
title => $comments->{title} || $comments->{TITLE} || '',
track => $comments->{tracknumber} || $comments->{TRACKNUMBER} || '',
year => $comments->{year} || $comments->{YEAR} || '',
)
}
# a limited escape of URLs (does not escape directory slashes)
sub path_escape {
my $self = shift;
my $uri = shift;
$$uri =~ s!([^a-zA-Z0-9_/.-])!uc sprintf("%%%02x",ord($1))!eg;
}
# get fields to display in list of MP3 files
sub fields {
my $self = shift;
my @f = split /\W+/,$self->r->dir_config('Fields')||'';
return map { lc $_ } @f if @f; # lower case
return qw(title artist duration bitrate); # default
}
# read from the cache
sub read_cache {
my $self = shift;
my $file = shift;
return unless my $cache = $self->cache_dir;
my $cache_file = "$cache$file";
my $file_age = -M $file;
return unless -e $cache_file && -M $cache_file <= $file_age;
return unless my $c = IO::File->new($cache_file);
my ($data,$buffer);
while (read($c,$buffer,4096)) {
$data .= $buffer;
}
close $c;
my @data = split $;,$data;
push @data,'' if @data %2; # avoid odd numbered hashes
return @data;
}
# write to the cache
sub write_cache {
my $self = shift;
my ($file,$data) = @_;
return unless my $cache = $self->cache_dir;
my $cache_file = "$cache$file";
# some checks and untaint
return if $cache_file =~ m!/\.\./!; # no relative path tricks
$cache_file =~ m!^(/.+)$! or return;
$cache_file = $1;
my $dirname = dirname($cache_file);
-d $dirname || eval{mkpath($dirname)} || return;
if (my $c = IO::File->new(">$cache_file")) {
print $c join $;,%$data;
}
1;
}
# called to open the MP3 file
# can override to do downsampling, etc
sub open_file {
my $self = shift;
my $file = shift;
return IO::File->new($file,O_RDONLY);
# return true if client can stream
sub is_stream_client {
my $r = shift->r;
my $h = $r->headers_in;
$h->{'Icy-MetaData'} # winamp/xmms
|| $h->{'Bandwidth'} # realplayer
|| $h->{'Accept'} =~ m!\baudio/mpeg\b! # mpg123 and others
|| $h->{'User-Agent'} =~ m!^NSPlayer/! # Microsoft media player
|| $h->{'User-Agent'} =~ m!^xmms/!;
}
# whether to read info for each MP3 file (might take a long time)
sub read_mp3_info {
my $d = shift->r->dir_config('ReadMP3Info') || '';
return $d !~ /$NO/oi;
}
# whether to time out streams
sub stream_timeout {
shift->r->dir_config('StreamTimeout') || 0;
}
# how long an album list is considered so long we should put buttons
# at the top as well as the bottom
sub file_list_is_long { shift->r->dir_config('LongList') || 10 }
sub home_label {
my $self = shift;
my $home = $self->r->dir_config('HomeLabel') ||
$self->x('Home');
return lc($home) eq 'hostname' ? $self->r->hostname : $home;
}
sub path_style { # style for the path to parent directories
lc(shift->r->dir_config('PathStyle')) || 'Staircase';
}
# where is our cache directory (if any)
sub cache_dir {
my $self = shift;
return unless my $dir = $self->r->dir_config('CacheDir');
my $rootdir = Apache2::ServerUtil::server_root();
return $dir if $dir =~ m!^/!;
return "$rootdir/$dir";
}
# columns to display
sub subdir_columns {shift->r->dir_config('SubdirColumns') || SUBDIRCOLUMNS }
sub playlist_columns {shift->r->dir_config('PlaylistColumns') || PLAYLISTCOLUMNS }
# various configuration variables
sub default_dir { shift->r->dir_config('BaseDir') || BASE_DIR }
sub stylesheet { shift->get_dir('Stylesheet', STYLESHEET) }
sub parent_icon { shift->get_dir('ParentIcon',PARENTICON) }
sub cd_list_icon {
my $self = shift;
my $subdir = shift;
my $image = $self->r->dir_config('CoverImageSmall') || COVERIMAGESMALL;
my $directory_specific_icon = $self->r->filename."/$subdir";
my $uri = escape($subdir)."/$image";
# override the icon filename if the dir is fully pathed
if (substr($subdir, 0, 1) eq "/") {
$directory_specific_icon = $self->r->lookup_uri($subdir)->filename;
}
$directory_specific_icon .= "/$image";
return -e $directory_specific_icon
? $uri
: $self->get_dir('DirectoryIcon',CDLISTICON);
}
sub playlist_icon {
my $self = shift;
my $image = $self->r->dir_config('PlaylistImage') || PLAYLISTIMAGE;
my $directory_specific_icon = $self->r->filename."/$image";
warn $directory_specific_icon if DEBUG;
return -e $directory_specific_icon
? $self->r->uri . "/$image"
: $self->get_dir('PlaylistIcon',PLAYLISTICON);
}
sub song_icon { shift->get_dir('SongIcon',SONGICON) }
sub arrow_icon { shift->get_dir('ArrowIcon',ARROWICON) }
sub help_url { shift->get_dir('HelpURL', HELPIMGURL) }
sub help_img_url { shift->get_dir('HelpImgURL',HELPIMGURL) }
sub cd_icon {
my $self = shift;
my $dir = shift;
my $coverimg = $self->r->dir_config('CoverImage') || COVERIMAGE;
if (-e "$dir/$coverimg") {
$coverimg;
} else {
$self->get_dir('TitleIcon',CDICON);
}
}
sub missing_comment {
my $self = shift;
my $missing = $self->r->dir_config('MissingComment') || '';
return if $missing eq 'off';
$missing = $self->lh->maketext('unknown') unless $missing;
$missing;
}
# create description string
sub description {
my $self = shift;
my $data = shift;
my $description;
my $format = $self->r->dir_config('DescriptionFormat');
if ($format) {
($description = $format) =~ s{%([atfglncrdmsqS%])}
{$1 eq '%' ? '%'
: $data->{$FORMAT_FIELDS{$1}}
}gxe;
} else {
$description = $data->{title} || basename($data->{filename},
$self->suffixes());
$description .= " - $data->{artist}" if $data->{artist};
$description .= " ($data->{album})" if $data->{album};
=item $mp3->mp3_table_header
This creates the first row (table headers) of the list of MP3 files.
=item $mp3->mp3_list_bottom($mp3s)
This method generates the buttons at the bottom of the MP3 file
listing. C<$mp3s> is a hashref containing information about each file.
=item $mp3->mp3_list($mp3s)
This routine sorts the MP3 files contained in C<$mp3s> and invokes
format_song() to format it for the table.
=item @buttons = $mp3->control_buttons
Return the list of buttons printed at the bottom of the MP3 file listing.
=item $arrayref = $mp3->format_song($song,$info,$count)
This method is called with three arguments. C<$song> is the path to
the MP3 file, C<$info> is a hashref containing tag information from
the song, and C<$count> is an integer containing the song's position
in the list (which currently is unusued). The method invokes
format_song_controls() and format_song_fields() to generate a list of
elements to be incorporated into cells of the table, and returns an
array reference.
=item @array = $mp3->format_song_controls($song,$info,$count)
This method is called with the same arguments as format_song(). It
returns a list (not an arrayref) containing the "control" elements of
one row of the MP3 list. The control elements are all the doo-dads on
the left-hand side of the display, including the music icon, the
checkbox, and the [fetch] and [stream] links.
=item @array = $mp3->format_song_fields($song,$info,$count)
This method is called with the same arguments as format_song(). It
returns a list (not an arrayref) containing the rest of a row of the
MP3 file display. This will include the title, artist, and so forth,
depending on the values of the Fields configuration. variable.
=item ($directories,$mp3s) = $mp3->read_directory($dir)
This method reads the directory in C<$dir>, generating an arrayref
containing the subdirectories and a hashref containing the MP3 files
and their information, which are returned as a two-element list.
=item $hashref = $mp3->fetch_info($file)
This method fetches the MP3 information for C<$file> and returns a
hashref containing the MP3 tag information as well as some synthesized
fields. The synthesized fields are I<track>, which contains the same
information as I<tracknum>; I<description>, which contains the title,
album and artist merged together; and I<duration>, which contains the
duration of the song expressed as hours, minutes and seconds. Other
fields are taken directly from the MP3 tag, but are downcased (for
convenience to other routines).
=item Apache::MP3->path_escape($scalarref)
This is a limited form of CGI::escape which does B<not> escape the
slash symbol ("/"). This allows URIs that correspond to directories
to be escaped safely. The escape is done inplace on the passed scalar
reference.
=item @fields = $mp3->fields
Return the fields to display for each MP3 file. Reads the I<Fields>
configuration variable, or uses a default list.
=item $hashref = $mp3->read_cache($file)
Reads the cache for MP3 information about the indicated file. Returns
a hashref of the same format used by fetch_info().
=item $boolean = $mp3->write_cache($file,$info)
Writes MP3 information to cache. C<$file> and C<$info> are the path
to the file and its MP3 tag information, respectively. Returns a
boolean indicating the success of the operation.
=item $boolean = $mp3->download_ok
Returns true if downloading files is allowed.
=item $boolean = $mp3->stream_ok
Returns true if streaming files is allowed.
=item $boolean = $mp3->check_stream_client
Returns true if the module should check the browser/MP3 player for
whether it accepts streaming.
=item $boolean = $mp3->is_stream_client
Returns true if this MP3 player can accept streaming. Note that this
is not a foolproof method because it checks a variety of
non-standardized headers and user agent names!
=item $boolean = $mp3->read_mp3_info
Returns true if the module should read MP3 info (true by default).
=item $seconds = $mp3->stream_timeout
Returns the number of seconds after which streaming should time out.
Used for "demo mode".
=item $lines = $mp3->file_list_is_long
Returns the number of lines in the MP3 file listing after which the
list is considered to be "long". When a long list is encountered, the
module places the control buttons at both the top and bottom of the
MP3 file table, rather than at the bottom only. This method
=item $html = $mp3->home_label
Returns a fragment of HTML to use as the "Home" link in the list of
parent directories.
=item $style = $mp3->path_style
( run in 0.643 second using v1.01-cache-2.11-cpan-df04353d9ac )