• Publicidad

Conteo while con ceros hacia la izquierda

¿Apenas comienzas con Perl? En este foro podrás encontrar y hacer preguntas básicas de Perl con respuestas aptas a tu nivel.

Conteo while con ceros hacia la izquierda

Notapor zkizzik » 2007-11-05 23:35 @024

Cómo puedo imprimir en pantalla la cuenta:

Código: Seleccionar todo
01
02
03...
50

001
002
003
...200

Lo que yo hago es:
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
my $inicio = 1; my $final = 50;
while ( $inicio1 <= $final ) { print $inicio; $inicio++; }
Coloreado en 0.004 segundos, usando GeSHi 1.0.8.4


Pero necesito los ceros.
zkizzik
Perlero nuevo
Perlero nuevo
 
Mensajes: 18
Registrado: 2007-10-15 18:26 @810

Publicidad

Notapor explorer » 2007-11-06 03:41 @195

Una solución sería poner los ceros al principio y luego, quitarlos.

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
$inicio = 1;
$final  = 50;
while ( $inicio <= $final ) {
    print substr( ('0' x 2) . $inicio, -2), "\n";
    $inicio++;
}
Coloreado en 0.002 segundos, usando GeSHi 1.0.8.4

Pero esto es dependiente del número de ceros que quisiéramos imprimir. Nos tendríamos que acordar de actualizar el 2 y el -2 si queremos pasar a otra banda de números.

Otra opción mejor es usar el printf:
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
$inicio = 1;
$final  = 200;
while ( $inicio <= $final ) {
    printf "%03d\n", $inicio;
    $inicio++;
}
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4

El formato indica que queremos imprimir un número decimal, de 3 posiciones como máximo, y relleno de ceros. Simple.

Y finalmente, la forma Perl...
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
for $i ( "000" .. "200" ) {
    print "$i\n";
}
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4

Tu eliges...
JF^D Perl programming & Raku programming. Grupo en Telegram: https://t.me/Perl_ES
Avatar de Usuario
explorer
Administrador
Administrador
 
Mensajes: 14480
Registrado: 2005-07-24 18:12 @800
Ubicación: Valladolid, España

Notapor zkizzik » 2007-11-06 17:30 @770

Muchas gracias... el último me ha servido de mucho. Al llamarlo desde una declaración como por ejemplo $cantidad = 001 tuve que hacerlo entre comillas; no se me había ocurrido; tampoco conocía esa forma de utilizar for.

Te dejo mi código para que los demás también puedan aprender...
Me gustó mucho poder conocer tu foto ^^

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
#!/usr/bin/perl -w
# - pvd.pl - PVideo Downloader V2.5 by WHK

#Variables y declaraciones ===============================================================#
my ($inicio_1, $inicio_2, $ruta, $video, $n_1, $n_2);                                     #
unless (@ARGV == 1) { die "uso: $0 [Cantidad de videos (0 = todos)]\n" } ($n_1) = @ARGV;  #
if ($n_1 == 0) { $n_1 = 1954601; }                                                        #
                                                                                          #
$n_2 = 1;                                                                                 #
$carpeta_1 = 'videos'; #Opcional                                                          #
$carpeta_2 = 1;                                                                           #
#=========================================================================================#

print "Iniciando descargas...\n";
system("mkdir $carpeta_1");

#=========================================INICIO DE DESCARGAS=======================================#
#Inicio ruta Nº1 http://free.sexbankroll.com/content/VDB00[01-49]/[1-x].wmv --------------:
$inicio_1 = "01"; $inicio_2 = 1; $ruta = "49"; $video = 1000; system("mkdir $carpeta_1/$carpeta_2");
for $i ( $inicio_1 .. $ruta ) {
    while ( $inicio_2 <= $video ) {
        if (-e "$carpeta_1/$carpeta_2/$inicio_2.wmv") {
            $inicio_2++;
        } else {
            system("wget -nd http://free.sexbankroll.com/content/VDB ... icio_2.wmv");
            if ($n_1 == $n_2) {
                exit(0);
            }
            if (-e "$carpeta_1/$carpeta_2/404.html") {
                unlink("$carpeta_1/$carpeta_2/404.html");
                if ($video == 1) {
                    $inicio_1 = $ruta;
                } else {
                    $inicio_2 = $video;
                }
            } else {
                system("mv $inicio_2.wmv $carpeta_1/$carpeta_2/$inicio_2.wmv");
                $n_2++; $inicio_2++;
            }
        }
    }
}
$carpeta_2++;
#Fin ruta Nº1 ----------------------------------------------------------------------------:

