Ya que estás aprendiendo Perl, te recomiendo que no uses el módulo Switch.

Siempre ha tenido errores. En estos momentos, marca que sólo tiene 4 errores denunciados, pero seguro que tiene más.

Fíjate lo que dice en su descripción:

Switch - A switch statement for Perl, do not use if you can use given/when

"No lo uses si puedes usar given/when".

given/when forma parte de los nuevos intérpretes de Perl, desde la versión v5.10. Para hacer uso de él (si tienes un Perl moderno), te vale con poner al principio del programa

use v5.10;

o también

use feature 'switch';

(Tienes más información sobre esto en perldoc perlsyn. Busca por la sección Switch statements)


La comparación de caracteres, efectivamente se hace con 'eq', pero... no te funciona porque en la línea 59, al leer desde el teclado, estás incluyendo el carácter de nueva línea (cuando el usuario pulsa la tecla de Entrar o Retorno).

Antes de hacer la comparación, debes asegurarte de que has eliminado esos caracteres, y sólo te quedas con la opción que el usuario ha elegido. Para ello, usa la función chomp(). Quedaría así:

				 $opcion = <stdin>;
                                 chomp $opcion;		# quitar caracteres de nueva línea

Los caracteres '0D' podrían ser los caracteres de Retorno de carro, en el sistema operativo Windows, o Nueva línea, en los Mac OS.

El programa hace una copia literal del archivo, así que los caracteres '0D' deberías verles también en el archivo original.

Si solo quieres eliminar los caracteres '0D', lo que puedes hacer es filtrarles:

$file_contents =~ s/\0x0D//g;

Pero lo mejor sería saber el formato del archivo de origen, para hacer una conversión más correcta.

Saludos desde Perl en Español.

¡Ah!, quizás el problema sea

