Forum Webscript.Ru

Программирование => Perl => Тема начата: bemser от 17 Марта 2006, 00:21:06

Название: определение позиции в яндексе
Отправлено: bemser от 17 Марта 2006, 00:21:06

Всем привет! Есть у меня скриптик по определению позиции сайта в поисковых системах. И с недавнего времени он перестал работать корректно, а точнее сказать, вообще перестал работать с яндексом. Причиной может служить изменение структуры выдачи яндексом или ещё что-то... не знаю точно. Смотрел сам скрипт, вроде как должен работать, но что-то никак... посмотрите пожалуйста, думаю, некоторым это будет интересно.




@words=( # список ключевых запросов через запятую
        \'гипсокартон\',
\'сухие смеси\',
\'ротбанд\',
\'утепление стен\',
\'утепление\',
\'кнауф\',
\'отделочные материалы\',
\'сухие строительные смеси\',
        );
$site=\'elbor.info\'; #проверяемый домен (+любой его субдомен) или выбранный субдомен

$needed=\'yg\';        #какие поисковики интересуют: yandex rambler aport google
$maxpages=6;           #сколько страниц выдачи просматривать, если сайт не найден на предыдущих (вывод по 50 записей на страницу)
$proxy=\'\';             #прокси-сервер в виде IP или домена и порт ([url]http://123.456.7.89:8000[/url]), при пустом значении прокси не устанавливается
                       #список смотреть здесь: [url]http://core.proxyswitcher.com/proxy_list.html[/url]
