#!/usr/bin/perl -w
use strict;
use warnings;
use CGI;
use Cwd;
use Carp qw( croak );
use MP3::M3U::Parser 2.30;
run();
sub run {
my $output;
my $cgi = CGI->new;
my %opt = (
encoding => 'ISO-8859-9', # http encoding
output_format => $cgi->param('xml') ? 'xml' : 'html',
base_dir => getcwd || q{.}, # where are your m3u files?
error => 'Invalid parameter!',
);
my $target = $cgi->param('m3u') ? \&m3u : \&list;
$target->( \$output, $cgi, \%opt );
my $head = $cgi->header(
-type => "text/$opt{output_format}",
-charset => $opt{encoding},
);
print $head . $output or croak "Can't print to STDOUT: $!";
return;
}
sub list {
my($OUT, $cgi, $opt) = @_;
my $p = $cgi->url;
opendir DIR, $opt->{base_dir};
my @m3u = readdir DIR;
closedir DIR;
$OUT .= <<"FRAGMENT";
<p style="font-family:Verdana;font-size:14px;font-weight:bold"
>M3U List</p>
<pre>
FRAGMENT
foreach my $file ( sort @m3u ) {
next if $file !~ m{ [.] m3u \z }xmsi;
my $name = $file;
$name =~ s{ [.] m3u \z }{}xmsi;
my $u = qq~$p?m3u=$name~;
$OUT .= qq~[ <a href="$u">HTML</a> - <a href="$u&xml=1" target="_blank">XML</a> ] $_~;
}
$OUT .= q~</pre>~;
return;
}
sub m3u {
my($OUT, $cgi, $opt) = @_;
my $m3u = $cgi->param('m3u') or return $opt->{error};
return $opt->{error} if $m3u =~ m{ \A A-Z_a-z_0-9 }xms;
my $file = sprintf q{%s/%s.m3u}, $opt->{base_dir}, $m3u;
return $opt->{error} if ! -e $file;
my $parser = MP3::M3U::Parser->new(-seconds => 'format');
$parser->parse($file);
$parser->export(
-encoding => $opt->{encoding},
-format => $opt->{output_format},
-drives => 'off',
-toscalar => \$OUT,
);
my $p = $cgi->url;
my $link = <<"FRAGMENT";
<p>
[
<a href = "$p"
style = "color:#FFFFFF"
>M3U List</a>
<a href = "$p?m3u=$m3u&xml=1"
style = "color:#FFFFFF"
target = "_blank"
>XML</a>
]
</p>
FRAGMENT
$OUT =~ s{<blockquote>}{$link<blockquote>}xms;
return;
}
1;
__END__