Changeset 20015 for lang/perl/tiarra

Timestamp:

09/27/08 11:45:04 (5 years ago)

Author:

hio

Message:

血液型ゲノムの見出し抽出を追加.

Files:

• lang/perl/tiarra/trunk/module/Auto/FetchTitle/Plugin/ExtractHeading.pm (modified) (1 diff)

lang/perl/tiarra/trunk/module/Auto/FetchTitle/Plugin/ExtractHeading.pm

@@ -461 +461 @@
       extract    => qr{<img src="../../images/recipes/drink/re_name\d+.gif" alt="(.*?)" width=".*?" height=".*?">}s,
     },
+    {
+      # 30a. 血液型ゲノム.
+      url        => 'http://blood-genome.com/d/92008/*',
+      extract    => qr{<h2>(.*?)</table>}s,
+    },
+    {
+      # 30b. 血液型ゲノム(相性).
+      url        => 'http://blood-genome.com/c/92008/*',
+      extract    => sub{
+        my ($point)  = m{<h2>(.*?)</h2>}s;
+        my ($compat) = m{<div class=infw>(.*?)</div>}s;
+        $compat =~ s/^(.*?。).*。(.*?。)/$1...$2/;
+        "$point, $compat";
+      },
+    },
   ];
   $config;