if($fondo ne "Login failed"){


Es casi seguro que $fondo contengo algo más que "Login failed".

Quizás con una expresión regular...

if ($fondo !~  /Login failed/) {

Otro detalle: mueve el $i++ a la primera parte del if(), no al else{}.

Después del $i++; pon un

last;

¡Buen aporte!

Esta es otra versión, un poco más corta...

#!/usr/bin/perl
use Mojo::UserAgent;         # Nuestro agente
use utf8::all;               # Las salidas y entradas serán en utf-8
 
$ua = Mojo::UserAgent->new(name => 'Mozilla/5.0', request_timeout => 5);
 
print "\n\n-- == Buscador de sueños == --\n\n";
print '[+] Palabra : '; $_ = <>; chomp;
 
print $ua->get("http://www.mis-suenos.org/interpretaciones/buscar?text=$_")->res->dom("li")->first->text;
 
print "\n\n(C) Doddy Hackman 2012\n\n"; <>;
 

El segundo código, si solo consiste en recorrer los valores numéricos entre 00000 y el 99999, vale ponerlo como

#!/usr/bin/perl
open my $FILEHANDLE, ">>", "wpakey-jazztel.txt"  or  die 'cannot open file!';
 
for my $WAP_KEY ( "00000" .. "99999" ) {
    print $FILEHANDLE $WAP_KEY , "\n";
}
 
close $FILEHANDLE;

Además, dejamos fuera del bucle las sentencias open() y close(), por lo que se ejecutará mucho más rápido.

En el primer código hay un error: falta la 'P'. Y es demasiado largo para lo que se quiere hacer.

Esta es una versión un poco más corta:

#!/usr/bin/perl
use Modern::Perl '2012';
use autodie;
use Algorithm::Combinatorics 'variations_with_repetition';
 
my @data = ( 'A' .. 'Z', '0' .. '9');
 
my $iterador = variations_with_repetition(\@data, 16);
 
open $fh, '>', 'fichero_wpakey.txt';
 
while (my $v = $iterador->next) {
    say $fh @{$v};
}
 
close $fh;
 

P.D.: El fichero resultante es realmente grande... 36^16 = 7,95866111 × 10²⁴. Ocho cuatrillones de claves... Dudo mucho que se pueda generar un archivo de 135 yottabytes, en un ordenador casero... 

Ahora estoy un poco dormido, pero creo que la solución es esta:

my $visto;
 
for my $a1 (1 .. 20) {
    for my $a2 (1 .. 20) {
        for my $a3 (1 .. 20) {
            for my $a4 (1 .. 20) {
 
                my @ordenados = sort { $a <=> $b } $a1, $a2, $a3, $a4;
 
                # salimos si hay coincidencia
                next if $ordenados[0] == $ordenados[1]
                     or $ordenados[0] == $ordenados[2]
                     or $ordenados[0] == $ordenados[3]
                     or $ordenados[1] == $ordenados[2]
                     or $ordenados[1] == $ordenados[3]
                     or $ordenados[2] == $ordenados[3]
                ;
 
                # salimos si hay coincidencia por pares
                next if $visto{"$ordenados[0]-$ordenados[1]"}
                     or $visto{"$ordenados[0]-$ordenados[2]"}
                     or $visto{"$ordenados[0]-$ordenados[3]"}
                     or $visto{"$ordenados[1]-$ordenados[2]"}
                     or $visto{"$ordenados[1]-$ordenados[3]"}
                     or $visto{"$ordenados[2]-$ordenados[3]"}
                ;
 
                # recordamos todos los pares nuevos
                $visto{"$ordenados[0]-$ordenados[1]"} =
                $visto{"$ordenados[0]-$ordenados[2]"} =
                $visto{"$ordenados[0]-$ordenados[3]"} =
                $visto{"$ordenados[1]-$ordenados[2]"} =
                $visto{"$ordenados[1]-$ordenados[3]"} =
                $visto{"$ordenados[2]-$ordenados[3]"} = 1;
 
                # Impresión
                print "[", join('-', @ordenados), "]\n";
            }
        }
    }
}

La salida es algo corta:
[1-2-3-4]
[1-5-6-7]
[1-8-9-10]
[1-11-12-13]
[1-14-15-16]
[1-17-18-19]
[2-5-8-11]
[2-6-9-12]
[2-7-10-13]
[2-14-17-20]
[3-5-9-13]
[3-6-8-14]
[3-7-11-15]
[3-10-12-16]
[4-5-10-14]
[4-6-11-16]
[4-7-8-12]
[4-9-15-17]
[4-13-18-20]
[5-12-15-18]
[5-16-19-20]
[6-10-15-19]
[7-9-14-18]
[8-13-16-17]

Curiosamente, el alumno 1 nunca estará con el número 20. ¿Por qué?
Supongamos que queremos la combinación [1-a-b-20]. ¿Qué valores serían a o b?. Pues cualquiera entre 2 y 19... pero eso no es posible, porque todos los números entre 2 y 19 ya han salido con el 1 antes (mirar las 6 primeras combinaciones). Y se cumpliría la condición de que el 1 ya se ha visto con cualquiera de esos números.

Me temo que esto no es lo que quieres...

Según las condiciones que has puesto, la segunda es la que limita la salida de todas las combinaciones: «tampoco me valdría otra donde volvieran a coincidir dos variables o más...». Como los grupos son de 4, eso quiere decir que habrá alumnos que estarán en más combinaciones (el 1, seis veces), pero otras, menos (el 20, tres veces) por la razón explicada antes.

Ya que lo vas a ejecutar en Codepad, prueba esta versión:

#!/usr/bin/perl
use strict;
use warnings;
 
my $alumnos = 20;                    # Número de alumnos
my $grupos  = 4;                     # Tamaño de los grupos
 
my @alumnos = 1 .. $alumnos;
my $n_grupo = 1;
 
while (@alumnos >= $grupos) {
 
    # Creamos un @nuevo_grupo compuesto de tantos alumnos como de grande
    # sean los $grupos, elegidos al azar de los @alumnos restantes
    my @nuevo_grupo = map { splice @alumnos, rand(@alumnos), 1 } 1 .. $grupos;
 
    print "Grupo $n_grupo: [@nuevo_grupo]\n";
 
    $n_grupo++;
}
 
# Resto que ha quedado sin asignar
if (@alumnos) {
    print "Grupo $n_grupo: [@alumnos]\n";
}
 

Ya está cambiado para los Perl antiguos.

Esta es mi versión:

#!/usr/bin/perl
use strict;
use warnings;
 
print "Número de alumnos: ";
my $alumnos = <>;
 
print "Tamaño de los grupos: ";
my $grupos  = <>;
 
my @alumnos = 1 .. $alumnos;
my $n_grupo = 1;
 
while (@alumnos >= $grupos) {
 
    # Creamos un @nuevo_grupo compuesto de tantos alumnos como de grande
    # sean los $grupos, elegidos al azar de los @alumnos restantes
    my @nuevo_grupo = map { splice @alumnos, rand(@alumnos), 1 } 1 .. $grupos;
 
    print "Grupo $n_grupo: [@nuevo_grupo]\n";
 
    $n_grupo++;
}
 
# Resto que ha quedado sin asignar
if (@alumnos) {
    print "Grupo $n_grupo: [@alumnos]\n";
}
 
__END__
Número de alumnos: 23
Tamaño de los grupos: 4
Grupo 1: [23 1 3 7]
Grupo 2: [14 20 13 22]
Grupo 3: [15 8 10 6]
Grupo 4: [4 12 18 11]
Grupo 5: [21 17 5 2]
Grupo 6: [9 16 19]