#Inicio ruta Nº2 http://free.sexbankroll.com/content/DB1[001-616]/[1-x].wmv --------------:
$inicio_1 = "001"; $inicio_2 = 1; $ruta = "616"; $video = 1000; system("mkdir $carpeta_1/$carpeta_2");
for $i ( $inicio_1 .. $ruta ) {
    while ( $inicio_2 <= $video ) {
        if (-e "$carpeta_1/$carpeta_2/$inicio_2.wmv") {
            $inicio_2++;
        } else {
            system("wget -nd http://free.sexbankroll.com/content/DB1$i/$inicio_2.wmv");
            if ($n_1 == $n_2) {
                exit(0);
            }
            if (-e "$carpeta_1/$carpeta_2/404.html") {
                unlink("$carpeta_1/$carpeta_2/404.html");
                if ($video == 1) {
                    $inicio_1 = $ruta;
                } else {
                    $inicio_2 = $video;
                }
            } else {
                system("mv $inicio_2.wmv $carpeta_1/$carpeta_2/$inicio_2.wmv");
                $n_2++; $inicio_2++;
            }
        }
    }
}
$carpeta_2++;
#Fin ruta Nº2 ----------------------------------------------------------------------------:

#Inicio ruta Nº3 http://free.sexbankroll.com/quality_con ... uregranny/[1-757].wmv -:
$inicio_2 = 1; $video = 757; system("mkdir $carpeta_1/$carpeta_2");
while ( $inicio_2 <= $video ) {
    if (-e "$carpeta_1/$carpeta_2/$inicio_2.wmv") {
        $inicio_2++;
    } else {
        system("wget -nd http://free.sexbankroll.com/quality_con ... icio_2.wmv");
        if ($n_1 == $n_2) {
            exit(0);
        }
        if (-e "$carpeta_1/$carpeta_2/404.html") {
            unlink("$carpeta_1/$carpeta_2/404.html");
            $inicio_2 = $video;
        } else {
            system("mv $inicio_2.wmv $carpeta_1/$carpeta_2/$inicio_2.wmv");
            $n_2++; $inicio_2++;
        }
    }
}
$carpeta_2++;
#Fin ruta Nº3 ----------------------------------------------------------------------------:

#Inicio ruta Nº4 http://free.sexbankroll.com/quality_con ... uregranny/[1-757].wmv -:
$inicio_2 = 1; $video = 1269; system("mkdir $carpeta_1/$carpeta_2");
while ( $inicio_2 <= $video ) {
    if (-e "$carpeta_1/$carpeta_2/$inicio_2.wmv") {
        $inicio_2++;
    } else {
        system("wget -nd http://free.sexbankroll.com/niche_conte ... icio_2.wmv");
        if ($n_1 == $n_2) {
            exit(0);
        }
        if (-e "$carpeta_1/$carpeta_2/404.html") {
            unlink("$carpeta_1/$carpeta_2/404.html");
            $inicio_2 = $video;
        } else {
            system("mv $inicio_2.wmv $carpeta_1/$carpeta_2/$inicio_2.wmv");
            $n_2++; $inicio_2++;
        }
    }
}
$carpeta_2++;
#Fin ruta Nº4 ----------------------------------------------------------------------------:

#Inicio ruta Nº5 http://free.sexbankroll.com/quality_con ... ar/hentai/[1-2274].wmv -:
$inicio_2 = 1; $video = 2274; system("mkdir $carpeta_1/$carpeta_2");
while ( $inicio_2 <= $video ) {
    if (-e "$carpeta_1/$carpeta_2/$inicio_2.wmv") {
        $inicio_2++;
    } else {
        system("wget -nd http://free.sexbankroll.com/quality_con ... icio_2.wmv");
        if ($n_1 == $n_2) {
            exit(0);
        }
        if (-e "$carpeta_1/$carpeta_2/404.html") {
            unlink("$carpeta_1/$carpeta_2/404.html");
            $inicio_2 = $video;
        } else {
            system("mv $inicio_2.wmv $carpeta_1/$carpeta_2/$inicio_2.wmv");
            $n_2++; $inicio_2++;
        }
    }
}
$carpeta_2++;
#Fin ruta Nº5 ----------------------------------------------------------------------------:

