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;