buenas,

Estaba googleando cuando me he encontrado un servidor de mp3 en perl. Y probando probando me he hecho un autoDJ para icecast la mar de chulo y sin soltar un céntimo.

el truco es sencillo, ojito gente de la venta de stream, que si lo haceis bien y lo mejorais, os ahorrais el centovacast, un poquito de php y algo de shell script por detrás y andando...

La idea es hacer el servidor con una playlist de la cual pillará la música, y hacer un relay con icecast, de forma que si no emite nadie por /live, /stream se redirija a la conexión adecuada...

si soys vendedores de streaming se supone que estas cosas las controlais, así que os dejo el código por aquí para montar el servidor de mp3 en perl.

!/usr/bin/perl

#

Servidor de Sonido en MP3

Joaquín Ferrero. Septiembre 2006

#

Versión

1.0           - 2006/09/12 - Primera versión

1.1      - 2006/09/16 - Añadido lapso de espera para no saturar

                        Definido tiempo de timeout del cliente

#

Bibliotecas #############################################################

use IO::Socket;

use warnings;

use strict;

Configuración ###########################################################

my $mp3_path = '/home/BOFHVirtualTest/Documents/Music/test';
my $size_buffer = 10240;    # Parte de música enviada cada vez
my $miport      = 8000;     # Puerto por defecto

Fin configuración #######################################################

Variables y constantes ##################################################

my $port = $ARGV[0] || $miport;    # Puerto a controlar o usamos el de por defecto
$SIG{CHLD} = 'IGNORE';             # Ignorar procesos hijos para evitar zombies
$|++;                              # No buffer de salida

Programa ################################################################

Crear el socket a escuchar

my $listen_socket = IO::Socket::INET->new(
    LocalPort => $port,
    Listen    => 10,
    Proto     => 'tcp',
    Reuse     => 1,
);
die "No puedo crear el socket escuchante: $@" unless $listen_socket;

Aviso

warn "Servidor preparado. Esperando conexiones en puerto $port ... \n";

Esperar conexiones

while ( my $connection = $listen_socket->accept ) {
    my $child;

    ## Crear el fork o salimos
    die "No puedo hacer fork!: $!" unless defined( $child = fork() );

    ## El proceso es el siguiente:
    # * El padre simplemente termina la conexión y regresa a escuchar otra
    # * Mientras, el hijo se dedica a reproducir música mientras haya conexión

    if ( $child == 0 ) {    # El hijo

        $listen_socket->close;    # Cerramos el puerto porque no vamos a
                                  # seguir escuchando

        play_songs($connection);  # Llamar a la función principal del hijo

        exit 0;                   # Si el hijo regresa salimos
    }

    else {                        # El padre

        # ¿Quién se conecto?
        warn "Conexión recibida desde ... ", $connection->peerhost, "\n";

        $connection->close();     # Cerramos la conexión
    }
}

Subrutinas ##############################################################

Reproduce canciones de forma aleatoria en el socket pasado como argumento

sub play_songs {

    my $socket = shift;
    $socket->timeout(10);

    # Lista de canciones vacía al principio
    my @songs = ();

    # Reproducimos música mientras el usuario siga conectado
    my $print_status = 1;
    while ( defined $print_status ) {

        # Si no tenemos lista de canciones generamos una nueva
        @songs = genera_lista() unless @songs;

        # Sacamos una canción de la lista
        my $song = shift @songs;

        # Informar de la canción que estamos tocando
        warn "Tocando canción: $song\n";

        # Mandar la cabecera
        print $socket "HTTP/1.0 200 0k\n";
        print $socket "Content-Type: audio/x-mp3\n";
        print $socket "Cache-Control: no-cache \n";
        print $socket "Pragma: no-cache \n";
        print $socket "Connection: close \n";
        print $socket "Content-Length: ", -s $song, "\n";
        print $socket "x-audiocast-name: My MP3 Server\n";
        print $socket "x-audiocast-genre: Ambient/Chill Out\n";

      print $socket "x-audiocast-url: http://icecast.serv.dom/\n";

      print $socket "x-audiocast-streamid: \n";

        print $socket "x-audiocast-public: 1\n";

      print $socket "x-audiocast-bitrate: 24\n";

        print $socket "x-audiocast-description: served by Icecast\n";
        print $socket "\n";

 
        # Abrir la canción o intentar con otra
        open( SONG, $song )
          or warn "No pude abrir archivo $song: $!"
          and next;

        binmode(SONG);    # Siempre en modo binario

        my $read_status = 1;    # Estado de la lectura de la canción
        my $chunk;              # Buffer de lectura

        # Esta parte imprime el binario al socket
        # Lo hace lo más rápido posible
        while ( $read_status && $print_status ) {
            $read_status = read( SONG, $chunk, $size_buffer );

            if ( defined $chunk && defined $read_status ) {
                $print_status = print $socket $chunk;
                select(undef, undef, undef, 0.03);     # esperamos un poco
            }
        }

        close SONG;
    }
    warn "Fin de conexión\n";
    $socket->close();
}

Genera lista aleatoria de canciones disponibles

sub genera_lista {

    # Inicializamos la semilla de números aleatorios
    srand(time);

    # Lista de todas las canciones posibles
    chomp( my @canciones = <$mp3_path/*.mp3> );
    die "ERROR: ¡No hay canciones!" unless @canciones;

    # Generamos la lista de forma aleatoria
    # Lo que hacemos es un bucle tan largo como el largo del array @canciones
    # En cada iteración, sacamos un elemento de forma aleatoria de él
    # Y ese nuevo array es lo que devolvemos a la salida
    map { splice( @canciones, rand @canciones, 1 ) } 0 .. $#canciones;
}
__END__

Hola, respecto a este código, tengo que decir de ante mano que no se programar en perl, solo php y javascript,
aunque por los conocimientos que ya se tienen no resulta para nada extraño.
Me surge un interrogante, y es porqué usar un sistema en perl si ya contamos con Ices, aunque claro, todas las alternativas son válidas, y claro, me entra mucha curiosidad por aprender.
Es más, voy a probarlo, de todo se puede aprender mucho, todo depende de cuanto interés se le ponga. Muchas gracias BOFH por tu aporte!

No lo se, lo encontré por ahí y decidí usarlo para eso. El objetivo principal no era hacer un autodj, lo programó un señor para escuchar música en la empresa.