初めての Perl

本を読むだけじゃやっぱ飽きるので、わけわかんないなりにとりあえずなんか書いてみようと思ったものの、特に面白げなネタも思い浮かばない。そんな折り、IRC である方がいってたネタを思い出し、ちとやってみることに。ちなみにどんなネタかってのは諸事情により明言できません。って、スクリプトを見ればなにをやってるのかはすぐわかるんだけど…。

とゆか、なんか書いたっつっても、実際にはモジュール使いまくって、さらには以下の素晴らしいリソース群からコピペしたものを組み合わせただけなので、まったくお勉強になってないわけだが、ははは、ごめんなさい…。

mixi2rss.pl

#!/usr/bin/perl
#
# mixi2rss.pl
#   usage1: % perl mixi2rss.pl <mixi_id>
#   usage2: http://yourdomain/path/to/script/mixi_id
#
use strict;
use warnings;
use CGI;
use Jcode;
use HTML::TokeParser;
use WWW::Mechanize;
use Cache::FileCache;
use Template::Extract;
use XML::RSS;
my $base_uri = "http://mixi.jp/";
my $mail_address = "foo\@bar.com";
my $password = "password";
my $diary_path = "list_diary.pl?id=";
my $cache_expires = 60 * 60;
my $cache = new Cache::FileCache({
namespace => "mixi2rss",
default_expires_in => $cache_expires,
});
my $query = CGI->new;
my $id = $ARGV[0] || $query->path_info;
$id =~ s|^/||;
my $rss;
unless ($rss = $cache->get($id)) {
my $data = get_data($base_uri, $mail_address, $password, $diary_path, $id);
$rss = generate_rss($data, $base_uri, $diary_path, $id);
$cache->set($id => $rss);
}
print $query->header(-type => "application/xml; charset=UTF-8",),
Jcode->new($rss)->utf8;
sub get_data {
my ($base_uri, $mail_address, $password, $diary_path, $id) = @_;
my $mech = WWW::Mechanize->new();
$mech->agent_alias("Windows Mozilla");
$mech->get($base_uri);
$mech->form_number("1");
$mech->field("email", $mail_address);
$mech->field("password", $password);
$mech->submit();
$mech->get($base_uri.$diary_path.$id);
return $mech->content();
}
sub generate_rss {
my ($data, $base_uri, $diary_path, $id) = @_;
my $template;
while(<DATA>){$template .= $_;}
my $obj = Template::Extract->new;
my $ext = $obj->extract($template, $data);
my $rss = XML::RSS->new(
version => "1.0",
encode_output => 0,
);
$rss->channel(
title => $ext->{title},
link  => $base_uri.$diary_path.$id,
description => "mixi: $ext->{title} RSS feed - generated by mixi2rss.pl",
);
for my $item (@{$ext->{items}}) {
my $parser = HTML::TokeParser->new(\$item->{description});
$rss->add_item(
title => $item->{title},
link  => $base_uri.$item->{link},
description => $parser->get_trimmed_text("/br"),
);
}
return $rss->as_string;
}
__END__
<td WIDTH=490 BACKGROUND=img/bg_w.gif><b><font COLOR=#605048>[% title %]</font></b></td></tr>[% ... %]
[% FOREACH items %]
<tr VALIGN=top>
[% ... %]
<td bgcolor=#F2DDB7> [% title %]</td></tr>
[% ... %]
<table BORDER=0 CELLSPACING=0 CELLPADDING=3 WIDTH=410>
<tr>
[% description %]
</tr>
</table>
[% ... %]
<font COLOR=#F2DDB7>|</font> <a href="[% link %]">続きはこちら</a> <font COLOR=#F2DDB7></td></tr>
[% END %]

なんかダサい箇所がたくさんあるけど気にしない。てゆーか、cron でまわして RSS を複数個一挙に生成しまくるようにする方がいいということに気付いた。orz

Leave a Reply Cancel reply