Committer: gariev
New version of LJ::RadioU trunk/cgi-bin/LJ/Radio.pm
Modified: trunk/cgi-bin/LJ/Radio.pm
===================================================================
--- trunk/cgi-bin/LJ/Radio.pm 2010-09-21 05:32:34 UTC (rev 17420)
+++ trunk/cgi-bin/LJ/Radio.pm 2010-09-21 07:28:02 UTC (rev 17421)
@@ -20,10 +20,13 @@
## </Perl>
## SetHandler perl-script
## PerlHandler LJ::Radio
-## PerlSetVar LJRadioBlockSize 4096
-## PerlSetVar LJRadioVerbose 0
-## PerlSetVar LJRadioDataDir /home/lj/var/www/radio/data
+## DocumentRoot /home/lj/var/www/radio/data
##
+## ## Optional config vars:
+## ## PerlSetVar LJRadioBlockSize 4096
+## ## PerlSetVar LJRadioVerbose 1
+##
+##
package LJ::Radio;
@@ -31,141 +34,246 @@
use warnings;
use Apache2::RequestRec();
use Apache2::RequestIO();
-use Apache2::ServerUtil();
+use Apache2::RequestUtil;
use Apache2::Connection();
use Apache2::Const qw(OK DECLINED SERVER_ERROR);
use APR::Table;
-use MP3::Info;
+use MP3::Info qw(get_mp3info);
use IO::Dir;
use Fcntl qw(SEEK_SET);
use Data::Dumper qw/Dumper/;
+use constant { LOG_INFO => 2, LOG_WARN => 1, LOG_ERROR => 0 };
+
sub handler {
my $r = shift;
return DECLINED
- unless $r->method eq 'GET';
+ unless $r->method eq 'GET' && -d $r->filename;
- if ( $r->headers_in->get('icy-metadata') ||
- $r->headers_in->get('User-Agent') =~ /NSPlayer/) ## Microsoft Windows Media player
- {
- LJ::Radio->serve_streaming_request($r);
- return OK;
+ my $block_size = $r->dir_config("LJRadioBlockSize") || 8192;
+ my $verbose = $r->dir_config("LJRadioVerbose") || 0;
+
+ my $self = bless {
+ r => $r,
+ block_size => $block_size,
+ verbose => $verbose,
+ };
+
+ if ($self->is_streaming_request) {
+ return $self->serve_streaming_request;
} else {
- $r->log_reason("Got a non-streaming request");
- $r->content_type("text/plain");
- print("This stream requires a shoutcast/icecast compatible player (e.g. winamp, mpg123 or microsoft media player)");
- return OK;
+ return $self->serve_browser_request;
}
}
+sub is_streaming_request {
+ my $self = shift;
+
+ my $r = $self->{'r'};
+ my $h = $r->headers_in;
+ return $h->get('icy-metadata')
+ || $h->get('User-Agent') =~ /NSPlayer/ ## Microsoft Windows Media player
+ || $r->args('stream');
+}
+
+## implementation of SHOUTcast protocol
sub serve_streaming_request {
- my $class = shift;
- my $r = shift;
+ my $self = shift;
- my $s = Apache2::ServerUtil->server;
- my $block_size = $s->dir_config("LJRadioBlockSize") || 8192;
- my $data_dir = $s->dir_config("LJRadioDataDir") || "/var/www/radio/data";
- my $verbose = $s->dir_config("LJRadioVerbose");
- $verbose = 1 unless defined $verbose;
+ my $r = $self->{'r'};
+ $self->log(LOG_WARN, "New connection");
- warn "BlockSize=$block_size, data_dir=$data_dir, verbose=$verbose" if $verbose;
-
- my $self = bless {
- r => $r,
- block_size => $block_size,
- data_dir => $data_dir,
- verbose => $verbose,
- }, $class;
+ ## print headers
+ $r->assbackwards(1); ## notify Apache that we will print all headers ourselves
+ $r->print("ICY 200 OK\r\n");
+ $r->print("icy-name:LiveJournal Voice Posts\r\n");
+ $r->print("icy-genre:voice\r\n");
+ $r->print("icy-br:128\r\n");
+ $r->print("icy-metaint:$self->{block_size}\r\n");
+ $r->print("\r\n");
+ $self->log(LOG_WARN, "Headers are printed");
- warn "Got streaming request" if $verbose;
-
- $self->print_headers();
- my (%played_files, $fh);
my $buffer = '';
- my $current_journal = '';
-
+ my $block_size = $self->{'block_size'};
+ my $file_iterator = LJ::Radio::FileIterator->new($self);
+
SEND_FILE:
while (!$r->connection->aborted) {
- ## choose a file
- my @files = $self->get_list_of_files();
- unless (@files) {
- $r->log_reason("No files found in '$data_dir'");
+ ## get a file to send to client
+ my $file = $file_iterator->get_next_file;
+ if (!$file) {
+ $r->log(LOG_ERROR, "No more mp3 files found!");
return SERVER_ERROR;
}
- my @non_played_files = grep { !$played_files{$_} } @files;
- my $file = (@non_played_files)
- ? $non_played_files[ rand(scalar@non_played_files) ]
- : $files[ rand(scalar @files) ];
- warn "File is $file" if $verbose;
- $played_files{$file}++;
+ $self->log(LOG_WARN, "File is $file");
## get info and open the file, skip ID3 section
my $info = get_mp3info($file);
- warn(Dumper $info) if $verbose>1;
+ $self->log(LOG_INFO, Dumper($info));
+ my $fh;
unless (open($fh, $file)) {
- $r->log_reason("Can't read from $file: $!");
+ $r->log(LOG_ERROR, "Can't read from $file: $!");
next SEND_FILE;
}
unless (seek($fh, $info->{'OFFSET'}, SEEK_SET)) {
- $r->log_reason("Invalid file $file: can't seek to $info->{'OFFSET'}");
+ $r->log(LOG_ERROR, "Invalid file $file: can't seek to $info->{'OFFSET'}");
next SEND_FILE;
}
- $current_journal = ($file =~ /^\d+-(\w+)-/) ? $1 : '';
+
+ ## create a SHOUTcast separator/stream info header
+ my $stream_info;
+ {
+ my $current_journal = ($file =~ /^\d+-(\w+)-/) ? $1 : '';
+ my $h = "StreamTitle=$current_journal";
+ my $l = length($h);
+ my $k = int( ($l+15)/16 );
+ $stream_info = pack("C", $k) . $h . "\0" x ($k*16 - $l);
+ }
- ## send the file content (actually, stream section of the file)
+ ## send the file content (actually, data stream section of the file)
my $l = length($buffer);
while (my $rv = read($fh, $buffer, $block_size-$l, $l)) {
die if length($buffer)>$block_size;
- warn "Read $rv bytes from $file" if $verbose>2;
+ $self->log(LOG_INFO, "Read $rv bytes from $file");
if (length($buffer)==$block_size) {
- warn "Going to print buffer" if $verbose>2;
+ $self->log(LOG_INFO, "Going to print buffer");
## $r->print may cause exception for connections aborted by users:
## Apache2::RequestIO::print: (103) Software caused connection abort
eval { $r->print($buffer); }
or last SEND_FILE;
- warn "Buffer is printed" if $verbose>2;
+ $self->log(LOG_INFO, "Buffer is printed");
$buffer = '';
- my $header = "StreamTitle=$current_journal";
- my $k = int( (length($header)+15)/16 );
- $header .= "\0" x ($k*16 - length($header));
- $r->print( pack("C", $k) . $header );
+ $r->print($stream_info);
}
}
- close $fh; undef $fh;
+ close $fh;
}
- close $fh if $fh; ## aborted connection case
- warn "Connection is closed" if $verbose;
+ $self->log(LOG_WARN, "Connection is closed");
+ return OK;
}
-sub print_headers {
+## the HTML page that a regular browser will see
+sub serve_browser_request {
my $self = shift;
-
- my $r = $self->{'r'};
- $r->assbackwards(1); ## we will print all headers ourselves
- $r->print("ICY 200 OK\r\n");
- $r->print("icy-name:LiveJournal Voice Posts\r\n");
- $r->print("icy-genre:voice\r\n");
- $r->print("icy-br:128\r\n");
- $r->print("icy-metaint:$self->{block_size}\r\n");
- $r->print("\r\n");
-
- $r->log_reason("Headers are printed")
- if $self->{'verbose'} > 1;
+
+ my $r = $self->{'r'};
+ my $files = join("\n", map { "<li><a href='$_'>$_</a>" } $self->get_list_of_files('recursive' => 1));
+ $r->content_type("text/html");
+ $r->print(<<"HTML");
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" lang="en" xml:lang="en">
+<head>
+ <title>Frank Radio</title>
+ <meta http-equiv="X-UA-Compatible" content="IE=7" />
+ <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
+ <link href="http://l-stat.livejournal.com/framework/error-pages.css" rel="stylesheet" type="text/css" />
+ <!--[if lte IE 7]><link rel="stylesheet" href="http://l-stat.livejournal.com/framework/error-pages-ie.css"><![endif]-->
+</head>
+<body class="error-page">
+<div class="header">
+ <img src="http://l-stat.livejournal.com/img/error-pages/frank-200.png" width="250" height="260" alt="" class="pic" />
+ <div class="desc">
+ <h1>Frank Radio</h1>
+ <p>Welcome! This page is best seen (well, listened) in audio player that support streams, e.g. iTunes, WinAmp or Microsoft Media Player - just enter the URL and listent to voice posts created by LJ users.</p>
+ <p>If you use regular browser and see this text, you may download/play these posts individually:</p>
+ </div>
+</div>
+<div class="content">
+ <div class="article">
+ <ul>
+ $files
+ </ul>
+ </div>
+ <div class="searchbar">
+ <h3><a href="http://www.livejournal.com">LiveJournal</a></h3>
+ </div>
+</div>
+</body>
+</html>
+HTML
+ return OK;
}
+##
+## input: hash of named options (dir, absolute_path, recursive)
+## output: array of filenames
+##
sub get_list_of_files {
my $self = shift;
+ my %opts = @_;
- my $dir = $self->{'data_dir'};
- my $d = IO::Dir->new($dir);
- return unless $d;
- my @files = map {"$dir/$_" } grep { $_ =~ /\.mp3$/ } $d->read;
+ my $absolute_path = delete $opts{'absolute_path'};
+
+ my $dir = $opts{'dir'} || $self->{'r'}->filename;
+ $dir =~ s/\/$//;
+
+ die "$dir is not directory!"
+ unless -d $dir;
+
+ my (@subdirs, @files);
+ my $d = IO::Dir->new($dir)
+ or die "Can't open dir '$dir': $!";
+ while (my $f = $d->read) {
+ next if $f =~ /^\./;
+ if (-d "$dir/$f") {
+ push @subdirs, $f if -r "$dir/$f";
+ } elsif ($f =~ /\.mp3/i) {
+ push @files, $f;
+ }
+ }
close $d;
+
+ if ($opts{'recursive'}) {
+ foreach my $subdir (@subdirs) {
+ push @files, map { "$subdir/$_" } $self->get_list_of_files(%opts, 'dir' => "$dir/$subdir");
+ }
+ }
+
+ if ($absolute_path) {
+ @files = map { "$dir/$_" } @files;
+ }
+
return @files;
}
+sub log {
+ my $self = shift;
+ my $level = shift;
+ my $msg = shift;
+
+ if ($self->{'verbose'}>=$level) {
+ warn("[$$] $msg");
+ }
+}
+
+package LJ::Radio::FileIterator;
+
+sub new {
+ my $class = shift;
+ my $lj_radio = shift;
+
+ return bless {
+ lj_radio => $lj_radio,
+ palyed_files => {},
+ }, $class;
+}
+
+sub get_next_file {
+ my $self = shift;
+
+ ## choose a file
+ my @files = $self->{'lj_radio'}->get_list_of_files('absolute_path' => 1, 'recursive' => 1);
+ return unless @files;
+
+ my @non_played_files = grep { !$self->{'played_files'}->{$_} } @files;
+ my $list = (@non_played_files) ? \@non_played_files : \@files;
+ my $file = $list->[ rand(scalar @$list) ];
+ $self->{'played_files'}->{$file}++;
+ return $file;
+}
+
1;
