Foro - Perl en Español

por **BigBear** » 2012-03-28 13:33 @606

Tengo un problema con este código porque no sé cómo renovar el array @urls, ya que la segunda vez que uso el programa aparecen los enlaces viejos.

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

#!usr/bin/perl
#Lix.In Decoder 0.2
#Version Tk
#Coded By Doddy H
 
use LWP::UserAgent;
use URI::Split qw(uri_split);
use Tk;
use Tk::Dialog;
 
if ( $^O eq 'MSWin32' ) {
    use Win32::Console;
    Win32::Console::Free();
}
 
my $nave = LWP::UserAgent->new;
$nave->agent("Mozilla/5.0 (Windows; U; Windows NT 5.1; nl; rv:1.8.1.12) Gecko/20080201Firefox/2.0.0.12");
$nave->timeout(5);
 
my $color_fondo = "black";
my $color_text  = "green";
 
my $ben = MainWindow->new( -background => $color_fondo, -foreground => $color_text );
 
$ben->title("Lix.In Decoder 0.2 (C) Doddy Hackman 2012");
$ben->geometry("492x385+20+20");
$ben->resizable( 0, 0 );
 
$ben->Label( -background => $color_fondo, -foreground => $color_text, -text => "Page : ", -font => "Impact1" )
    ->place( -x => 20, -y => 20 );
my $page
    = $ben->Entry( -background => $color_fondo, -foreground => $color_text, -width => 40 )->place( -x => 73, -y => 24 );
 
$ben->Button(
    -text             => "Decode",
    -width            => 10,
    -command          => \&home,
    -background       => $color_fondo,
    -foreground       => $color_text,
    -activebackground => $color_text
)->place( -x => 325, -y => 23 );
$ben->Button(
    -text             => "Logs",
    -width            => 10,
    -command          => \&logs,
    -background       => $color_fondo,
    -foreground       => $color_text,
    -activebackground => $color_text
)->place( -x => 400, -y => 23 );
 
$ben->Label( -text => "Links Found", -font => "Impact", -background => $color_fondo, -foreground => $color_text )
    ->place( -x => 200, -y => 80 );
my $links = $ben->Listbox( -width => 70, -height => 15, -background => $color_fondo, -foreground => $color_text )
    ->place( -x => 32, -y => 140 );
 
MainLoop;
 
sub home {
 
    my @urls = ("");
 
    $links->delete( "0.0", "end" );
 
    my $url = $page->get;
 
    my $code = toma($url);
 
    while ( $code =~ m{http://lix\.in/(-\w+)}ig ) {
        push( @urls, "http://lix.in/" . $1 );
    }
 
    while ( $code =~ m{http://lix\.in/(\w+)}ig ) {
        push( @urls, "http://lix.in/-" . $1 );
    }
 
    my @urls = repes(@urls);
 
    for my $l (@urls) {
        chomp $l;
        $ben->update;
        decode_link( $l, $url );
    }
}
 
sub decode_link {
 
    my ( $link, $url ) = @_;
 
    my ( $scheme, $auth, $path, $query, $frag ) = uri_split($url);
 
    if ( $link =~ /-(.*)/ ) {
        my $co = "-" . $1;
        chomp $co;
        my $code = tomar( $link, { "tiny" => $co, "submit" => "continue", "submit" => "submit" } );
        if ( $code =~ /<iframe  name="ifram" src="(.*)" marginwidth="0"/ ) {
            my $link = $1;
            chomp $link;
            unless ( $link =~ /lix\.in/ ) {
                savefile( $auth . ".txt", $link );
                $links->insert( "end", $link );
            }
        }
    }
}
 
sub logs {
 
    my ( $scheme, $auth, $path, $query, $frag ) = uri_split( $page->get );
    my $f = $auth . ".txt";
 
    if ( -f $f ) {
        system($f);
    }
    else {
        $ben->Dialog(
            -title            => "Error",
            -buttons          => ["OK"],
            -text             => "Logs not found",
            -background       => $color_fondo,
            -foreground       => $color_text,
            -activebackground => $color_text
        )->Show();
    }
}
 
sub repes {
    foreach $test (@_) {
        push @limpio, $test unless $repe{$test}++;
    }
    return @limpio;
}
 
sub savefile {
    open( SAVE, ">>" . $_[0] );
    print SAVE $_[1] . "\n";
    close SAVE;
}
 
sub toma {
    return $nave->get( $_[0] )->content;
}
 
sub tomar {
    my ( $web, $var ) = @_;
    return $nave->post( $web, [ %{$var} ] )->content;
}
 
# The End ?
Coloreado en 0.010 segundos,  usando GeSHi 1.0.8.4

¿ Alguien me puede ayudar ?

No sé a qué te refieres exactamente, pero, por defecto, cuando arranca un programa, ninguna variable "recuerda" el estado de la anterior ejecución (se puede hacer que sí la recuerden, a eso se le llama "persistencia", pero no es el caso en tu programa).

Lo que sí veo es que hay un '>>' en la función de salvar... Si entre ejecuciones no pones a cero el archivo, pues irá creciendo, desde luego.

Otra cosa que quieras hacer es que solo quieres los enlaces que no estén ya grabados en la lista. Para eso, no te queda más remedio que leer esa lista. (O usar un método de "persistencia"

)

por **BigBear** » 2012-03-28 15:43 @697

Bueno, explorer, esta vez me he salvado yo mismo. El problema estaba en la función repes().

Igual: gracias.

Foro - Perl en Español

Renovar array en programa

Renovar array en programa

Publicidad

Re: Renovar array en programa

Re: Renovar array en programa

¿Quién está conectado?