2008/03/18


fukaz55さんの所に置いてあった「Amazon Web Services から情報を取得する blosxom 向けプラグイン」を貰ってきて AWSWORD:ほにゃらら: ※「ほにゃらら」は英数字もしくは「_」
と指定出来るようにした。
これまでの様に ASIN:4844322893 と書けば

となるし
AWSWORD:perl: と書けば
AWSWORD:perl:
となる。
結果は一覧されるうちの先頭で表示され、キャッシュは全件「検索語.xml」で保存される。ファイル名の都合で英数字+「_」が制限になってます。
なおblosxom::templateを使ってないのは、mobrowserと干渉しても構わないようにです。
パッチは以下の通り。
--- awsxom.orig Thu Nov 30 22:12:17 2006
+++ awsxom  Tue Mar 18 09:32:22 2008
@@ -57,17 +57,20 @@
 
    # ASIN/ISBNが書かれていたら置き換える
    # テンプレート指定版
-   s/(?:ASIN|ISBN):([A-Z0-9]{10}):(.*?):/to_html($1,$2)/ge;
+   s/(?:ASIN|ISBN):([A-Z0-9]{10}):(.*?):/to_html_asin($1,$2)/ge;
 
    # テンプレート無指定版
-   s/(?:ASIN|ISBN):([A-Z0-9]{10})/to_html($1,$default_template)/ge;
+   s/(?:ASIN|ISBN):([A-Z0-9]{10})/to_html_asin($1,$default_template)/ge;
+
+   # テンプレート無指定版
+   s/(?:AWSWORD):([a-zA-Z0-9_]*?):/to_html_word($1,$default_template)/ge;
 
    return $_;
 }
 
 # ---------------------------------------------------------------------
 # ASINからAmazonのアフィリエイト用HTMLを作成
-sub to_html {
+sub to_html_asin {
    my ($asin, $template) = @_; # ASINとテンプレ名称
    my $cache = "$cachedir/$asin.xml";
    my $url = "http://webservices.amazon.co.jp/onca/xml?Service=AWSECommerceService&SubscriptionId=$devkey&AssociateTag=$asoid&Operation=ItemLookup&ItemId=$asin&ResponseGroup=Medium,Offers";
@@ -90,8 +93,57 @@
    # テンプレートを展開。エラーの場合はエラー文字列を返す
    my $form;
    if (!defined($detail{"ErrorMsg"})) {
-       $form = &$blosxom::template($blosxom::path, $template, 'html');
-       $form =~ s/\$(\w+)/$detail{$1}/ge;
+       #$form = &$blosxom::template($blosxom::path, $template, 'html');
+        my $fh = new FileHandle;
+        if ($fh->open("< $blosxom::datadir/$template.html")) {
+            $form = join '', <$fh>;
+           $form =~ s/\$(\w+)/$detail{$1}/ge;
+            $fh->close();
+        }
+   }
+   else {
+       $form = "<p>" . $detail{"ErrorMsg"} . "</p>";
+   }
+
+   return $form;
+}
+
+# ---------------------------------------------------------------------
+# ASINからAmazonのアフィリエイト用HTMLを作成
+sub to_html_word {
+   my ($word, $template) = @_; # ASINとテンプレ名称
+   my $cache = "$cachedir/$word.xml";
+   my $url = "http://webservices.amazon.co.jp/onca/xml?Service=AWSECommerceService&SubscriptionId=$devkey&AssociateTag=$asoid&Operation=ItemSearch&Keywords=$word&SearchIndex=Books&ResponseGroup=Medium,Offers";
+   my $outfile = "$cachedir/$word.html";
+
+   # 取り込み直す必要はあるか?
+   if (!(-e $cache) || (-M $cache > ($EXPIRE / 24))) {
+   # AWSから情報を取得してキャッシュファイルに保存
+       # UserAgent初期化
+       my $ua = new LWP::UserAgent;
+       $ua->agent($ua_name);
+       $ua->timeout(60);
+       my $rtn = $ua->mirror($url, $cache);
+   }
+
+   # キャッシュからXMLを読み込んで解析
+   my $content = getFile($cache);
+    $content =~ s!.*?(<Item>.*?</Item>).*!$1!is;
+   my $asin = "";
+    $asin = $1 if ($content =~ /<ASIN>([^<]*)<\/ASIN>/);
+    return "" if !$asin;
+   my %detail = parseXML($content, $asin);
+
+   # テンプレートを展開。エラーの場合はエラー文字列を返す
+   my $form;
+   if (!defined($detail{"ErrorMsg"})) {
+       #$form = &$blosxom::template($blosxom::path, $template, 'html');
+        my $fh = new FileHandle;
+        if ($fh->open("< $blosxom::datadir/$template.html")) {
+            $form = join '', <$fh>;
+           $form =~ s/\$(\w+)/$detail{$1}/ge;
+            $fh->close();
+        }
    }
    else {
        $form = "<p>" . $detail{"ErrorMsg"} . "</p>";
ちなみに、先日図書館で見つけた本で面白いの見つけた。
子供向け絵本らしいが、ちょっと笑った。
Posted at by



2008/03/05


RPC-XML-Parser-LibXML をつくってみた - TokuLog 改め だまってコードを書けよハゲ
http://svn.coderepos.org/share/lang/perl/RPC-XML-Parser-Lite/

RPC::XML::Parser というのがあり、これは expat ベース。RPC::XML::Parser::XS というのがあるのだが、これは libxml を直接つかった XS なのだ。

さらにRPC::XML::Parser::LibXML も要コンパイルなのだ。

というわけで、ためしに XML::Parser::Lite::Tree と XML::Parser:Lite::Tree::XPath をつかったものを作ってみた。機能的には一緒 & インターフェースもいっしょにしてみた。

ただ、perlへたっぴなので誰か添削ぷりーず

※要は、id:tokuhirom のパクリなのだ。

Posted at by



2008/02/14


なんだかtwitterではハート祭りが繰り広げられている様で...
twitter-heart
どうやら「<3」でハートマークが付くようです。
今日はバレンタインデーって事で、こんなもん作ってみました。
WWW::Mechanize::AutoPagerでfriends全員をハッシュ一覧化し、Net::Twitterで全員にこのハートを送るperlスクリプトを作ってみました。
宜しければどうぞ!
って私はやりませんが...
※ちなみに本気でやるなら、ちゃんとsleep入れて下さいね。

#!/usr/bin/perl

use warnings;
use strict;
use WWW::Mechanize;
use WWW::Mechanize::AutoPager;
use Web::Scraper;
use Net::Twitter;

my $username = 'username';
my $password = 'password';

my $twitter_friends = scraper {
    process 'tr.vcard',
        'friends[]' => scraper {
            process 'td strong a', name => 'TEXT';
        };
    result 'friends';
};

my $u = 'http://twitter.com/friends/';

my $mech = WWW::Mechanize->new(timeout => 10);
$mech->add_header('Accept-Encoding', 'identity');
$mech->get('http://twitter.com/login');
$mech->submit_form(
    form_number => 2,
    fields    => {
        username_or_email  => $username,
        password           => $password,
    },
    button    => 'commit',
);

$mech->autopager->load_siteinfo();
my $friends;
while($u) {
    my $res = $twitter_friends->scrape( $mech->get($u)->content );
    eval { push @$friends, @{$res}; };
    last if ( $@ or !defined($mech->next_link) );
    $u = $mech->next_link;
}

my $twit = Net::Twitter->new( username => $username, password => $password );
foreach my $friend (@$friends) {
    my $name = $friend->{name};
    $result = $twit->update("\@$name <3");
}
って俺、男だ。
Posted at by