[livejournal] r17421: New version of LJ::Radio

U   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;