Форум АНТИЧАТ

Форум АНТИЧАТ (https://forum.antichat.xyz/index.php)
-   PHP, PERL, MySQL, JavaScript (https://forum.antichat.xyz/forumdisplay.php?f=37)
-   -   FTP & PR cheker [perl] (https://forum.antichat.xyz/showthread.php?t=65655)

ZAMUT 27.03.2008 23:15

FTP & PR cheker [perl]
 
Файл с фтп в формате
Код:

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 творения нету смысла,в этом разделе сидят только "крутые" ПыХыПы кодеры


Время: 21:54