Version Tk de un simple programa en Perl para bajar archivos.

Una imagen



El codigo

#!usr/bin/perl
#Simple downloader 0.1
#Version Tk
#Coded By Doddy H
 
use Tk;
use Tk::Dialog;
use LWP::UserAgent;
use URI::Split qw(uri_split);
 
my $color_fondo = "black";
my $color_texto = "green";
 
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(20);
 
if ( $^O eq 'MSWin32' ) {
    use Win32::Console;
    Win32::Console::Free();
}
 
my $dron =
  MainWindow->new( -background => $color_fondo, -foreground => $color_texto );
$dron->geometry("430x70+20+20");
$dron->resizable( 0, 0 );
$dron->title("Simple Downloader 0.1 || [+] Status : <None>");
 
$dron->Label(
    -text       => "URL : ",
    -font       => "Impact",
    -background => $color_fondo,
    -foreground => $color_texto
)->place( -x => 20, -y => 20 );
my $pre = $dron->Entry(
    -width      => 45,
    -background => $color_fondo,
    -foreground => $color_texto
)->place( -x => 60, -y => 27 );
$dron->Button(
    -command          => \&now,
    -text             => "Download",
    -width            => 10,
    -background       => $color_fondo,
    -foreground       => $color_texto,
    -activebackground => $color_texto
)->place( -x => 340, -y => 25 );
 
MainLoop;
 
sub now {
 
    my ( $scheme, $auth, $path, $query, $frag ) = uri_split( $pre->get );
    $dron->title("Simple Downloader 0.1 || [+] Status : Downloading..");
    if ( $path =~ /(.*)\/(.*)$/ ) {
        my $file = $2;
        if ( download( $pre->get, $file ) ) {
            $dron->Dialog(
                -title            => "OK",
                -buttons          => ["OK"],
                -text             => "File downloaded",
                -background       => $color_fondo,
                -foreground       => $color_texto,
                -activebackground => $color_texto
            )->Show();
        }
        else {
            $dron->Dialog(
                -title            => "Error",
                -buttons          => ["OK"],
                -text             => "Error",
                -background       => $color_fondo,
                -foreground       => $color_texto,
                -activebackground => $color_texto
            )->Show();
        }
    }
    $dron->title("Simple Downloader 0.1 || [+] Status : <None>");
}
 
sub download {
    if ( $nave->mirror( $_[0], $_[1] ) ) {
        if ( -f $_[1] ) {
            return true;
        }
    }
}
 
#The End ?