$delay=1;              #задержка между запросами в секундах
#_________________________
$useragent=\'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)\'; # НЕ МЕНЯТЬ НА АЛЬТЕРНАТИВНЫЕ БРАУЗЕРЫ! ТОЛЬКО IE!
$timeout=100;#время ожидания ответа, в секундах
###############################################
# Евгений, PromoSite.RU
# [url]http://promosite.ru/services/monitoring.php[/url]
# ---------------------------------------------
# Updated by vladots [work@vladots.ru]
###############################################
$nowtime=time();
$date=localtime($nowtime);
$date=~s#(\\d+:)#
$1#i;
$n=$site;
$n=~s#\\.#_#g;
$sname=$n.\'_trends.html\';
open(F,"<$sname");
until(eof(F)) {$stext.=;};
close F;
if (!($stext=~m##))
        {
        $stext=\'new\';
        }
else
        {
        $stext=~s#(<\\!--.+?-->)#$1#gi;
        };

$code=\'%22%B8%E9%F6%F3%EA%E5%ED%E3%F8%F9%E7%F5%FA%FD%E6%E4%EB%EE%F0%EF%E0%E2%FB%F4%FF%F7%F1%EC%E8%F2%FC%E1%FE%22%B8%E9%F6%F3%EA%E5%ED%E3%F8%F9%E7%F5%FA%FD%E6%E4%EB%EE%F0%EF%E0%E2%FB%F4%FF%F7%F1%EC%E8%F2%FC%E1%FE\';
$code=~s/(%[0123456789A-F][0123456789A-F])/push(@codes,$1)/eg;
$lett=\'"ёйцукенгшщзхъэждлорпавыфячсмитьбю"ЁЙЦУКЕНГШЩЗХЪЭЖДЛОРПАВЫФЯЧСМИТЬБЮ\';
$lett=~s/(.)/push(@letters,$1)/eg;
push(@codes, \'+\');
push(@letters, \' \');

sub urlencode
{
my $str=$_[0];
my ($k, $i, $j);

for($k=0; $k<@codes; $k++)
 {
 $i=$codes[$k];
 $j=$letters[$k];
 $str=~s#$j#$i#eg;
 };
return $str;
}

use LWP::UserAgent;
use HTTP::Request;
use URI::URL;
use HTTP::Headers;

$ua = new LWP::UserAgent;
$ua->agent($useragent);
$ua->max_size(100000);
$ua->timeout($timeout);
if ($proxy ne \'\') {$ua->proxy([\'http\', \'ftp\'], $proxy);};

sub getdomain
{
my $paga=$_[0];
$paga=~s#^[url]http://##ig;[/url]
if ($paga=~m#^(.*?)[?:/]#i) {$paga=$1};
return "http://".$paga;
}

sub full
{
my $parent=$_[0];
my $child=$_[1];
my $proto;
my $domains;
my $dir;
my $file;

$parent=~s#&\\;#&#g;
$child=~s#&\\;#&#g;

if ($child=~m#\\.(xls|doc|rtf|txt|gif|jpg|jpeg|mpg|mpeg|mp3|tiff|avi|wov|exe|zip|rar|gz|tar|bz2|bz|tgz|lha|lzh|arj|mov|wav|au|qt|mpe|midi|ra|ram|rm)#i) {return \'\'};

if ($child=~m#[url]http://#i[/url]) {return $child};
if ($child=~m#^/#i)
        {
        if ($parent=~s|(https?://)?(([0-9a-zA-Z_-]+\\.)+[0-9a-zA-Z_-]{2,3})((/[0-9a-zA-Z_-]+?)*?)/?([^/]*?[?#.][^/]*)?$|$proto=$1; $domain=$2; $dirs=$4; $file=$6|ige )
                {
                if ($proto eq \'\') {$proto=\'http://\';};
                $child=~s/#.*$//;
                return $proto.$domain.$child;
                };
        }
else        {
$child=~s#\\.\\./#/#ig;

if ($parent=~s|(https?://)?(([0-9a-zA-Z_-]+\\.)+[0-9a-zA-Z_-]{2,3})((/[0-9a-zA-Z_-]+?)*?)/?([^/]*?[?#.][^/]*)?$|$proto=$1; $domain=$2; $dirs=$4; $file=$6|ige )
{
while ($child=~m#^/#)
        { if ($dirs=~m#/[0-9a-zA-Z_-]+$#)
                        {
                        $child=~s#^/##;
                        $dirs=~s#/[0-9a-zA-Z_-]+$##;
                        }
          else  {
                        print "incorrect link out of dirs\\n";
                        $child=~s#^/##;
                        };
        };
}
else {print "can\'t understand parent url..\\n";};

$child="/".$child;
$child=~s#^//#/#;
if ($proto eq \'\') {$proto=\'http://\';};

$child=~s/#.*$//;
return $proto.$domain.$dirs.$child;
        };
}




sub get
{
my $urlo=$_[0];

$hdrs = new HTTP::Headers(Accept => \'text/html\',ACCEPT_LANGUAGE => \'ru\');
$url = new URI::URL($urlo);
$req = new HTTP::Request(GET, $url, $hdrs);
$req->referer($current);
sleep($delay);
$resp = $ua->request($req);

if ($resp->is_success)
        {
        $result=$resp->content;
        print "\\n Got ".$urlo;
        $current=$urlo;
        return $result;
        }
else
        {
$msg=$resp->message;
print $msg;
return 0;
        };
};





for($i=0; $i<@words; $i++)
{
$word=$words[$i];
$currow="$word";
$navrow=\'\';


#######
if ($needed=~m#y#)
{
$current=\'http://www.yandex.ru/\';
$se=$current;
$num=\'000\';
$p=0;
$navrow.="$current";
$page=\'http://www.yandex.ru/yandsearch?text=\'.urlencode($word).\'&numdoc=50\';
$result=get($page);

while(!($result=~s#

\\s*

\\s*        {
        $p++;
        print "\\n $p-th page... (50 on page)";
        $result=~s#следующая.*#$page=full($page,$1);#igse;
        $result=get($page);
        };

print "\\n\\nYour site is number ".$num." in Yandex by the -".$word."- query.";
print "\\nProgress: ".int(100*$i/(@words+0))."%\\n\\n";
$currow.="$num";
if ($stext eq \'new\')
        {
        $uprow{$se}.="$word$num"."\\n";
        $daterow="Запрос|Дата<\\!--date-->$date";
        }
else
        {
        $stext=~s#(<\\!--$word_$se-->)#$1$num#i;
        $stext=~s#(<\\!--date-->)#$1$date#i;
        };
};
#######
if ($needed=~m#r#)
{
$current=\'http://www.rambler.ru/\';
$se=$current;
$num=\'000\';
$p=0;
$rps=0; # rambler page start in

tag
$navrow.="$current";
$page=\'http://search.rambler.ru/srch?words=\'.urlencode($word).\'&limit=50\';
$result=get($page);

while(!($result=~m#
1.         {
           $p++;
           print "\\n $p-th page...";
           $hlp=$p+1;
           $result=~s#$hlp#$page=full($page,$1);#ei;
           $result=get($page);
           };
   if ($result=~s#
2. #is)
           {
           $result=~s#

   #$rps=$1#igse;
           $result=~s#
   1. #$num++#igse;
              $num+=$rps-1;
              };
      
      print "\\n\\nYour site is number ".$num." in Rambler by the -".$word."- query.";
      print "\\nProgress: ".int(100*$i/(@words+0))."%\\n\\n";
      $currow.="$num";
      if ($stext eq \'new\')
              {
              $uprow{$se}.="$word$num"."\\n";
              $daterow="Запрос|Дата<\\!--date-->$date";
              }
      else
              {
              $stext=~s#(<\\!--$word_$se-->)#$1$num#i;
              $stext=~s#(<\\!--date-->)#$1$date#i;
              };
      };
      #######
      if ($needed=~m#a#)
      {
      $current=\'http://www.aport.ru/\';
      $a_pages = 3*$maxpages; # 15 [on page] * 3 = 45 ~= 50 ;)
      if ($a_pages > 10) { $a_pages = 10; } # для перехода к следующему списку там используется >
      $se=$current;
      $num=\'000\';
      $p=1;
      $navrow.="$current";
      $page=\'http://sm.aport.ru/scripts/template.dll?r=\'.urlencode($word);
      $result=get($page);
      
      while(!($result=~s#
   2. \\s*        {
              $p++;
              print "\\n $p-th page... (15 on page / 3 pages)";
              $result=~s#]+)>$p#$page=full($page,$1);#ei;
              $result=get($page);
              };
      print "\\n\\nYour site is number ".$num." in Aport by the -".$word."- query.";
      print "\\nProgress: ".int(100*$i/(@words+0))."%\\n\\n";
      $currow.="$num";
      if ($stext eq \'new\')
              {
              $uprow{$se}.="$word$num"."\\n";
              $daterow="Запрос|Дата<\\!--date-->$date";
              }
      else
              {
              $stext=~s#(<\\!--$word_$se-->)#$1$num#i;
              $stext=~s#(<\\!--date-->)#$1$date#i;
              };
      };
      #######
      if ($needed=~m#g#)
      {
      $current=\'http://www.google.com/\';
      $se=$current;
      $num=\'000\';
      $p=0;
      $gps=0; # google page start
      $navrow.="$current";
      $page=\'http://www.google.com/search?q=\'.urlencode($word).\'&num=10&hl=ru\';
      $result=get($page);
      $result=~s#

      \\s*

      .+?

      ##igs; # kill 2nd level snippets
      
      while(!($result=~m#

              {
              $p++;
              print "\\n $p-th page...";
              $result=~s#]*)><.+?>
      .+?#$page=full($page,$1);#ei;
              $result=get($page);
              };
      
              # get google page start
              $result=~s#<.+?>.+?(\\d+)#$gps=$1#igse;
      
              @garr=split(\'

      \',$result);
              for($j=0; $j<@garr; $j++) {
                      $garr[$j]=~s#^        };
      
      print "\\n\\nYour site is number ".$num." in Google by the -".$word."- query.";
      print "\\nProgress: ".int(100*$i/(@words+0))."%\\n\\n";
      $currow.="$num";
      if ($stext eq \'new\')
              {
              $uprow{$se}.="$word$num"."\\n";
              $daterow="Запрос|Дата<\\!--date-->$date";
              }
      else
              {
              $stext=~s#(<\\!--$word_$se-->)#$1$num#i;
              $stext=~s#(<\\!--date-->)#$1$date#i;
              };
      };
      
      
      ###
      $curout.="$currow\\n";
      };
      
      
      if ($stext eq \'new\')
              {
              $stext=\'

      Мониторинг

      \';
              while(($k,$v)=each(%uprow))
                      {
                      $stext.="

      $site : $k

      $daterow$v";
                      };
              $stext.="

      ---

      По датам:

      ";
              };
      $stext.="

      $site : ".localtime($nowtime)."

      $navrow\\n$curout

      Запрос|SE

      Сайт на первых $maxpages страницах выдачи может быть не найден

      ---

      ";
      
      if ($st eq \'new\') {$stext.=\'\';};
      
      $stext=~s#000#нет на $maxpages стр.)#g;
      open(F,">$sname");
      print F $stext;
      close F;
      print "\\a";
      
      

Название: определение позиции в яндексе
Отправлено: arto от 17 Марта 2006, 10:13:12

какой-то "макаронный" код, сложен для понимания.

через WWW::Search не легче?