2007/02/13

[技術系]   comment2rss

at 12:34JST
 
Seesaaのコメント通知機能がどこかで詰まってたので、どうせなら…と思って
「コメント管理画面を参照してRSSを吐く」
スクリプトを書いた。

+index.cgi =このスクリプト

+data/ =処理用ディレクトリ(0777)
  |
  +index.rdf=キャッシュ。ここにリダイレクトされる

というふうに。

キャッシュとかあとで考えたのでひたすら汚いけど。mod_perlで順調に動いているようだし、もうちょっとようすみたら一般公開しよう。

#!/usr/bin/perl 

# comment2rss.cgi

use strict;
use WWW::Mechanize;
# I need Crypt:SSLeay.

# install Crypt::SSLeay on Win32(ActivePerl):
# > ppm install http://theoryx5.uwinnipeg.ca/ppms/Crypt-SSLeay.ppd
# or on Fedora:
# % sudo yum install openssl-devel

my $site = 'サイトFQDN';
my $mailaddr = 'メールアドレス(アカウント名)';
my $password = 'パスワード';
my $blogid = 'blogのID';

my $URL_INIT = 'http://blog.seesaa.jp/pages/my/home/index';
my $DATA_DIR = 'data';
my $LOCK_DIR = "$DATA_DIR/lock";

my $rdffile = "$DATA_DIR/index.rdf";
umask 0;
$|=1;

die if ( ( ! -d $DATA_DIR ) || ( ! -w $DATA_DIR ) );

if ( ( -r $rdffile ) && ( ( ( -M $rdffile ) * 24 * 60 ) < 15 ) ) {
RedirectTo( $rdffile );
}

mkdir( $LOCK_DIR, 0777 )
or RedirectTo( $rdffile );

my $table;
if (
! (
$table = GetCommentTable(
$URL_INIT,
$site, $mailaddr, $password, $blogid,
)
)
) {
rmdir $LOCK_DIR;
RedirectTo( $rdffile );
}
my @entries = ParseComments( $table );
my $rss = CommentsToRSS( $site, @entries );

print <<"_EOF_RSS";
Content-Type: application/xml

$rss
_EOF_RSS

my $tmpfile = "$DATA_DIR/tmp.$$";
if ( !open( W, ">$tmpfile" ) ) {
rmdir $LOCK_DIR;
RedirectTo( $rdffile );
}
print W $rss;
close( W );

rename( $tmpfile, $rdffile );
rmdir $LOCK_DIR;
exit;

sub RedirectTo {
my( $file ) = @_;
my $basepath =
'http://'
. $ENV{'HTTP_HOST'}
. ( ( $ENV{'SERVER_PORT'} != '80' ) ? ":$ENV{'SERVER_PORT'}" : '' )
. $ENV{'SCRIPT_NAME'}
;
$basepath =~ s#[^/]+$##;
print "Location: $basepath$file\n\n";
exit;
}

# コメントテーブル取得
sub GetCommentTable {
my( $URL_INIT, $site, $mailaddr, $password, $blogid ) = @_;

my $mech = WWW::Mechanize->new( autocheck => 1 );
$mech->agent_alias( 'Windows IE 6' );

# 初期画面
$mech->get( $URL_INIT )
or return undef;

# ログイン
$mech->submit_form(
fields =>
{
'member__email' => $mailaddr,
'member__password' => $password,
}
) or return undef;
while (
$mech->response()->header('refresh') =~ /url=([^\s;]+)/i
) {
$mech->get( $1 )
or return undef;
}

# 「コメント一覧」
$mech->follow_link(
url =>
"/pages/my/blog/home/?blog_id=$blogid" .
"&goto=/pages/my/blog/comment/edit/list"
) or return undef;

my $table = $mech->content();
$table =~
s#^.*<table[^>]+class="list-table">(.*)</form>.*$#$1#s;
return $table;
}

# コメント取得
sub ParseComments {
my( $table ) = @_;

my @t = localtime();
my $year = $t[5]+1900;
my $month = $t[4]+1;

my @entries;
foreach my $i ( $table =~ m#<tr>.*?</tr>#sg ) {
my( $id, $name, $date, $comment, $url, $art ) =
( $i =~ m|
<td[^>]+>.*?value="(.*?)"></td>
#id
\s+
<td[^>]+><a\s+href[^>]+>(.*?)</a></td>
#name
\s+
<td[^>]+>.*?</td>
\s+
<td[^>]+>.*?</td>
\s+
<td[^>]+>(.*?)</td>
#date
\s+
<td[^>]+>(.*?)</td>
#comment
\s+
<td[^>]+>.*?</td>
\s+
<td[^>]+>
<a\shref="(.*?)"
#url
.*?title="(.*?)"
#art
.*?</td>
|sx );
next if ( $id < 1 );

$name =~ s/<.*?>//;
my( $mm, $dd, $tt ) =
( $date =~ m#(..)/(..)\s+(.*)# );
my $thisYear = $year;
$thisYear-- if ( $mm>$month );
$date = "${thisYear}-${mm}-${dd}T${tt}:00+09:00";

push( @entries,
{
entry => "$url?$id#comment",
url => "$url#comment",
date => $date,
title => "$name on $art",
description => $comment,
}
);
}
return @entries;
}

sub CommentsToRSS {
my( $site, @entries ) = @_;

my $rss = <<"_EOF";
<?xml version="1.0" encoding="Shift_JIS"?>
<rdf:RDF
xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
xmlns:dc="http://purl.org/dc/elements/1.1/"
xmlns="http://purl.org/rss/1.0/"
>
<channel
rdf:about="http://$site/"
>
<title>$site</title>
<link>http://$site/</link>
<description>Comments on $site</description>
<dc:language>ja</dc:language>
<items>
<rdf:Seq>
@{[ do {
my $t;
foreach my $h ( @entries ) {
$t .= <<"_EOF_toc";
<rdf:li rdf:resource="$h->{entry}"/>
_EOF_toc
}
$t;
} ]}
</rdf:Seq>
</items>
</channel>
@{[ do {
my $t;
foreach my $h ( @entries ) {
$t .= <<"_EOF_entries";
<item
rdf:about="$h->{entry}"
>
<link>$h->{url}</link>
<title>$h->{title}</title>
<description>$h->{description}</description>
<dc:date>$h->{date}</dc:date>
</item>
_EOF_entries
}
$t;
} ]}
</rdf:RDF>
_EOF
return $rss;
}



関連しそうな過去記事:
さらに過去の記事
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)  
×

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