Foro - Perl en Español

sub generador() {

        use Data::Dumper::Names;
        use File::Find::Rule;
        use File::Basename;
        use strict;
       
       
       
        #my $directorio = 'C:\\Documents and Settings\\user\\Mis documentos\\Mi música\\';
        #chdir $directorio;
        my $dir='C:\\Documents and Settings\\user\\Mis documentos\\Mi música\\';
        my @tema;
        my $midato;
        if (opendir(DIR,"$dir")){
       
        @tema=readdir(DIR);
        close DIR;
        foreach (@tema){  
   # ignorar . y .. :  EN EL LINUX EL . .  ERA UN ENLACE SIMBOLICO Y EL . INDICABA  QUE SE TRATABA DE UN DIRECTORIO SERIA ASI ??????
   
   #$_ PERL CREA ESTA VARIABLE DE BUCLE AUTOMATICAMENTE
        next if ($_ eq "." || $_ eq "..");  
        if (/$ARGV[0]/io){  
        print "$dir/$_\n";  
        }  
        generador("$dir/$_") if (-d "$dir/$_" && ! -l "$dir/$_");  
        }        
        }else{  
        print "ERROR: no se puede leer el directorio $dir\n";  
        }
        # @temas = splice (@tema);
        my @temas;
        my $n;
        my $ind;
        $ind = 0;
        for ($n = 0; $n < @tema; $n++) {
        #
        #
        #COMO HAGO PARA COMPARA SI EL TEMA TIENE EL .MP3 Y LO GUARDO EN EL NUEVO ARRAY, CON LA PREGUNTA QUE LE CLAVE EN MI DATO ESTA BIEN ??????? YO NO LO PUEDO PROBAR
        if ( $tema[$n] &&( #  ASI $midato=~/\.mp3$/  O ASI  pff \'\\.mp3\'  )) {
        $ind++;
        $temas [$ind] = $tema[$n];
        }      
        else {
       
        }
        }
        return (@temas);
       
}

if ($tema =~m/\.mp3/){

sub generador() {
        my $tmp;
        my $tmpdir;
        $tmpdir = "C:\\Documents and Settings\\user\\Mis documentos\\Mi música\\";
        #my $tmpdir = shift;
        my @list;
        my @tmp2;
        my $a;
        my $arreglo;
        print "Hola/....\n";
        opendir(DIR,$tmpdir) or die "No existe el dir";
        $a=readdir(DIR);
    while (defined $a){
                $tmp=$tmpdir."".$a;
                #Pregunto si es directorio y si es verdad vuelvo a llamar a la funcion ESTO DE LA RECURSIVIDAD NO ME ANDA AYUDA????????
                #if (-d $tmp) {
                #@tmp2 = generador($tmp);
                #push (@list,@tmp2);
                #}
                #Pregunto si es archivo y si lo es  si su extension es .mp3 y le hago un push
                if ((-f $tmp) && ($tmp=~/\.mp3$/ ) || ($tmp=~/\.MP3$/ ) || ($tmp=~/\.Mp3$/ )) {
                push (@list,$tmp);
                }
                 $a=readdir(DIR);
        }
       
        close(DIR);
               
        return(@list);
}      

 

sub escuchando {
        #my $dir1='C:\\Documents and Settings\\user\\Mis documentos\\Mi música\\';
        my @songs;
    my $socket = shift;
  #levanto la lista
    my $dir = 'C:\\servidor streaming\\guns hits\\';
    chdir $dir;
        my $bol;
    if (open (PLAYLIST, "lis.m3u")) {
        open (PLAYLIST, "lis.m3u");
        @songs =<PLAYLIST>;
        shift @songs;
        close (PLAYLIST);
        }
        else {
        @songs = generador();
        shift @songs;
        }
       
    #creo un loop eterno hasta que el cliente deje de escuchar
 my $indice;
        for ($indice = 0; $indice < @songs; $indice++) {
       
        #Mandar el header necesario
                print $socket "HTTP/1.0 200 OK\n";
                print $socket "Content-Type: text/html\n";
                print $socket "Cache-Control: no-cache \n";
                print $socket "Pragma: no-cache \n";
                print $socket "Connection: close \n";
                print $socket "Aplication: The best of the Reproducer\n\n";

        #seleccionar una cancion aleatoria de tu lista
                my $song = $songs[rand @songs];

        #que cancion estamos tocando
        warn ( "play song: $song\n");

        #abrir la cancion o intentar con otra
        open (SONG, $song) || next;
        binmode(SONG);
                #para usuarios de windows
        my $read_status = 1;
        my $print_status = 1;
        my $chunk;

        #Esta parte imprime el binario al socket
        #Lo hace lo mas rapido posible
        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);
        }
    }
       
}