#Inicio ruta Nº6 http://free.sexbankroll.com/quality_con ... /sologirl/[1-382].wmv :
$inicio_2 = 1; $video = 382; system("mkdir $carpeta_1/$carpeta_2");
while ( $inicio_2 <= $video ) {
    if (-e "$carpeta_1/$carpeta_2/$inicio_2.wmv") {
        $inicio_2++;
    } else {
        system("wget -nd http://free.sexbankroll.com/quality_con ... icio_2.wmv");
        if ($n_1 == $n_2) {
            exit(0);
        }
        if (-e "$carpeta_1/$carpeta_2/404.html") {
            unlink("$carpeta_1/$carpeta_2/404.html");
            $inicio_2 = $video;
        } else {
            system("mv $inicio_2.wmv $carpeta_1/$carpeta_2/$inicio_2.wmv");
            $n_2++; $inicio_2++;
        }
    }
}
$carpeta_2++;
#Fin ruta Nº6 ----------------------------------------------------------------------------:
#===========================================FIN DE DESCARGAS========================================#

print "\nTerminado!\n";
exit(0);
Coloreado en 0.004 segundos, usando GeSHi 1.0.8.4


¿Se podrá mejorar de alguna forma? Pienso que tal vez pueda automatizarse de 6 a un solo grupo de scripts donde tan solo se llame a una variable http://sitio/[1-900].wmv y que el código tome esa declaración y lo transforme en código, así solo pondría los links en una variable única llamada links. De todas formas buscaré la manera de hacerlo. Fíjate que me he demorado casi tres días en construir este script ya que antes sabía muy poco y casi todo lo que puse ahí fue averiguando solo cada función y aplicándola al código.

Al final me he divertido más creando el código que utilizándolo :p

(Si piensas que no es bueno dejar este código acá puedes eliminarlo sin remordimiento jajaja)
zkizzik
Perlero nuevo
Perlero nuevo
 
Mensajes: 18
Registrado: 2007-10-15 18:26 @810

Estás repitiendo desiado

Notapor Jenda » 2007-11-06 18:26 @810

Me parece que todas las secciones desde "#Inicio ruta ..." hasta "#Fin ruta ..." son muy parecidas. Debes mover el código común a un subrutina y llamar a la subrutina pasando la $ruta, $inicio_1 y otras cosas diferentes en estas secciones.

Cada vez cuando te ves repitiendo algunas líneas de código debes moverles a un subrutina.

Jenda
P.S.: Disculpe mi español por favor.
Jenda
Perlero nuevo
Perlero nuevo
 
Mensajes: 132
Registrado: 2007-10-29 06:31 @313
Ubicación: Praga, Republica Checa

Notapor zkizzik » 2007-11-06 19:05 @837

Sí lo había pensado pero fíjate que cada vez que termina una declaración como por ejemplo

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
$inicio_1 = "01"; $inicio_2 = 1; $ruta = "49"; $video = 1000; system("mkdir $carpeta_1/$carpeta_2");
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4


al final debe modificarse ya que $inicio_1 ya no es 01 sino 49 y hay que indicarle que nuevamente debe volver a cero; por eso cada inicio del grupo debe contener ese trozo de código... y así el resto; sí había pensado como tu lo dices pero no sabría cómo hacerlo sin afectar cada declaración.
zkizzik
Perlero nuevo
Perlero nuevo
 
Mensajes: 18
Registrado: 2007-10-15 18:26 @810

Notapor explorer » 2007-11-06 19:22 @848

Algunos comentarios...
  • En las rutas 1 y 2, $video nunca vale 1 porque nunca es modificado, por lo que entonces el if suyo siempre ejecutará la parte del 'else'.
  • Cuando detectas que ha ocurrido un error (página 404.html), modificas el valor de $inicio2 al de $video, con la intención de terminar el bucle while, pero no ocurre eso porque la comparación del while se cumple de nuevo (los dos valores son iguales). El bucle se ejecuta una vez más y luego sale. Para hacerlo de forma más elegante, usar last.
JF^D Perl programming & Raku programming. Grupo en Telegram: https://t.me/Perl_ES
Avatar de Usuario
explorer
Administrador
Administrador
 
Mensajes: 14480
Registrado: 2005-07-24 18:12 @800
Ubicación: Valladolid, España

Notapor creating021 » 2007-11-06 20:00 @875

Ignorando el contenido... creo que crearás un gran problema para el servidor con ese system( "wget ..." );

http://search.cpan.org/~gaas/libwww-per ... RobotUA.pm
http://search.cpan.org/~gaas/libwww-per ... otRules.pm
Expect the worst, is it the least you can do?
Avatar de Usuario
creating021
Perlero frecuente
Perlero frecuente
 
