Apache-MP3
view release on metacpan or search on metacpan
3.01 Sun Aug 18 13:32:59 EDT 2002
-Changed the way that $VERSION is defined in the localization modules
in order to live peacefully with CPAN.
3.00 Fri Aug 16 00:12:33 EDT 2002
- Extensive contribution from Sean Burke to provide localization and
internationalization.
2.26 Wed Apr 17 11:03:24 EDT 2002
- Added patch from Tom Hughes to correctly escape paths in the playlist.
- Added patch from Tom Hughes to fetch the average bitrate for VBR Ogg
files rather than the nominal bitrate (which is meaningless).
2.25 Tue Apr 9 12:35:44 EDT 2002
- Added patch from Clemens Schrimpe to handle diacritical marks in
CD icon names.
- Added patch from John Regehr to get CDDB information from an
external index file, if present.
- Put warning in the error_log if PerlSetupEnv has been set to off
(thanks to Stas Bekman and Eric Hammond)
&& '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).
$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);
$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;
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;
}
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 $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){
# 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},
# 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'},
}
# 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',
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
# 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);
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)
MP3/L10N.pm view on Meta::CPAN
);
sub encoding { "iso-8859-1" } # Latin-1
# Override as necessary if you use a different encoding
# Things overridden in RightToLeft.pm:
sub left { 'left' }
sub right { 'right' }
sub direction { 'ltr' }
sub must_escape { $_[0]{'must_escape'} || '' }
# don't override that unless you know what you're doing.
1;
__END__
=head1 NAME
Apache::MP3::L10N - base class for Apache::MP3 interface localization
=head1 SYNOPSIS
MP3/Playlist.pm view on Meta::CPAN
if (param('Play All') and param('playlist')) {
return HTTP_NO_CONTENT unless @$playlist;
my @list = @$playlist;
return $self->send_playlist(\@list);
}
if ($changed) {
$self->flush;
(my $uri = $r->uri) =~ s!playlist\.m3u$!!;
$self->path_escape(\$uri);
my $rand = int rand(100000);
$r->headers_out->add(Location => "$uri?$rand");
return REDIRECT;
}
$self->playlist($playlist);
return;
}
sub retrieve_playlist {
MP3/Playlist.pm view on Meta::CPAN
sub flush {
my $self = shift;
$self->session->flush;
}
sub directory_bottom {
my $self = shift;
if ($self->playlist) {
my $r = $self->r;
my $uri = $r->uri; # for self referencing
$self->path_escape(\$uri);
my $descriptions = $self->lookup_descriptions($self->playlist);
my @ok = grep { $descriptions->{$_} } $self->playlist;
print
a({-name=>'playlist'}),
table({-width=>'100%',-border=>1},
Tr({-class=>'playlist'},
td({-class=>'playlist'},
h3($self->x('Current Playlist')),
MP3/Resample.pm view on Meta::CPAN
package Apache::MP3::Resample;
# $Id: Resample.pm,v 1.7 2003/10/06 14:10:30 lstein Exp $
# Resamples (downsamples) on the fly
use strict;
use vars qw(@ISA $VERSION);
use Apache2::Const -compile => qw(:common);
use IO::File;
use CGI qw(:standard *table *TR *td escape);
use CGI::Cookie;
use Apache::MP3::Playlist;
use File::Basename;
$VERSION = 1.0;
@ISA = 'Apache::MP3::Playlist';
use constant ENCODE => qq(%Dlame%I %b -%F);
my @DECOMPRESSOR_DEFAULTS = ("audio/shorten" => "shorten -x %f -|",
MP3/Resample.pm view on Meta::CPAN
my $self = shift;
my $g = $self->{bitrate};
$self->{bitrate} = shift if @_;
return unless $self->presets($g);
$g;
}
sub stream_parms {
my $self = shift;
my $p = $self->SUPER::stream_parms;
my $rate = escape($self->bitrate);
$p .= ";bitrate=$rate" if $rate;
$p;
}
sub presets {
my $self = shift;
unless (%PRESETS) {
my @p;
if (my $conf = $self->r->dir_config('ResamplePresets')) {
@p = split /\s*(?:=>|,)\s*/,$conf;
( run in 0.509 second using v1.01-cache-2.11-cpan-c21f80fb71c )