* Move files to trunk

1 files changed, 727 insertions, 0 deletions

diff --git a/lib/MP3/Icecast.pm b/lib/MP3/Icecast.pm
new file mode 100644
index 0000000..729e959
--- /dev/null
+++ b/lib/MP3/Icecast.pm
@@ -0,0 +1,727 @@
+package MP3::Icecast;
+
+=head1 NAME
+
+MP3::Icecast - Generate Icecast streams, as well as M3U and PLSv2 playlists.
+
+=head1 SYNOPSIS
+
+  use MP3::Icecast;
+  use MP3::Info;
+  use IO::Socket;
+
+
+  my $listen_socket = IO::Socket::INET->new(
+    LocalPort => 8000, #standard Icecast port
+    Listen    => 20,
+    Proto     => 'tcp',
+    Reuse     => 1,
+    Timeout   => 3600);
+
+  #create an instance to find all files below /usr/local/mp3
+  my $finder = MP3::Icecast->new();
+  $finder->recursive(1);
+  $finder->add_directory('/usr/local/mp3');
+  my @files = $finder->files;
+
+  #accept TCP 8000 connections
+  while(1){
+    next unless my $connection = $listen_socket->accept;
+
+    defined(my $child = fork()) or die "Can't fork: $!";
+    if($child == 0){
+      $listen_socket->close;
+
+      my $icy = MP3::Icecast->new;
+
+      #stream files that have an ID3 genre tag of "jazz"
+      while(@files){
+        my $file = shift @files;
+        my $info = new MP3::Info $file;
+        next unless $info;
+        next unless $info->genre =~ /jazz/i;
+        $icy->stream($file,0,$connection);
+      }
+      exit 0;
+    }
+
+    #a contrived example to demonstrate that MP3::Icecast
+    #can generate M3U and PLSv2 media playlists.
+    print STDERR $icy->m3u, "\n";
+    print STDERR $icy->pls, "\n";
+
+    $connection->close;
+  }
+
+
+=head1 ABSTRACT
+
+MP3::Icecast supports streaming Icecast protocol over socket
+or other filehandle (including STDIN).  This is useful for writing
+a streaming media server.
+
+MP3::Icecast also includes support for generating M3U and PLSv2
+playlist files.  These are common formats supported by most modern
+media players, including XMMS, Windows Media Player 9, and Winamp.
+
+=head1 SEE ALSO
+
+  The Icecast project
+  http://www.icecast.org
+
+  Namp! (Apache::MP3)
+  http://namp.sourceforge.net
+
+  Unofficial M3U and PLS specifications
+  http://forums.winamp.com/showthread.php?threadid=65772
+
+=head1 AUTHOR
+
+ Allen Day, E<lt>allenday@ucla.eduE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2003, Allen Day
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+use strict;
+use File::Spec;
+use File::Basename 'dirname','basename','fileparse';
+use URI::Escape;
+use IO::File;
+use MP3::Info;
+
+use constant DEBUG => 0;
+
+our $VERSION = '0.02';
+
+our %AUDIO = (
+               '.mp3' => 'audio/x-mp3',
+             );
+our %FORMAT_FIELDS = (
+                      a => 'artist',
+                      c => 'comment',
+                      d => 'duration',
+                      f => 'filename',
+                      g => 'genre',
+                      l => 'album',
+                      m => 'min',
+		              n => 'track',
+                      q => 'samplerate',
+		              r => 'bitrate',
+		              s => 'sec',
+		              S => 'seconds',
+		              t => 'title',
+		              y => 'year',
+		                );
+
+
+our $CRLF = "\015\012";
+
+=head2 new
+
+ Title   : new
+ Usage   : $icy = MP3::Icecast->new(%arg);
+ Function: create a new MP3::Icecast instance
+ Returns : an MP3::Icecast object
+ Args    : none
+
+
+=cut
+
+sub new{
+  my($class,%arg) = @_;
+
+  my $self = bless {}, $class;
+
+  return $self;
+}
+
+=head2 add_directory
+
+ Title   : add_directory
+ Usage   : $icy->add_directory('/usr/local/mp3');
+ Function: add a directory of files to be added to the playlist
+ Returns : true on success, false on failure
+ Args    : a system path
+
+
+=cut
+
+sub add_directory{
+   my ($self,$dir) = @_;
+   warn "adding directory $dir" if DEBUG;
+   if(!-d $dir or !-r $dir){
+     return undef;
+   } else {
+     $self->_process_directory($dir);
+     return 1;
+   }
+}
+
+=head2 _process_directory
+
+ Title   : _process_directory
+ Usage   : $icy->_process_directory('/usr/local/mp3');
+ Function: searches a directory for files to add to the playlist
+ Returns : true on success
+ Args    : a system path to search for files
+
+
+=cut
+
+sub _process_directory{
+   my ($self,$dir) = @_;
+
+   if(!-r $dir){
+     return undef;
+   } else {
+     warn "processing directory: $dir" if DEBUG;
+
+     opendir(my $d, $dir) or die "couldn't opendir($dir): $!";
+     my @dirents = grep {$_ ne '.' and $_ ne '..'} readdir($d);
+     closedir($d) or die "couldn't closedir($dir): $!";
+
+     foreach my $dirent (@dirents){
+       warn "found dirent: $dirent" if DEBUG;
+
+       next if !-r File::Spec->catfile($dir,$dirent);
+       if(-d File::Spec->catfile($dir,$dirent)){
+         next unless $self->recursive;
+         $self->_process_directory(File::Spec->catdir($dir,$dirent));
+       } else {
+         $self->add_file(File::Spec->catfile($dir,$dirent));
+       }
+     }
+   }
+
+   return 1;
+}
+
+
+=head2 add_file
+
+ Title   : add_file
+ Usage   : $icy->add_file('/usr/local/mp3/meow.mp3')
+ Function: add a file to be added to the playlist
+ Returns : true on success, false on failure
+ Args    : a system path
+
+
+=cut
+
+sub add_file{
+   my ($self,$file) = @_;
+
+   my(undef,undef,$extension) = fileparse($file,keys(%AUDIO));
+   warn "adding file $file" if DEBUG;
+   warn $extension if DEBUG;
+
+   if(!-f $file or !-r $file){
+     warn "not a readable file: $file" if DEBUG;
+     return undef;
+   } elsif($AUDIO{lc($extension)}) {
+     warn "adding $file" if DEBUG;
+     push @{$self->{files}}, $file;
+   } else {
+     warn "not a usable mimetype: $file" if DEBUG;
+     return undef;
+   }
+
+   return 1;
+}
+
+=head2 files
+
+ Title   : files
+ Usage   : @files = $icy->files
+ Function: returns a list of all files that have been added
+           from calls to add_file() and add_directory()
+ Returns : a list of files
+ Args    : none
+
+
+=cut
+
+sub files{
+  my $self = shift;
+
+  if(defined($self->{files})){
+    if($self->shuffle){
+      for (my $i=0; $i<@{$self->{files}}; $i++) {
+        my $rand = rand(scalar @{$self->{files}});
+
+        #swap;
+        ($self->{files}->[$i],$self->{files}->[$rand])
+          =
+        ($self->{files}->[$rand],$self->{files}->[$i]);
+      }
+    }
+
+    return @{$self->{files}};
+
+  } else {
+    return ();
+  }
+
+}
+
+=head2 clear_files
+
+ Title   : clear_files
+ Usage   :
+ Function:
+ Example :
+ Returns :
+ Args    :
+
+
+=cut
+
+sub clear_files{
+   my ($self) = @_;
+   $self->{files} = undef;
+   return 1;
+}
+
+=head2 m3u
+
+ Title   : m3u
+ Usage   : $m3u_text = $icy->m3u
+ Function: generates an Extended M3U string from the
+           contents of the list returned by files().
+           files not recognized by MP3::Info are
+           silently ignored
+ Returns : a Extended M3U string
+ Args    : none
+
+
+=cut
+
+sub m3u{
+   my $self = shift;
+
+   my $output = undef;
+
+
+   # The extended format is:
+   #	#EXTM3U
+   #	#EXTINF:seconds,title - artist (album)
+   #	URL
+   # but apparently you can override with this
+   #	#EXTART:Britney Spears
+   #	#EXTALB:Oops!.. I Did It Again
+   #	#EXTTIT:Something or other
+   # and there doesn't seem to be a way to escape the -, so that's safer
+   # in theory, but if you send both it seems to ignore all but the EXTINF
+   # and there's no way to send seconds without it anyway, so we'll just do
+   # that.
+   #
+   # .... except that the second format breaks older versions of winamp
+   # so we'll use EXTINF only!
+
+   $output .= "#EXTM3U$CRLF" if $self->files;
+   foreach my $file ($self->files){
+     my $info = $self->_get_info($file);
+
+     next unless defined($info);
+     $file = $self->_mangle_path($file);
+
+     my $time   = $info->secs   || -1;
+     my $artist = $info->artist || 'Unknown Artist';
+     my $album  = $info->album  || 'Unknown Album';
+     my $title  = $info->title  || 'Unknown Title';
+
+     $output .= sprintf("#EXTINF:%d,%s - %s (%s)",$time,$title,$artist,$album) . $CRLF;
+     $output .= $file . $CRLF;
+   }
+
+   return $output;
+}
+
+=head2 pls
+
+ Title   : pls
+ Usage   : $pls_text = $icy->pls
+ Function: generates a PLSv2 string from the
+           contents of the list returned by files().
+           files not recognized by MP3::Info are
+           silently ignored.
+ Returns : a PLSv2 string
+ Args    : none
+
+
+=cut
+
+sub pls{
+   my $self = shift;
+
+   my $output = undef;
+
+   $output .= "[playlist]$CRLF" if $self->files;
+   my $c = 0;
+   foreach my $file ($self->files){
+     my $info = $self->_get_info($file);
+
+     next unless defined($info);
+
+     $c++;
+
+     $file = $self->_mangle_path($file);
+
+     my $time   = $info->secs   || -1;
+     my $artist = $info->artist || 'Unknown Artist';
+     my $album  = $info->album  || 'Unknown Album';
+     my $title  = $info->title  || 'Unknown Title';
+
+     $output .= uri_escape(sprintf("File%d=%s${CRLF}Title%d=%s - %s (%s)${CRLF}Length%d=%d$CRLF",$c,$file,$c,$title,$artist,$album,$c,$time));
+   }
+
+   $output .= "NumberOfEntries=$c$CRLF" if $self->files;
+   $output .= "Version=2$CRLF"          if $self->files;
+
+   return $output;
+}
+
+=head2 stream
+
+ Title   : streamll: 1 at /raid5a/allenday/projects/MP3/Icecast.pm line 459.
+
+ Usage   : $icy->stream('/usr/local/mp3/meow.mp3',0);
+           $icy->stream('/usr/local/mp3/meow.mp3',0,$io_handle);
+ Function: stream an audio file.  prints to STDOUT unless a
+           third argument is given, in which case ->print() is
+           called on the second argument.  An IO::Handle or
+           Apache instance will work here.
+ Returns : true on success, false on failure
+ Args    : 1) system path to the file to stream
+           2) offset in file to start streaming
+           3) (optional) object to call ->print() on, rather
+              than printing to STDOUT
+
+
+=cut
+
+sub stream{
+   my ($self,$file,$offset,$handle) = @_;
+
+   return undef unless -f $file;
+   my $info = $self->_get_info($file);
+   return undef unless defined($info);
+
+   my $genre = $info->genre                    || 'unknown genre';
+   my $description = $self->description($file) || 'unknown';
+   my $bitrate = $info->bitrate                || 0;
+   my $size = -s $file                         || 0;
+   my $mime = $AUDIO{ lc((fileparse($file,keys(%AUDIO)))[2]) };
+   my $path = $self->_mangle_path($file);
+
+   my $fh = $self->_open_file($file) || die "couldn't open file $file: $!";
+   binmode($fh);
+   seek($fh,$offset,0);
+
+   my $output = '';
+   $output .= "ICY ". ($offset ? 206 : 200) ." OK$CRLF";
+   $output .= "icy-notice1:<BR>This stream requires a shoutcast/icecast compatible player.<BR>$CRLF";
+   $output .= "icy-notice2:MP3::Icecast<BR>$CRLF";
+   $output .= "icy-name:$description$CRLF";
+   $output .= "icy-genre:$genre$CRLF";
+   $output .= "icy-url: $path$CRLF";
+   $output .= "icy-pub:1$CRLF";
+   $output .= "icy-br:$bitrate$CRLF";
+   $output .= "Accept-Ranges: bytes$CRLF";
+   if($offset){ $output .= "Content-Range: bytes $offset-" . ($size-1) . "/$size$CRLF" }
+   $output .= "Content-Length: $size$CRLF";
+   $output .= "Content-Type: $mime$CRLF";
+   $output .= "$CRLF";
+
+   if(!ref($handle)){
+     print $output;
+   } elsif($handle->can('print')) {
+     $handle->print($output);
+   } else {
+     return undef;
+   }
+
+   my $bytes = $size;
+   while($bytes > 0){
+     my $data;
+     my $b = read($fh,$data,2048) || last;
+     $bytes -= $b;
+
+     if(!ref($handle)){
+       print $data;
+     } else {
+       $handle->print($data)
+        or return undef;
+     }
+   }
+
+   return 1;
+}
+
+=head2 _open_file
+
+ Title   : _open_file
+ Usage   : $fh = $icy->open_file('/usr/local/mp3/meow.mp3');
+ Function:
+ Example :
+ Returns :
+ Args    :
+
+
+=cut
+
+sub _open_file{
+  my ($self,$file) = @_;
+
+  return undef unless $file;
+  return IO::File->new($file,O_RDONLY);
+}
+
+=head2 _mangle_path
+
+ Title   : _mangle_path
+ Usage   : $path = $icy->_mangle_path('/usr/local/mp3/meow.mp3');
+ Function: applies alias substitutions and prefixes to a system path.
+           this is intended to be used to create resolvable URLs.
+ Returns : a string
+ Args    : a system path
+
+
+=cut
+
+sub _mangle_path{
+   my ($self,$path) = @_;
+
+   my $qpath = quotemeta($path);
+
+   foreach my $alias ($self->alias){
+     warn "replacing $alias..." if DEBUG;
+     my $search = $alias;
+
+     my $qalias = quotemeta($alias);
+
+     next unless $path =~ /^$qalias/;
+
+     my $replace = $self->alias($alias);
+     $path =~ s/^$qalias/$replace/;
+     last;
+   }
+   $self->_uri_path_escape(\$path);
+   $path = join '', ($self->prefix ||'', $path ||'', $self->postfix ||'');
+   return $path;
+}
+
+=head2 _path_escape
+
+ Title   : _path_escape
+ Usage   :
+ Function:
+ Example :
+ Returns :
+ Args    :
+
+
+=cut
+
+sub _uri_path_escape{
+   my ($self,$uri) = @_;
+
+   $$uri =~ s!([^a-zA-Z0-9_/.-])!uc sprintf("%%%02x",ord($1))!eg;
+}
+
+
+=head2 _get_info
+
+ Title   : _get_info
+ Usage   : $mp3_info = $icy->_get_info($file)
+ Function: constucts and returns an MP3::Info object.  the intended
+           use here is to access MP3 metadata (from ID3 tags,
+           filesize, etc).
+ Returns : a new MP3::Info object on success, false on failure
+ Args    : a system path to a file
+
+
+=cut
+
+sub _get_info{
+   my ($self,$file) = @_;
+
+   return undef unless $file;
+   return new MP3::Info $file;
+}
+
+
+=head2 alias
+
+ Title   : alias
+ Usage   : #returns 1
+           $icy->alias('/home/allenday/mp3' => '/mp3');
+
+           #returns '/mp3'
+           $icy->alias('/home/allenday/mp3');
+
+           #returns 1
+           $icy->alias('/usr/local/share/mp3' => '/share/mp3'); #returns 1
+
+           #returns qw(/mp3 /share/mp3)
+           $icy->alias();
+ Function: this method provides similar behavior to Apache's Alias directive.
+           it allows mapping of system paths to virtual paths for usage by,
+           for instance, a webserver.  the mapping is simple: when examining
+           a file, MP3::Icecast tries to match the beginning of the file's
+           full path to a sorted list of aliases.  the first alias to match
+           is accepted.  this may cause unexpected behavior in the event that
+           a file's path matches multiple alias entries.  patches welcome.
+ Returns : see Usage
+ Args    : see Usage
+
+
+=cut
+
+sub alias{
+   my ($self,$search,$replace) = @_;
+
+   if(defined($search) and defined($replace)){
+     $self->{alias}{$search} = $replace;
+   } elsif(defined($search)) {
+     return $self->{alias}{$search};
+   } else {
+     return sort keys %{$self->{alias}};
+   }
+}
+
+=head2 prefix
+
+ Title   : prefix
+ Usage   : $icy->prefix('http://');
+ Function: prefix all entries in the playlist with this value.
+           this string is *not* uri or system path escaped.
+ Returns : value of prefix (a scalar)
+ Args    : on set, new value (a scalar or undef, optional)
+
+
+=cut
+
+sub prefix{
+    my $self = shift;
+
+    return $self->{'prefix'} = shift if @_;
+    return $self->{'prefix'};
+}
+
+=head2 postfix
+
+ Title   : postfix
+ Usage   : $obj->postfix($newval)
+ Function: postfix all entries in the playlist with this value.
+           this string is *not* uri or system path escaped.
+           uri escaped.
+ Returns : value of postfix (a scalar)
+ Args    : on set, new value (a scalar or undef, optional)
+
+
+=cut
+
+sub postfix{
+    my $self = shift;
+
+    return $self->{'postfix'} = shift if @_;
+    return $self->{'postfix'};
+}
+
+=head2 recursive
+
+ Title   : recursive
+ Usage   : $obj->recursive($newval)
+ Function: flag determining whether a directory is recursively
+           searched for files when passed to ::add_directory().
+           default is false (no recursion).
+ Example :
+ Returns : value of recursive (a scalar)
+ Args    : on set, new value (a scalar or undef, optional)
+
+
+=cut
+
+sub recursive{
+    my $self = shift;
+
+    return $self->{'recursive'} = shift if @_;
+    return $self->{'recursive'};
+}
+
+=head2 shuffle
+
+ Title   : shuffle
+ Usage   : $obj->shuffle($newval)
+ Function:
+ Example :
+ Returns : value of shuffle (a scalar)
+ Args    : on set, new value (a scalar or undef, optional)
+
+
+=cut
+
+sub shuffle{
+    my $self = shift;
+
+    return $self->{'shuffle'} = shift if @_;
+    return $self->{'shuffle'};
+}
+
+=head2 description
+
+ Title   : description
+ Usage   : $description = $icy->description('/usr/local/mp3/meow.mp3');
+ Function: returns a description string of an MP3.  this is extracted
+           from the ID3 tags by MP3::Info.  the description format can
+           be customized, see the description_format() method.
+ Returns : a description string
+ Args    : a valid system path
+
+
+=cut
+
+sub description{
+  my $self = shift;
+  my $file = shift;
+  my $data = new MP3::Info $file;
+  my $description;
+  my $format = $self->description_format;
+  if ($format) {
+    ($description = $format) =~ s{%([atfglncrdmsqS%])}
+      {$1 eq '%' ? '%'
+	 : $data->{$FORMAT_FIELDS{$1}}
+       }gxe;
+  } else {
+    $description = $data->{title} || basename($file, qw(.mp3 .MP3 .mp2 .MP2) );
+    $description .= " - $data->{artist}" if $data->{artist};
+    $description .= " ($data->{album})"  if $data->{album};
+  }
+  return $description;
+}
+
+=head2 description_format
+
+ Title   : description_format
+ Usage   : $icy->description_format($format_string)
+ Function:
+ Returns : value of description_format (a scalar)
+ Args    : on set, new value (a scalar or undef, optional)
+
+
+=cut
+
+sub description_format{
+    my $self = shift;
+
+    return $self->{'description_format'} = shift if @_;
+    return $self->{'description_format'};
+}
+1;