Apache-MP3-Skin
view release on metacpan or search on metacpan
package Apache::MP3::Skin;
# Subclasses Apache::MP3::Playlist and through the magic
# of HTML::Template allows Apache::MP3 to be skinned.
use strict;
use HTML::Template;
use Apache::Constants qw(:common REDIRECT HTTP_NO_CONTENT DIR_MAGIC_TYPE);
use constant COVERIMAGE => 'cover.jpg';
use CGI qw(param escape);
use Apache::MP3::Playlist;
use Apache::File ();
use Apache::URI ();
use File::Basename 'dirname','basename';
use vars qw(@ISA $VERSION);
@ISA = 'Apache::MP3::Playlist';
$VERSION = '0.91';
sub process_playlist {
my $self = shift;
my $r = $self->r;
my (@playlist,$changed);
if (my $cookies = CGI::Cookie->parse($r->header_in('Cookie'))) {
my $playlist = $cookies->{playlist};
@playlist = $playlist->value if $playlist;
if ($playlist[-1] &&
$r->lookup_uri($playlist[-1])->content_type ne 'audio/mpeg') {
$self->{possibly_truncated}++;
pop @playlist; # get rid of the last
}
}
if (param('Clear All')) {
@playlist = ();
$changed++;
}
if (param('Clear Selected')) {
my %clear = map { $_ => 1 } param('file') or return HTTP_NO_CONTENT;
@playlist = grep !$clear{$_},@playlist;
$changed++;
}
if (param('Add All to Playlist')) {
my %seen;
@playlist = grep !$seen{$_}++,(@playlist,@{$self->find_mp3s});
$changed++;
}
if (param('Add to Playlist')) {
my $dir = dirname($r->uri);
my @new = param('file') or return HTTP_NO_CONTENT;
my %seen;
# The line below is the only line that's different than SUPER::process_playlist
@playlist = grep !$seen{$_}++,(@playlist,map {(m/^\//) ? "$_" : "$dir/$_" } @new);
$changed++;
}
if (param('Play Selected') and param('playlist')) {
my @uris = param('file') or return HTTP_NO_CONTENT;
return $self->send_playlist(\@uris);
}
if (param('Shuffle All') and param('playlist')) {
return HTTP_NO_CONTENT unless @playlist;
return $self->send_playlist(\@playlist,'shuffle');
}
if (param('Play All') and param('playlist')) {
return HTTP_NO_CONTENT unless @playlist;
return $self->send_playlist(\@playlist);
}
if ($changed) {
my $c = CGI::Cookie->new(-name => 'playlist',
-value => \@playlist);
tied(%{$r->err_headers_out})->add('Set-Cookie' => $c);
(my $uri = $r->uri) =~ s!playlist\.m3u$!!;
$self->path_escape(\$uri);
$r->err_header_out(Location => $uri);
return REDIRECT;
}
$self->playlist(@playlist);
return;
}
sub run {
my $self = shift;
my $r = $self->r;
if (param('Shuffle Selected')) {
return HTTP_NO_CONTENT unless my @files = param('file');
$self->shuffle(\@files);
my $uri = dirname($r->uri);
$self->send_playlist([map { (m/^\//) ? "$_" : "$uri/$_" } @files]);
return OK;
}
return $self->SUPER::run();
}
# override the list_directory in Apache::MP3, see if there's a skin file.
# if there's a skin file, we'll handle it otherwise pass it back (SUPER)
# to Apache::MP3
sub list_directory {
my $self = shift;
my $dir = shift;
return DECLINED unless my ($directories,$mp3s,$playlists)
= $self->read_directory($dir);
if ($self->r->header_only) {
$self->r->send_http_header('text/html');
return OK;
}
my $skin = $self->get_skin_path($dir);
if ($skin) {
$self->r->send_http_header('text/html');
# open the html template
my $template = HTML::Template->new(filename => $skin, die_on_bad_params=>0, loop_context_vars=>1);
$self->set_template_params($template, $dir, $directories, $mp3s);
# print the template
my $page = $template->output;
#add the javascript tag
my $script_tag = "<SCRIPT language=\"JavaScript\" src=\"".$self->default_dir."/apache_mp3_skin.js\"></SCRIPT>";
$page =~ s!(</HEAD[^>]*>)!$script_tag$1!oi;
$page =~ s!(<BODY[^>]*>)!$1<FORM NAME="apache_mp3_skin">!oi;
$page =~ s!(</BODY[^>]*>)!</FORM>$1!oi;
my @inners = @$inner_loops;
if ($#inners > -1) {
@param_names = $template->query(loop => $inner_loops);
} else {
@param_names = $template->query();
}
my %params;
foreach (@param_names) {
my $p = lc $_;
if ($p =~ m/^__\S*__$/) {
$params{$_} = $self->set_loop_params($p,$count);
} elsif ($p eq "is_dir") {
$params{$_} = "1";
} elsif ($p eq "is_mp3") {
$params{$_} = "0";
} else {
$params{$_} = $self->set_context_params($p, $template, $dir, $uri, $directories, $mp3s, $inner_loops);
}
}
return \%params;
}
sub set_mp3_context_params {
my ($self, $template, $dir, $uri, $directories, $mp3s, $inner_loops, $song_file, $song, $count, $on_playlist) = @_;
# Warning: Hack following. A double '//' is creeping into $uri. Remove it.
if ($uri) {
$uri =~ s/\/\//\//g;
}
my @param_names;
my @inners = @$inner_loops;
if ($#inners > -1) {
@param_names = $template->query(loop => $inner_loops);
} else {
@param_names = $template->query();
}
my %params;
foreach (@param_names) {
my $p = lc $_;
if (defined $$song{$_}) {
$params{$_} = $$song{$_};
next;
}
if ($p =~ m/^__\S*__$/) {
$params{$_} = $self->set_loop_params($p,$count);
} elsif (($p eq "is_dir") && (not $on_playlist)) {
$params{$_} = "0";
} elsif (($p eq "is_mp3") && (not $on_playlist)) {
$params{$_} = "1";
} elsif ($p eq "fetch_url") {
if ($self->download_ok) {
$params{$_} = ($on_playlist) ? escape($song_file) : $uri.escape($song_file);
} else {
$params{$_} = "";
}
} elsif (($p eq "add_to_playlist_url") && (not $on_playlist)) {
$params{$_} = $self->r->uri."playlist.m3u?Add+to+Playlist=1;file=".$uri.escape($song_file);
} elsif (($p eq "remove_from_playlist_url") && ($on_playlist)) {
$params{$_} = $self->r->uri."playlist.m3u?Clear+Selected=1;playlist=1;file=".escape($song_file);
} elsif ($p eq "play_url") {
if ($self->stream_ok) {
$params{$_} = ($on_playlist) ? escape($song_file)."?play=1;" : $uri . escape($song_file) . "?play=1;";
$params{$_} =~ s/(\.[^.]+)?$/.m3u?play=1/;
} else {
$params{$_} = "";
}
} elsif ($p eq "checkbox") {
$params{$_} = ($on_playlist) ? "<input type=\"checkbox\" name=\"pl\" value=\"$song_file\" />":
"<input type=\"checkbox\" name=\"mp3\" value=\"$uri/$song_file\" />";
} else {
$params{$_} = $self->set_context_params($p, $template, $dir, $uri, $directories, $mp3s, $inner_loops);
}
}
return \%params;
}
sub set_loop_params {
# NOTE THAT __FIRST__, __LAST__, and __INNER__ are handled by HTML::Template not here.
my ($self, $p, $count) = @_;
if ($p eq "__count__") {
return $count;
} elsif ($p eq "__count_base_zero__") {
return $count - 1;
} elsif ($p eq "__odd__") {
return ($count % 2) ? "1" : "0";
} elsif ($p eq "__even__") {
return ($count % 2) ? "0" : "1";
} elsif ($p =~ m/__first_col_(\d+)__/) {
if ($1 < 1) { return "0"; }
my $x = ($count + $1) % $1;
return ( $x = 1 ) ? "1" : "0";
} elsif ($p =~ m/__last_col_(\d+)__/) {
if ($1 < 1) { return "0"; }
my $x = ($count + $1) % $1;
return ( $x = 0 ) ? "1" : "0";
} elsif ($p =~ m/__inner_col_(\d+)__/) {
if ($1 < 1) { return "0"; }
my $x = ($count + $1) % $1;
return ( $x > 1 ) ? "1" : "0";
}
return "";
}
sub set_context_params {
my ($self, $p, $template, $dir, $uri, $directories, $mp3s, $inner_loops) = @_;
if ($p eq "allow_stream") { return ($self->stream_ok) ? "1" : "0"; }
if ($p eq "allow_download") { return ($self->download_ok) ? "1" : "0"; }
# What's the skin's filename?
my $skin_filename = $self->skin_filename || return undef;
return $dir."/".$skin_filename if (-r $dir."/".$skin_filename);
return $self->r->document_root.$self->default_dir."/".$skin_filename if (-r $self->r->document_root.$self->default_dir."/".$skin_filename);
return undef;
}
1;
__END__
=head1 NAME
Apache::MP3::Skin - A subclass of Apache::MP3::Playlist with the ability to "skin"
the output using HTML::Template
=head1 SYNOPSIS
# httpd.conf or srm.conf
AddType audio/mpeg .mp3 .MP3
# httpd.conf or access.conf
<Location /songs>
SetHandler perl-script
PerlHandler Apache::MP3::Skin
PerlSetVar HomePath /songs # optional
PerlSetVar DefaultSkin default.tmpl # required
# Without DefaultSkin being set to a valid file
# Apache::MP3::Skin will be the same as Apache::MP3
</Location>
=head1 DESCRIPTION
Apache::MP3::Skin subclasses Apache::MP3::Playlist enabling the use of skin files
which are html files with special tags enabled by HTML::Template. See L<Apache::MP3>
for details on installing and using.
=head1 CUSTOMIZING WITH SKINS
The whole purpose of this class is to allow custom GUIs to be built upon
Apache::MP3::Playlist and subsequently Apache::MP3 itself. Skin are just html files
that contain various tags in the form of <TMPL_blah,blah [ATTRIBUTE=value]>. The filename
of the skin to be used is set with PerlSetVar DefaultSkin and can be overridden by
"?skin=someskin.tmpl" in the query string. The skin file is first looked for in the
directory of the request. For example, if you were to go to /Songs/Rock, Apache::MP3::Skin
would first look for the skin file in /Songs/Rock. If it didn't find one there, it'd look in
the directory set by PerlSetVar BaseDir (usually, /apache_mp3). In most cases you'll want
to keep all your skins in the BaseDir, but it is possible to have a different skin for each
directory.
Complete documentation on these tags can be found at L<HTML::Template>, but
enough to get you started follows.
=over 4
=item <TMPL_VAR [ESCAPE="HTML" | ESCAPE="URL"] NAME=variable>
Tag is replace with the value of variable and optionally escaped making it html
or url compliant.
=item <TMPL_IF NAME=variable> html here
[ <TMPL_ELSE> more here ]
</TMPL_IF>
The value or variable is evaluated, and if it is not empty or "0" it is
considered true and "some html" is outputed to the browser. A <TMPL_ELSE>
can optionaly be specified.
=item <TMPL_UNLESS NAME=variable> html here
[ <TMPL_ELSE> more here ]
</TMPL_UNLESS>
Similar to <TMPL_IF> but "html here" is outputed to the browser when variable
is either "" or "0".
=item <TMPL_LOOP NAME=loop_name> do this </TMPL_LOOP>
This tag is more complicated the others, but basically it outputs "do this"
multiple times. The number of times is determined by loop_name. Looping also
changes the context of some variable. For example...
<ul>
<TMPL_LOOP NAME="MP3S"><li> <TMPL_VAR NAME="TITLE"> </TMPL_LOOP>
</ul>
For each iteration of MP3S, TITLE will be different value.
Note: that variables can be used in TMPL_VAR, TMPL_UNLESS, and TMPL_IF, but not
in TMPL_LOOP which requires a loop_name.
=item <TMPL_INCLUDE NAME="filename.tmpl">
This tag includes a template directly into the current template at the
point where the tag is found. The included template contents are used
exactly as if its contents were physically included in the master template.
The file specified can be a full path - beginning with a '/'. If it isn't a
full path, the path to the enclosing file is tried first.
=back
=head1 NESTING TEMPLATE TAGS
Yes. All the tags can be nested in almost any way. A few variables are
limited to be inside certain loops, but that's the only restriction.
=head1 VARIABLES
Variables can be used in TMPL_VAR, TMPL_UNLESS, and TMPL_IF, and they are grouped below
into for types: global, directory scoped, file scoped, and special loop variables. At
last count there were 68 valid variables and some like PARAM_param and IS_SORT_sort can
take many forms.
=head2 Global Variables
These variables' values do not change during the parsing of a template and available
everywhere.
( run in 1.749 second using v1.01-cache-2.11-cpan-59e3e3084b8 )