2011年 07月 29日

gerry 可視化再び

use strict;

use LWP::Simple qw($ua);
use HTML::TreeBuilder::XPath;

my $res = $ua->get('http://subtech.g.hatena.ne.jp/keyworddiary/gerry');
$res->is_success or die "Failed to GET: $res";

my $data = [];
my $doc = HTML::TreeBuilder::XPath->new_from_content($res->content);
my $nodes = $doc->findnodes('id("refered-diary")//ul/li[@class="diary-listitem"]/a');
for my $node (@$nodes) {
	my $href = $node->findvalue('@href');
	if (my ($year, $month, $day) = ($href =~ m{/cho45/(\d{4})(\d\d)(\d\d)})) {
		push @$data, [$year, $month, $day] ;
	}
}

$doc->delete;


use WebService::Hatena::Graph;
use IO::Prompt;
use Perl6::Say;

my $password = prompt "Password:", -echo => '';

my $graph = WebService::Hatena::Graph->new(
	username => 'cho45',
	password => $password,
);

my $count = 1;
for my $date (reverse @$data) {
	$graph->post_data(
		graphname => 'gerry',
		date      => join('-', @$date),
		value     => $count++,
	);
	say join('-', @$date);
}

use DateTime;
use IO::File;
my $fh = IO::File->new('gerry_access_log', 'w');

for my $date (@$data) {
	my ($year, $month, $day) = @$date;
	my $dt = DateTime->new(year => $year, month => $month, day => $day, time_zone => 'Asia/Tokyo')->strftime('%d/%b/%Y:00:00:00 +0900');

	$fh->write(qq|0.0.0.0 - - [$dt] "GET /gerry HTTP/1.1" 200 26768 "-" "Gerry"\n|);
}

$fh->close;