Mensajes: 595
Registrado: 2006-02-23 16:17 @720
Ubicación: Frente al monitor

Notapor explorer » 2007-11-06 20:45 @906

Esto es un pequeño ejemplo de lo que se puede hacer en Perl: generar código en tiempo de ejecución:
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
#!/usr/bin/perl

use strict;
use warnings;

my @links = (
    {
        url    => 'http://free.sexbankroll.com/content/VDB00$A/$B.wmv',
        bucles => [
            {
                posicion => '$A',
                inicio   => '01',
                fin      => '49',
            },
            {
                posicion => '$B',
                inicio   => 1,
                fin      => 2,
            },
        ],
    },
);

foreach my $link ( @links ) {
    my $url = $link->{url};
    my @bucles = @{$link->{bucles}};

    my $codigo;

    for my $i ( 0 .. $#bucles ) {

        my $letra = $bucles[$i]->{posicion};
        my $ini   = $bucles[$i]->{inicio  };
        my $fin   = $bucles[$i]->{fin     };

        $codigo .= "\t"x$i . "foreach my $letra ( \"$ini\" .. \"$fin\" ) {\n";

    }

    $codigo .= "\t\tprint \"$url\\n\";\n";

    for my $i ( 0 .. $#bucles ) {
        $codigo .= '}';
    }
    $codigo .= "\n";

    print "$codigo";
    eval $codigo;
}
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4


El resultado es un código que genera las url que vamos a usar luego. Luego solo tendrías que ejecutar el fichero de texto con todas las url, con el parámetro -i, al comando wget y ya estarían bajando todos los ficheros. Recomendable poner la opción mirror del wget.

En la variable @links se puede agregar el resto.

Naturalmente, la solución final es más complicada. Esto es solo un ejemplo.
JF^D Perl programming & Raku programming. Grupo en Telegram: https://t.me/Perl_ES
Avatar de Usuario
explorer
Administrador
Administrador
 
Mensajes: 14480
Registrado: 2005-07-24 18:12 @800
Ubicación: Valladolid, España

parámetros

Notapor Jenda » 2007-11-07 05:02 @251

zkizzik escribiste:Sí lo había pensado pero fíjate que cada vez que termina una declaración como por ejemplo

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
$inicio_1 = "01"; $inicio_2 = 1; $ruta = "49"; $video = 1000; system("mkdir $carpeta_1/$carpeta_2");
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4


al final debe modificarse ya que $inicio_1 ya no es 01 sino 49 y hay que indicarle que nuevamente debe volver a cero; por eso cada inicio del grupo debe contener ese trozo de código... y así el resto; sí había pensado como tu lo dices pero no sabría cómo hacerlo sin afectar cada declaración.


Te he dicho, cambia lo que no está lo mismo como parámetros. Algo así:

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
descarga(  01,  49, 'VDB00');
descarga( 001, 616, 'DB1');

sub descarga {
        my ($inicio_1, $ruta, $dir) = @_;

        my $inicio_2 = 1;
        my $video = 1000;
        system("mkdir $carpeta_1/$carpeta_2");
        for $i ( $inicio_1 .. $ruta ) {
                while ( $inicio_2 <= $video ) {
                        if (-e "$carpeta_1/$carpeta_2/$inicio_2.wmv") {
                                $inicio_2++;
                        } else {
                                system("wget -nd http://free.sexbankroll.com/content/$di ... icio_2.wmv");
                                if ($n_1 == $n_2) {
                                        exit(0);
                                }
                                if (-e "$carpeta_1/$carpeta_2/404.html") {
                                        unlink("$carpeta_1/$carpeta_2/404.html");
                                        if ($video == 1) {
                                                $inicio_1 = $ruta;
                                        } else {
                                                $inicio_2 = $video;
                                        }
                                } else {
                                        system("mv $inicio_2.wmv $carpeta_1/$carpeta_2/$inicio_2.wmv");
                                        $n_2++; $inicio_2++;
                                }
                        }
                }
        }
        $carpeta_2++;
}
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4


Me parece que te podría interesar este script:

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
#!/usr/bin/perl
use strict;
use File::Path qw(mkpath);
use LWP::UserAgent;
use HTTP::Cookies;

my $VERSION = 1.3;

