Показать сообщение отдельно

  #442  
Старый 08.09.2008, 01:37
bons
Участник форума
Регистрация: 20.12.2007
Сообщений: 295
Провел на форуме:
1777055

Репутация: 347
По умолчанию

Может кому-то будет нужен
Скрипт на перле качает фотки с xuk.ru

Код:
#Скрипт закачивает фотки с xuk.ru ;)
use LWP;
use strict;

my $n = shift;
my $html = '';
if(defined($n))
{
	$html = "$n.html";
	$n = " - $n";
}
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime(time);
my $newdir = sprintf "%02u-%02u-%04u$n",$mday,$mon+1,$year+1900;
mkdir $newdir || die 'cannot create directory';
chdir $newdir;

my $ua = LWP::UserAgent->new;
my $res = $ua->get("http://xuk.ru/$html");
die 'cannot connect' unless $res->is_success;
my @main = split /\x0D\x0A/, $res->content;
my @girl_url;

foreach (@main)
{
	if(/vid-1\.html/)
	{
		push @girl_url, $& if /http:\/\/xuk\.ru\/.*vid-1\.html/;
	}

}

foreach (@girl_url)
{
	my $folder = substr $&, 1, -11 if /\/[\w-]*\/vid-1.html/;
	print "FOLDER: $folder\n";
	mkdir $folder || die 'cannot create directory';
	$res = $ua->get($_);
	unless($res->is_success)
	{
		warn "cannot connect\n";
		next
	}
	my @vid = split /\x0D\x0A/, $res->content;
	my @foto_url;
	foreach(@vid)
	{
		if(/<img alt="Эротика/)
		{
			push @foto_url, $& if /http:\/\/pic\.xuk\.ru\/files.*\.jpg/;
		}
	}
	foreach (@foto_url)
	{
		my $filename = substr $&, 1 if /\/[\w-\(\)\.]*\.jpg/;
		print "\tFILE: $filename\n";
		$ua->get($_, ':content_file' => "$folder/$filename");
	}
}

chdir '..';
 
Ответить с цитированием