[Perl Tk] Lix.In Decoder 0.2

Hola a todos.

Aca les traigo la version Tk de un script que habia hecho para decodificar las url lix.in

Lo bueno del programa es que guarda todo los logs en la carpeta donde ejecutaron el programa

#!usr/bin/perl
#Lix.In Decoder 0.2
#Version Tk
#Coded By pr0xXx0r
 
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 {
 
    $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 {
    my @limpio;
    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 ?