2007/07/23

[技術系]   update pingを受け取って何かを起動するCGIスクリプト

at 11:13JST
 
というのを適当にでっちあげている。

たとえばいま、このblogはn分おきにcronで更新チェックしてmixiに転載されたりしているが、これは非常にムダである。update pingを受け取ったときに更新チェックしに行くスクリプトを起動するようにしておけば省エネだ。これをタスクaとする。

もうひとつ。update pingを受け取ったらRSSを取得しにゆき、特定カテゴリの記事だけを蓄積してDB/RSS化するスクリプトもあれば便利だ。これをタスクbとする。

というわけで。しかし、

Weblogs.Com changes.xml を吐いたりする Ping サーバの Perl 実装 : NDO::Weblog
http://naoya.dyndns.org/~naoya/mt/archives/000444.html

あたりの事例のようにXMLRPCに沿ってマジメに書くのはいかにもメンドくさい。だって、weblogUpdates.pingのベーシックな中身って、
<?xml version="1.0"?> 
<methodCall>
<methodName>weblogUpdates.ping</methodName>
<params>
<param><value>testblog-blog</value></param>
<param><value>http://memo.hirosiki.jp/</value></param>
</params>
</methodCall>

こんだけなのだ。ムダきわまりない。そもそもXMLRPCキライだしね。

なので単純にPOSTで受け取って正規表現で更新サイトのURLを取得するだけにした。そのほか、もーほんとに適当に書き殴ってみる。

それでスクリプトの末尾に設定を
memo.hirosiki.jp	mailto	hoge@hoge.jp 
memo.hirosiki.jp !/var/net/www/hirosiki.jp/update.ping/something.to.exec

のように羅列しておくと、順に読んで処理してくれる。mailtoは更新通知メール送信コマンド。!のあとにパスを添えると外部コマンド起動。これでタスクaは完了。

で、タスクbのほう。とりあえず、
・更新通知を受ける
  ↓
・更新されたサイトからRSS auto discoveryでRSS URL取得
  ↓
・RSS取得
をやる。RSS auto discoveryももちろん正規表現で。この程度のことでTokeParserなんて使ってられるか。

…しかし、
・RSSを解析してローカルDBにストア
・特定カテゴリだけのRSSをストア
という処理で困った。
・RSS 1.0とRSS 2.0で大幅に仕様が違うので差異の吸収がめんどう
・パースがけっこうめんどう
うーん。しかし、ここでXML::RSSを使いたくないな…。そもそもXMLがキライだからな…。wellformedでないXMLを読むとショックで死ぬようなモジュール使えるか、ボケ。どうしようか。

以下、汚いスクリプト。
#!/usr/bin/perl 

use strict vars;
use Jcode;
use LWP::UserAgent;

my $req;
if ( $ENV{'REQUEST_METHOD'} eq 'POST' ) {
read( STDIN, $req, $ENV{'CONTENT_LENGTH'} );
} else {
FatalResponse( 503 );
}
=rem
* Seesaaでの例
<?xml version="1.0"?>
<methodCall>
<methodName>weblogUpdates.ping</methodName>
<params>
<param><value><string>testblog-blog</string></value></param>
<param><value><string>http://memo.hirosiki.jp/</string></value></param>
</params>
</methodCall>

* MovableTypeでの例
<?xml version="1.0"?>
<methodCall>
<methodName>weblogUpdates.ping</methodName>
<params>
<param><value>testblog-blog</value></param>
<param><value>http://memo.hirosiki.jp/</value></param>
</params>
</methodCall>
=cut

my $url =
( $req =~ m!<value>(?:<string>)?(http://.*?)(?:</string>)?</value>! )[0]
;

Response();

while ( <DATA> ) {
s/^\s+//;
s/\s+$//;
next if ( /^$/ || /^#/ );
my $name = ( split( /\t/, $_ ) )[0];
my $rest = $_;
$rest =~ s/^$name\t//;
my @args = split( /\t/, $rest );
my $cmd = shift @args;

next
if ( $url !~ m|^http://$name| );

if ( $cmd =~ s/^!// ) {
system( $cmd );
next;
}

my $cmdroutine = "__cmd_$cmd";
&$cmdroutine( $url, @args );
}

exit;

sub __cmd_mailto {
my @args = @_;
my $site = shift @args;

system( "echo '$site' | mail -s '[ping received] $site' $args[0]" );
}

sub __cmd_rssaddto {
my @args = @_;
my $site = shift @args;

my $cnt = GetRSS( $site )
or do {
Warn( "Could not get $site content" );
exit;
};
print STDERR substr( $cnt, 0, 20 ) . "\n";
}

sub GetRSS {
my $site = shift @_;

my $rssUrl = GetRSSURL( $site )
or return; # エラー
my $cnt = GetEucURL( $rssUrl )
or return; # エラー

return( $cnt );
}

sub GetRSSURL {
my $site = shift @_;

my $cnt = GetEucURL( $site )
or return; # エラー
my $rssUrl =
( $cnt =~ m|<link(?:.*)?type="application/rss\+xml"(?:.*)?href="(.*)"[^>]{0,}>|ig )[0]
;
return # エラー
if ( $rssUrl !~ /^http:/ );

return( $rssUrl );
}

sub Warn {
print STDERR shift @_;
}

sub GetEucURL {
my $url = shift @_;

my $refConf = shift @_;
my $timeout = 10;
my $max_size = 128;
if ( $refConf ) {
if ( $$refConf{timeout} ) {
$timeout = $$refConf{timeout};
}
if ( $$refConf{max_size} ) {
$max_size = $$refConf{max_size};
}
}

my $ua = LWP::UserAgent->new(
agent => 'Mozilla/4.0 (compatible; MSIE 6.0)',
timeout => $timeout,
max_size => $max_size * 1024,
);
my $response;
$response = $ua->get( $url )
or return; # エラー
return # エラー
if ( !$response->is_success );
my $eucContent;
$eucContent = jcode( $response->content )->h2z->euc;
return( $eucContent );
}

sub FatalResponse {
my $r = shift @_;
print "Response: $r\n\n";
exit;
}

sub Response {
my %params = (
flerror => 0,
message => 'Thanks for the ping',
@_,
);

print <<"_EOF_";
Content-Type: text/xml

<?xml version="1.0" encoding="UTF-8"?>
<methodResponse>
<params>
<param>
<value>
<struct>
<member>
<name>flerror</name>
<value>
<boolean>$params{'flerror'}</boolean>
</value>
</member>
<member>
<name>message</name>
<value>$params{'message'}</value>
</member>
</struct>
</value>
</param>
</params>
</methodResponse>
_EOF_
}

__DATA__
#memo.hirosiki.jp mailto hoge@hoge.jp
#memo.hirosiki.jp !/var/net/www/hirosiki.jp/update.ping/something.to.exec


そーす:update-ping.cgi
関連しそうな過去記事:
さらに過去の記事
2009/04 (1)   2008/12 (3)   2008/11 (9)   2008/10 (10)   2008/09 (20)   2008/08 (2)   2008/07 (23)   2008/06 (16)   2008/05 (22)   2008/04 (11)   2008/03 (21)   2008/02 (20)   2008/01 (21)   2007/12 (32)   2007/11 (37)   2007/10 (46)   2007/09 (63)   2007/08 (33)   2007/07 (41)   2007/06 (81)   2007/05 (173)   2007/04 (168)   2007/03 (113)   2007/02 (123)   2007/01 (92)   2006/12 (111)   2006/11 (185)   2006/10 (20)  
×

この広告は1年以上新しい記事の投稿がないブログに表示されております。