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]

Para que LWP pueda acceder con el protocolo HTTPS, debe estar instalado el módulo LWP::Protocol::https .