FTP & PR cheker [perl]

Файл с фтп в формате

Code:

ftp://bla:pas@xek.ru

Для всех c pr <= N/A, отмечает как "-". Все остальное в описании.

Code:

#!/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.

 

обновил

 

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