Yahoo! のランキングをお手軽チェックするPerlスクリプトCGI(2012/4現在)

 Yahoo!の検索順位チェックが手間なので、一気にチェックするスクリプトを書いてみました。
キーワードごとにYahoo!にアクセスするので、動作はすごく遅いですが、チェックが超ラクになりました。

#久しぶりにPerlを書いたら、けっこう書き方忘れていた。

使い方

ローカルホストの好きなところにおいて、以下のようにアクセスします(ファイル名はyahoo_search_rank_check.plとする)。
パラメータはPATH_INFOで渡します。

http://localhost/yahoo_search_rank_check.pl/k-カンマ,区切り,キーワード/site-example.com,example.net/

 site-のところにカンマ区切りで競合サイトを入れたりすると、一緒に一覧に表示します。

補足

  • 同じディレクトリに[lwpcookies.txt]というファイルを作って、書き込み可能にしておきます。内容は、
    Cookies:
    #LWP-Cookies-1.0
    Set-Cookie3: sB="n=100&"; path="/"; domain=.yahoo.co.jp; path_spec; expires="2099-04-01 00:00:00Z"; version=0
  • common.cssはこれ。必須ではありません。
  • jQueryhoverIntent を使っています。/JavaScript に置くか、読み込めるようにスクリプト内の記述を変更してください。
  • Web::Scraperを使ってDOMを検索しているので、Yahoo!の仕様が変わったらscraperの記述をそれに合わせる必要あり。
    現在でもUAによって返ってくるHTMLが違ったりしているので、将来変わる可能性は十分あります。
    2012/4現在の検索結果のHTMLを前提にしてます。
  • サイト名(/site-example.com,example.net/)の部分はそのまま正規表現にぶち込んでいるので、必ずしも正確ではありません。
  • このスクリプトを使用することで何らかの不利益を被ったとしても私は何ら感知いたしません。何らかの利益があったら教えてください。

スクリプト[yahoo_search_rank_check.pl]

#!/usr/bin/perl

use utf8;
use Encode;

use strict;
use lib qw(. ../lib/perl);
use CGI qw(:all);
use CGI::Pretty;
use CGI::Carp qw(fatalsToBrowser);
use CGI::PathInfo;

use Web::Scraper;
use LWP::UserAgent;
use HTTP::Cookies;
use URI::Escape;

use Data::Dumper;

my $q = new CGI;

print $q->header(-charset=>'utf-8');

my $pathinfo = new CGI::PathInfo;

my @keywords = split(',', $pathinfo->param('k'));
my @sites = split(',', $pathinfo->param('sites'));

my $data = {};
my $rank_data = {};
my $ua = LWP::UserAgent->new;
my $ys = 'http://search.yahoo.co.jp/search?p=';

$ua->cookie_jar(HTTP::Cookies->new(file => "lwpcookies.txt"));
$ua->agent('Local-UA/1.0');

# HTML Headers
my $css = <start_html(
 -title=>'Yahoo! rankings',
 -style=> { 'src'=>'/StyleSheet/common.css', 'code'=>$css },
 -script=> [
  { 'type'=>'text/javascript', 'src'=>'/JavaScript/jquery-1.7.1.min.js'},
  { 'type'=>'text/javascript', 'src'=>'/JavaScript/hoverIntent.min.js'},
  { 'code'=>$script }
 ]
);

print $q->start_table({-class=>'keyword_ranking', -border=>1});
print $q->thead($q->Tr($q->th(['KEYWORDS','RANK','SITES'])));
print $q->start_tbody() . $q->start_Tr();

foreach my $k (@keywords) {
 next if (!$k);
 $data->{$k} = {};
 my $r = $ua->request(HTTP::Request->new(GET => $ys . $k));
 if ($r->is_success) {
  my $scraper = scraper {
   process '#web li>a', 'TITLE[]' => 'HTML';
   process '#web li>a', 'URL[]' => '@href';
   process '#web li>div', 'DESCRIPTION[]' => 'HTML';
  };
  my $extract = $scraper->scrape($r->content);

  for (1..100) {
   for (my $i = 0; $i {URL}->[$_-1] =~ /$sites[$i]/) {
     $data->{$k}->{$sites[$i]}->{$_} = { title => $extract->{TITLE}->[$_-1], uri => $extract->{URL}->[$_-1], description => $extract->{DESCRIPTION}->[$_-1] }
    }
   }
  }

  my $r = {};
  foreach my $s (@sites) {
   foreach my $rank (keys %{$data->{$k}->{$s}}) {
    $r->{$rank} = [$data->{$k}->{$s}->{$rank}->{title}, $data->{$k}->{$s}->{$rank}->{uri}, $data->{$k}->{$s}->{$rank}->{description}];
   }
  }

  my $n = scalar keys %{$r};
  print $q->th({-rowspan=>$n, -class=>'keywords'},$k);

  my $count = 0;
  for (sort { $a  $b } keys %{$r}) {
   if ($count) { print $q->start_Tr(); }
   print $q->td({ -class=>'rank' }, $_);

   print $q->start_td({-class=>'site_data'});
   print $q->p({-class=>'title'}, $r->{$_}->[0]);
   print $q->p({-class=>'uri'}, $q->a({-href=>$r->{$_}->[1], -target=>'_blank'}, $r->{$_}->[1]));
   print $q->p({-class=>'description'}, $r->{$_}->[2]);
   print $q->end_td;
   print $q->end_Tr();
   $count++;
  }
  $rank_data->{$k} = $r;

 }
 else {
  print $r->status_line, "\n";
 }
}

$q->end_tbody() . $q->end_table();

__END__
Cookies:
#LWP-Cookies-1.0
Set-Cookie3: sB="n=100&"; path="/"; domain=.yahoo.co.jp; path_spec; expires="2099-04-26 02:33:27Z"; version=0

Leave a Reply