I've just added a web based playlist configurator to it... :-)
Pretty much via a web page you create a playlist and store it in an array (a fully qualified mp3 name per element)
I've then frozen the array with Storable.pm and stored it in a postgres database.
#!/usr/bin/perl -w
use strict;
use IO::Socket;
use MIME::Base64;
use DBI;
use Data::Dumper;
use Storable qw/freeze thaw/;
#get the port to bind to or default to 8000
my $port = $ARGV[0] || 8000;
#ignore child processes to prevent zombies
$SIG{CHLD} = 'IGNORE';
#create the listen socket
my $listen_socket = IO::Socket::INET->new(LocalPort => $port,
Listen => 10,
Proto => 'tcp',
Reuse => 1);
open (PIDFILE, '>'.$0.'.pid');
print PIDFILE $$;
close PIDFILE;
#make sure we are bound to the port
die "Cant't create a listening socket: $@" unless $listen_socket;
warn "Server ready. Waiting for connections ... \n";
my (@auth, @ary, $buf);
#wait for connections at the accept call
while (my $connection = $listen_socket->accept)
{
my $child;
# perform the fork or exit
die "Can't fork: $!" unless defined ($child = fork());
if ($child == 0)
{ #i'm the child!
$connection->recv($buf, 1024);
@ary = split(/0d0a/,unpack("H*",$buf) );
foreach (@ary){
my $line = pack("H*", $_);
@auth = split(/ /,$line ) if ($line =~ /^Auth/);
} #close the child's listen socket, we dont need it.
$listen_socket->close;
#call the main child rountine
play_songs($connection,\@auth);
#if the child returns, then just exit;
undef $kids{$child};
exit 0;
}
else
{ #i'm the parent!
$kids{$child} = 1;
#who connected?
warn "Connecton recieved ... ",$connection->peerhost,"\n";
#close the connection, the parent has already passed
# it off to a child.
$connection->close();
}
#go back and listen for the next connection!
}
sub play_songs
{
my $socket = shift;
my $ary = shift;
my @songs;
#get all the possible songs
if ($#{$ary} == -1) {
#get default playlist
local*PLAYLIST;
open PLAYLIST, "playlist.m3u" or die;
@songs = <PLAYLIST>;
close PLAYLIST;
chomp @songs;
} else {
my @user = split(/\:/,decode_base64(@{$ary}[$#{$ary}]) );
@songs = &get_db_playlist(name=>$user[0]);
}
#seed the rand number generator
srand(time / $$);
#loop forever (or until the client closes the socket)
while()
{
#print the HTTP header. The only thing really necessary
# is the first line and the trailing "\n\n"
# depending on your client (like xmms) you can also
# send song title etc.
print $socket "HTTP/1.0 200 OK\n";
print $socket "Content-Type: audio/x-mp3stream\n";
print $socket "Cache-Control: no-cache \n";
print $socket "Pragma: no-cache \n";
print $socket "Connection: close \n";
print $socket "x-audiocast-name: My MP3 Server\n\n";
#get a random song from your playlist
my $song = $songs[ rand @songs ];
#what song are we playing
warn( "play song: $song\n");
#open the song, or continue to try another one
open (SONG, $song) || next;
binmode(SONG); #for windows users
my $read_status = 1;
my $print_status = 1;
my $chunk;
# This parts print the binary to the socket
# as fast as it can. The buffering will
# take place on the client side (it blocks when full)
# because this is *not* non-blocking IO
#
#the read will return 0 if it has reached eof
#
#the print will return undef if it fails
# (ie the client stopped listening)
#
while( $read_status && $print_status ) {
$read_status = read (SONG, $chunk, 1024);
if( defined $chunk && defined $read_status)
{
$print_status = print $socket $chunk;
}
undef $chunk;
}
close SONG;
unless( defined $print_status )
{
$socket->close();
exit(0);
}
}
}
sub get_db_playlist {
my %user = @_;
my ($dbh, $sth, @ary);
$dbh = DBI->connect('DBI:Pg:dbname=infomgr', <name> , <passwd>, {
+RaiseError => 1, AutoCommit => 0 })
|| die "could not connect to database: ".$dbh->errstr;;
$sth = $dbh->prepare("SELECT a.playlist from playlist a, users b w
+here b.name = ?");
$sth->execute($user{name});
@ary = $sth->fetchrow_array;
$sth->finish;
$dbh->disconnect;
if ($dbh->errstr) {warn "Error getting playlist: ".$dbh->errstr };
my $retval = thaw(pack("H*", @ary) );
return @{$retval};
}
The database table structure is very simple. I have a table of users and a table of playlists. the playlist data comes from a web page where the list songs are stored in an array which is packed and frozen (using Storable.pm) It should be simple enuff to reverse, however if you want me to post the code, let me know.
The only thing i havent handled is a non existant name in the database. It should choose a default playlist, but it just bombs out now.
Not the most stylish code for the additions, but it works .. :-)
the usage via xmms is http://username:password@machine:port
My next task is to provide handling of the above scenario, and run it via init.d
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.