Foro - Perl en Español

#!/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/explorer/Documents/Musica/Agua';
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__