Changeset 1957 for lang/perl/WWW-CommentGetter

Timestamp:

11/24/07 10:00:37 (6 years ago)

Author:

tokuhirom

Message:

CommentGetter: split siteinfo to sharedir.

Location:

lang/perl/WWW-CommentGetter/trunk/WWW-CommentGetter

Files:

• Makefile.PL (modified) (1 diff)
• lib/WWW/CommentGetter.pm (modified) (2 diffs)
• share (added)
• share/siteinfo.json (added)

lang/perl/WWW-CommentGetter/trunk/WWW-CommentGetter/Makefile.PL

@@ -3 +3 @@
 all_from 'lib/WWW/CommentGetter.pm';
 
-requires 'YAML::Syck';
-requires 'Path::Class';
-requires 'Web::Scraper';
-requires 'URI';
-requires 'Module::Pluggable::Fast';
+requires 'HTTP::Response::Encoding';
+requires 'LWP::UserAgent';
+requires 'HTML::TreeBuilder::XPath';
+requires 'File::ShareDir';
+requires 'JSON::Any';
 
 build_requires 'Test::More';
+install_share;
 use_test_base;
 auto_include;

lang/perl/WWW-CommentGetter/trunk/WWW-CommentGetter/lib/WWW/CommentGetter.pm

@@ -7 +7 @@
 use LWP::UserAgent;
 use HTML::TreeBuilder::XPath;
+use File::ShareDir 'module_file';
+use JSON::Any;
 
 our $VERSION = '0.01';
@@ -15 +17 @@
 }
 
-my $siteinfos = [
-    {
-        url        => '^http://yaplog\.jp/.*',
-        context    => '//div[@class="message"]',
-        attributes => {
-            body  => '/div[@class="message_txt"]',
-            date  => '/div[@class="right s"]',
-            title => '/div[@class="message_title"]'
-        },
-    },
-    {
-        url        => '^http://blogs\.yahoo\.co\.jp/.*',
-        context    => '//p[@class="comentBody"]',
-        attributes => { body => '/text()', },
-    },
-    {
-        url        => '^http://.+\.seesaa\.net/.*',
-        context    => '//div[@class="comments-body"]/*[@class="text"]',
-        attributes => { body => '/text()', },
-    },
-    {
-        url        => '^http://[^/.]+\.nowa\.jp/.*',
-        context    => 'id("comment")/dl[@class="article-comment"]',
-        attributes => {
-            author => '/dd[@class="comment-author-name"]',
-            date   => '/dd[@class="comment-author-day"]',
-            body   => '/dd[@class="comment-body"]',
-        }
-    },
-    {
-        url        => '^http://blog.livedoor.jp/.*',
-        context    => '//div[@class="commentttl"]',
-        attributes => {
-            author => 'substring(/text(), 14)',
-            date   => '/span',
-            body   => '/following-sibling::div[@class="commenttext"][1]'
-        },
-    },
-    {
-        url => '^http://d.hatena.ne.jp.*',
-        context =>
-            '//div[@class="commentshort"]/p[@class!="commentmessage"]',
-        attributes => {
-            author => '//span[@class="commentator"]',
-            body   => '//span[@class="commentbody"]',
-            date   => '//span[@class="timestamp"]',
-        }
-    },
-    {
-        url        => '^http://blog\.goo\.ne\.jp/.*',
-        context    => '//td[@class="cmBody"]',
-        attributes => { body => '/text()', },
-    },
-    {
-        url => '^http://.*\.cocolog-nifty\.com/.*',
-        context =>
-            '//div[@class="comment-body" or @class="comment-content"]',
-        attributes => { body => '/p', }
-    },
-    {
-        url        => '^http://ameblo.jp/.*',
-        context    => '//div[@class="each_comment"]',
-        attributes => {
-            title  => 'substring(//p[@class="label"], 2)',
-            body   => '//p[@class="comment_body"]',
-            author => '//span[@class="comment_author"]',
-        },
-    },
-    {
-        url        => '^http://.*.jugem.jp/.*',
-        context    => '//dt[@class="com_desc"]',
-        attributes => {
-            body   => '/text()',
-            author => '/following-sibling::dd[1]/ul/li[1]',
-            date   => '/following-sibling::dd[1]/ul/li[2]',
-        },
-    }
-];
+sub _load_site_info {
+    my $self = shift;
+    $self->{__siteinfos} ||= do {
+        my $fname = module_file(__PACKAGE__, 'siteinfo.json');
+
+        open my $fh, '<', $fname or die $!;
+        my $src = do { local $/; join '', <$fh> };
+        close $fh;
+
+        JSON::Any->jsonToObj($src);
+    };
+}
 
 sub get {
     my ($self, $url) = @_;
 
+    my $siteinfos = $self->_load_site_info;
     for my $siteinfo (@$siteinfos) {
         my $ret = scrape_by_siteinfo($url => $siteinfo);