HTML::TagCloudのサンプル

perl

へぇこんなんのあるんだって思ったらかなり古くあるものだった。
どんなんか知るために、サンプルを書いてみる。

参考

http://search.cpan.org/~robertsd/HTML-TagCloud-0.36/lib/HTML/TagCloud.pm

ソース

DMMから女優ランキングを取得し、それをタグクラウド風にしたものを
HTMLとして出力する。

#!/usr/bin/env perl
use strict;
use warnings;

use utf8;

use Web::Scraper;
use URI;
use HTML::TagCloud;
use Text::Xslate;
use Encode;

my $rank = scraper {
    process "td.bd-b", "actresses[]" => scraper {
        process "span.rank", "rank" => 'TEXT';
        process "div.data > p > a", 'name' => 'TEXT', 'url' => '@href';
    };
};

my $cloud = HTML::TagCloud->new;

my $base = 'http://www.dmm.co.jp/digital/videoa/-/ranking_all/=/type=actress/page=';
for my $page (1..2) {
    my $url = "${base}${page}/";
    my $res = $rank->scrape(URI->new($url));

    for my $actress (@{$res->{actresses}}) {
        (my $name = $actress->{name}) =~ s{[(（].*$}{}xms;

        $cloud->add(
            $name,
            $actress->{url},
            500 - ($actress->{rank} * 10)
        );
    }
}

my $tx = Text::Xslate->new;
my $template = do {
    local $/;
    <DATA>;
};

my $output = $tx->render_string($template, { tag => $cloud->html_and_css(40) });

print encode_utf8($output);

__DATA__
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN"
   "http://www.w3.org/TR/html4/strict.dtd">
<html lang="ja">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
<meta http-equiv="Content-Style-Type" content="text/css" />
<title>タグクラウドサンプル</title>
<style type="text/css">
div.tag-box {
    width: 600px;
    border: solid 10px #aaaa55;
    margin: 0 auto 0 auto;
}
</style>
</head>
<body>
<div class="tag-box">
<: $tag | raw :>
</div>
</body>
</html>

イメージ

   % perl html_tagcloud.pl > cloud_sample.html
   % open cloud_sample.html

こんな感じ。