PDA

Просмотр полной версии : FTP & PR cheker [perl]


ZAMUT
27.03.2008, 23:15
Файл с фтп в формате ftp://bla:pas@xek.ru Для всех c pr <= N/A, отмечает как "-". Все остальное в описании.

#!/usr/bin/perl
#############################INFO################# ############
# FTP-checker & PR-checker (multithreads) #
# Exec: #
# fc.pl [file] [threads] [key] #
# key: #
# 0 : Check FTP #
# 1 : Check FTP & PR #
# 2 : Check PR only #
# Example: #
# fc.pl ftplist.txt 15 1 #
# Save good result in res.txt #
################################################## ############
# Author: ZAMUT #
# Homepage: zamuts.ueuo.com #
################################################## ############
use Net::FTP;
use strict;
use warnings;
use threads;
use threads::shared;
use LWP::UserAgent;
my @ftplist:shared;
my ($all,$n,$k):shared;
open IN,"<$ARGV[0]";
open GOOD,'>>res.txt';
print "\nChecking ...\n";
($n,$all) = 0; $k = $ARGV[2];
my ($flph,$h,$flp,$t,$l,$p,$ftp);
push @ftplist,$_ while(<IN>);chomp(@ftplist);
for(0..$ARGV[1]) {threads->create(\&Check,$_);}
for(threads->list) { $_->join; }
sub Check
{ while (@ftplist)
{ $flph = shift @ftplist;
if($flph=~/^ftp:\/\//i)
{($flp,$h)=split('\@',$flph);$t=$flp=~s/ftp:\/\///i;($l,$p)=split(':',$flp); $all++;} ;
if($k==2){ print GOOD $h.prc($h)."\n";}
if($k==0 || $k==1){
$ftp = Net::FTP->new($h);
if($ftp->login($l,$p))
{ if ($k) {print GOOD "$flph\t".prc($h)."\n";}
else {print GOOD "$flph\n"};
++$n; };
$ftp->quit;} }
}
close GOOD;close IN;
if($k!=2) {print "Checked:$all\nGood:$n\n"; } else {print "Checked:$all"; };
sub prc
{ sleep(3);
my $br=LWP::UserAgent->new;
my $res=$br->post("http://www.prchecker.info/check_page_rank.php",['action'=>'docheck','urlo'=>"http://$h",'do_it_now'=>' Check PR']);
if($res->as_string=~/the page rank value is <b>([0-9 ]{1,2})<\/b> from 10 possible points/) {return ' PR:'.$1;} else {return ' PR:-';}

З.Ы.
Код сократил в 1.5 раза, добавлена функция чека только PR.

ZAMUT
16.05.2008, 20:39
обновил

t00th
16.05.2008, 21:57
Зачем так извращаться с PR когда есть готовый модуль ?
CPAN => WWW::Google::PageRank.Да и вообще постить тут свои perl творения нету смысла,в этом разделе сидят только "крутые" ПыХыПы кодеры