if ($ARGV[0] =~ m{^[-/]h(elp)?$} or $ARGV[0] =~ m{^[-/]\?$}) {
        print <<'*END*';
getimagesR.pl [-r referer] url [filename]
        downloads all files in the sequence = finds all {N..M} or {N..} specifications in the URL
        and iterates through them downloading the files.
        {N..M} : try to download URLs with numbers N through M
        {N..}   : try to downlad all URLs starting with N until you fail ten times

        the filename may contain $1, $2, ... (the numbers generated by the {N..M} and {N..}
        groups) and $0 (the complete filename from the URL). If it doesn't contain any of those
        it'
s prepended to the filename from the URL.

        If you specify the -r followed by a URL then that URL will be downloaded
        (with cookies remembered) and then sent to      the server as the HTTP_REFERER
        for each download.
*END*
        exit;
}


my $ua = LWP::UserAgent->new(
        env_proxy => 1,
        keep_alive => 1,
        timeout => 60,
        agent => 'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0; (R1 1.3); .NET CLR 1.0.3705)',
        cookie_jar => HTTP::Cookies->new(),
);

our $referer = '';
while ($ARGV[0] =~ m{^[-/]r}) {
        shift(@ARGV);
        $referer = shift(@ARGV);

        if ($referer !~ /##/) {
                our $result = $ua->get( $referer, ':content_file' => 'referer.html');
                if ($result->code() != 200) {
                        die "Failed to load the referer $referer\n";
                }
        }
}

my $url = shift(@ARGV);

die "No {N..M} or {N..} specifications found in the URL!"
        unless $url =~ /\{\d+\.\.\d*\}/;

my $filemask = shift(@ARGV);
if ($filemask eq '') {
        $filemask = '$0';
} elsif ($filemask !~ /\$\d/) {
        $filemask .= '$0';
}


my @URL = split /\{(\d+)\.\.(\d*)\}/, $url;

use Data::Dumper;

download(1, [], @URL);

sub download {
        my ($level, $indexes, $prefix, $min, $max, $next, @rest) = @_;

        if ($min ne '') {
                # still some groups to process
                my $length = length($min);

                if ($max ne '') {
                        my $failed = 0;
                        for my $index ($min .. $max) {
                                $indexes->[$level] = sprintf("%0${length}d", $index);
                                download( $level+1, $indexes, sprintf("%s%0${length}d%s", $prefix, $index, $next), @rest)
                                        or $failed++;
                        }
                        return ! $failed;
                } else {
                        my $failed = 0;
                        my $index = $min;
                        while ($failed < 10) {
                                $indexes->[$level] = sprintf("%0${length}d", $index);;
                                if (download( $level+1, $indexes, sprintf("%s%0${length}d%s", $prefix, $index, $next), @rest)) {
                                        $failed = 0;
                                } else {
                                        $failed++;
                                }
                                $index++;
                        }
                        return ! $failed;
                }
        } else {
                my $filename;
                if ($filemask =~ /\$0/) {
                        $prefix =~ m{/([^/\?]+)(?:\?.*)?$} and $indexes->[0] = $1;
                }

                (my $filename = $filemask) =~ s/\$(\d)/$indexes->[$1]/g;
                (my $url = $prefix) =~ s/\$(\d)/$indexes->[$1]/g;
                print $url," => ",$filename,"\n";
                my $result = getstore( $url, $filename);
                return ($result == 200);
        }
}

sub getstore {
        my ($url, $file, $allowHTML) = @_;
        if (-e $file) {
                $file =~ s{(?:~(\d+))?(\.\w+)$}{'~' . ($1+1) . $2}e while (-e $file);
        } elsif ($file =~ m{^(.*)[/\\]}) {
                die qq{"$1" is not a directory!\n} if -e $1 and !-d $1;
                unless (-e $1) {
                        mkpath $1, 0777;
                }
        }
        my $result = $ua->get($url, ':content_file' => $file, referer => $referer);
        return $result->status_line() if $result->code() != 200;

        if (wantarray()) {
                return (200, $result->content_type);
        } else {
                if (!$allowHTML and $result->content_type =~ /^text/i) {
                        print "Bloody bastards. They do not return proper HTTP status!\n";
                        unlink $file;
                        return 404;
                }
                return 200;
        }
}
Coloreado en 0.003 segundos, usando GeSHi 1.0.8.4
Jenda
Perlero nuevo
Perlero nuevo
 
Mensajes: 132
Registrado: 2007-10-29 06:31 @313
Ubicación: Praga, Republica Checa


Volver a Básico

¿Quién está conectado?

Usuarios navegando por este Foro: No hay usuarios registrados visitando el Foro y 11 invitados

cron