Beefy Boxes and Bandwidth Generously Provided by pair Networks Bob
The stupid question is the question not asked

Comment on

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 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 = ?"); $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 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

In reply to Re: MP3 server with IO::Socket by Ryszard
in thread MP3 server with IO::Socket by perlmonkey

and:  <code> code here </code>

  • Please read these before you post! —
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Log In?

    What's my password?
    Create A New User
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others chilling in the Monastery: (5)
    As of 2014-03-17 04:39 GMT
    Find Nodes?
      Voting Booth?

      Have you used a cryptocurrency?

      Results (340 votes), past polls