[Perl Tk] Finder Paths 0.7

[BigBear]

Un simple programa para buscar los listados de directorios en una pagina.

Una imagen

El codigo

Código (perl) [Seleccionar] Expandir


#!usr/bin/perl
#Finder Paths 0.7
#Version Tk
#Coded By Doddy H

use Tk;
use Tk::ListBox;
use LWP::UserAgent;
use URI::Split qw(uri_split);
use HTML::LinkExtor;

if ( $^O eq 'MSWin32' ) {
    use Win32::Console;
    Win32::Console::Free();
}

my $background_fondo = "black";
my $texto_color      = "cyan";

my $nave = LWP::UserAgent->new();
$nave->timeout(5);
$nave->agent(
"Mozilla/5.0 (Windows; U; Windows NT 5.1; nl; rv:1.8.1.12) Gecko/20080201Firefox/2.0.0.12"
);

$ha = MainWindow->new(
    -background => $background_fondo,
    -foreground => $texto_color
);
$ha->title("Finder Paths 0.7 || (C) Doddy Hackman 2012");
$ha->geometry("510x430+20+20");
$ha->resizable( 0, 0 );

$ha->Label(
    -text       => "Web : ",
    -font       => "Impact1",
    -background => $background_fondo,
    -foreground => $texto_color
)->place( -x => 30, -y => 20 );
my $pagine = $ha->Entry(
    -text       => "http://localhost:8080/paths",
    -width      => 40,
    -background => $background_fondo,
    -foreground => $texto_color
)->place( -x => 80, -y => 23 );
$ha->Button(
    -text             => "Search",
    -width            => 10,
    -command          => \&search,
    -background       => $background_fondo,
    -foreground       => $texto_color,
    -activebackground => $texto_color
)->place( -x => 330, -y => 23 );
$ha->Button(
    -text             => "Logs",
    -width            => 10,
    -command          => \&ver_logs,
    -background       => $background_fondo,
    -foreground       => $texto_color,
    -activebackground => $texto_color
)->place( -x => 405, -y => 23 );

$ha->Label(
    -text       => "Type : ",
    -font       => "Impact1",
    -background => $background_fondo,
    -foreground => $texto_color
)->place( -x => 30, -y => 55 );

$ha->Radiobutton(
    -text             => "Fast",
    -value            => "fast",
    -variable         => \$type,
    -background       => $background_fondo,
    -foreground       => $texto_color,
    -activebackground => $texto_color
)->place( -x => 80, -y => 57 );
$ha->Radiobutton(
    -text             => "Full",
    -value            => "full",
    -variable         => \$type,
    -background       => $background_fondo,
    -foreground       => $texto_color,
    -activebackground => $texto_color
)->place( -x => 125, -y => 57 );

$ha->Label(
    -text       => "Paths Found",
    -font       => "Impact",
    -background => $background_fondo,
    -foreground => $texto_color
)->place( -x => 200, -y => 110 );
my $paths_list = $ha->Listbox(
    -width      => 70,
    -height     => 13,
    -background => $background_fondo,
    -foreground => $texto_color
)->place( -x => 42, -y => 160 );
my $status_now = $ha->Label(
    -text       => "Status : <None>",
    -font       => "Impact",
    -background => $background_fondo,
    -foreground => $texto_color
)->place( -x => 190, -y => 380 );

MainLoop;

sub search {

    $paths_list->delete( "0.0", "end" );
    $status_now->configure( -text => "Status : Scanning" );
    if ( $type eq "fast" ) {
        simple( $pagine->get );
    }
    if ( $type eq "full" ) {
        escalar( $pagine->get );
    }
    $status_now->configure( -text => "Status : <None>" );
}

sub ver_logs {
    if ( -f "paths-logs.txt" ) {
        system("paths-logs.txt");
    }
    else {
        $ha->Dialog(
            -title            => "Error",
            -buttons          => ["OK"],
            -text             => "File Not Found",
            -background       => $background_fondo,
            -foreground       => $texto_color,
            -activebackground => $texto_color
        )->Show();
    }
}

sub escalar {

    my $co    = $_[0];
    my $code  = toma( $_[0] );
    my @links = get_links($code);

    if ( $code =~ /Index of (.*)/ig ) {
        $paths_list->insert( "end", $co );
        savefile( "paths-logs.txt", $co );
        my $dir_found = $1;
        chomp $dir_found;
        while ( $code =~ /<a href=\"(.*)\">(.*)<\/a>/ig ) {
            my $ruta   = $1;
            my $nombre = $2;
            unless ( $nombre =~ /Parent Directory/ig
                or $nombre =~ /Description/ig )
            {
                push( @encontrados, $_[0] . "/" . $nombre );
            }
        }
    }

    for my $com (@links) {
        $ha->update;
        my ( $scheme, $auth, $path, $query, $frag ) = uri_split( $_[0] );
        if ( $path =~ /\/(.*)$/ ) {
            my $path1 = $1;
            $_[0] =~ s/$path1//ig;
            my ( $scheme, $auth, $path, $query, $frag ) = uri_split($com);
            if ( $path =~ /(.*)\// ) {
                my $parche = $1;
                unless ( $repetidos =~ /$parche/ ) {
                    $repetidos .= " " . $parche;
                    my $yeah = "http://" . $auth . $parche;
                    escalar($yeah);
                }
            }
            for (@encontrados) {
                $ha->update;
                escalar($_);
            }
        }
    }
}

sub simple {

    my $code  = toma( $_[0] );
    my @links = get_links($code);

    for my $com (@links) {
        $ha->update;
        my ( $scheme, $auth, $path, $query, $frag ) = uri_split( $_[0] );
        if ( $path =~ /\/(.*)$/ ) {
            my $path1 = $1;
            $_[0] =~ s/$path1//ig;
            my ( $scheme, $auth, $path, $query, $frag ) = uri_split($com);
            if ( $path =~ /(.*)\// ) {
                my $parche = $1;
                unless ( $repetidos =~ /$parche/ ) {
                    $repetidos .= " " . $parche;
                    my $code = toma( "http://" . $auth . $parche );

                    if ( $code =~ /Index of (.*)</ig ) {
                        my $dir_found = $1;
                        chomp $dir_found;
                        my $yeah = "http://" . $auth . $parche;
                        $paths_list->insert( "end", $yeah );
                        savefile( "paths-logs.txt", $yeah );
                    }
                }
            }
        }
    }
}

sub toma {
    return $nave->get( $_[0] )->content;
}

sub get_links {

    $test = HTML::LinkExtor->new( \&agarrar )->parse( $_[0] );
    return @links;

    sub agarrar {
        my ( $a, %b ) = @_;
        push( @links, values %b );
    }
}

sub savefile {
    open( SAVE, ">>" . $_[0] );
    print SAVE $_[1] . "\n";
    close SAVE;
}

#The End ?