SHIROBAKO

SHIROBAKO.pl

#!/usr/bin/perl -l
# -*- coding: utf-8 -*-
use strict;
use warnings;

my $word = $ARGV[0];
exit unless $word;

use NKF;
use LWP::UserAgent;
my $ua = LWP::UserAgent->new(timeout => 10);
my @TARGETS = (
    'http://wiki.kyokugen.info/dq10/index.php?%C7%F2%CA%F5%C8%A2',      # アイテム   → モンスター
    #'http://dq10ragu.com/post-30011',                                  # モンスター → アイテム
);
my %parts = ();
my %mons = ();

foreach my $TARGET (@TARGETS) {
    my $content = eval { $ua->get($TARGET)->content; };
    $content = nkf('-w', $content) if $content;
    if ($content) {
        $content =~ s,^.*?<table>(.*)</table>.*$,$1,s;
        $content =~ s/\r?\n//g;

        my @matches = $content =~ m|<td.*?>(.*?)</td><td.*?>(.*?)</td>|g;
        my $idx = 0;
        for (my $idx = 0; $idx < $#matches; $idx += 2) {
            my $k = $matches[$idx];
            my $v = $matches[$idx + 1];
            if ($k and $v) {
                my @mons = split(/、|<br.*?>/, $v);
                $parts{$k} = join('、', sort @mons);

                foreach my $mon (@mons) {
                    if (ref $mons{$mon} ne 'ARRAY') {
                        $mons{$mon} = ();
                    }
                    push @{$mons{$mon}}, $k;
                }
            }
        }
    }
}

my @lines = ();
foreach my $key (sort keys %parts) {
    if ($key =~ /$word/) {
        push @lines, "${key}：$parts{$key}";
    }
}
foreach my $key (sort keys %mons) {
    if ($key =~ /$word/) {
        my $parts = join('、', sort @{$mons{$key}});
        push @lines, "${key}：${parts}";
    }
}

if (@lines) {
    print $#lines + 1;
    print join("\n", @lines);
} else {
    print "${word}：みつかりませんでした";
}