Apache-MP3
view release on metacpan or search on metacpan
print "\n<!-- begin playlists -->\n";
$self->list_playlists($playlists);
print "\n<!-- end playlists -->\n";
}
if(%$mp3s) {
print "\n<!-- begin mp3s -->\n";
$self->list_mp3s($mp3s);
print "\n<!-- end mp3s -->\n";
}
print "\n<!-- end main -->\n";
print hr unless %$mp3s;
$self->directory_bottom($dir);
return OK;
}
# print the HTML at the top of the page
sub page_top {
my $self = shift;
my $dir = shift;
my $title = $self->r->uri;
print start_html(
-title => $title,
-head => meta({-http_equiv => 'Content-Type',
-content => 'text/html; charset='
. $self->html_content_type
}),
-lang => $self->lh->language_tag,
-dir => $self->lh->direction,
-style => {-src=>$self->stylesheet},
-script =>{-src=>$self->default_dir.'/functions.js'},
);
}
# print the HTML at the top of a directory listing
sub directory_top {
my $self = shift;
my $dir = shift;
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();
}
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();
}
return $result;
}
sub last_accessed {
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
$uri =~ s!([^a-zA-Z0-9/])!uc sprintf("%%%02x",ord($1))!eg;
# apache and/or mod_perl has some problem redirecting from POST requests...
print start_form(-name=>'form',-action=>"${uri}playlist.m3u",-method=>'GET');
my $count = keys %$mp3s;
print
"\n\n",
h2({-class=>'SongList'},
a({-name=>'cds'},
( run in 1.667 second using v1.01-cache-2.11-cpan-ceb78f64989 )