ぶログ＠天狗屋敷.jp

# 写真も取得するように変更
sub parse_view_bbs {
	my $self    = shift;
	my $res     = (@_) ? shift : $self->response();
	my $res     = shift;
	return unless ($res and $res->is_success);
	my $base    = $res->base->as_string;
	my $content = $res->content;
	my @items   = ();
	my $re_date = '<td rowspan="3" width="110" bgcolor="#ffd8b0" align="center" valign="top" nowrap>(\d{4})年(\d{2})月(\d{2})日<br>(\d{1,2}):(\d{2})</td>';
	my $re_subj = '<td bgcolor="#fff4e0">&nbsp;(.+?)</td>';
	my $re_desc = '</table>(.+?)</td>';
	my $re_c_date = '<td rowspan="2" width="110" bgcolor="#f2ddb7" align="center" nowrap>\n(\d{4})年(\d{2})月(\d{2})日<br>\n(\d{1,2}):(\d{2})';
	my $re_c_desc = '<td class="h120">(.+?)\n</td>';
	my $re_link   = '<a href="?(.+?)"?>(.*?)<\/a>';

	my $re_phot  = '<a.+(show_bbs_comment_picture.pl\?bbs_id=\d+\&id=\d+\&number=\d+).*>';

	if ($content =~ s/<!-- TOPIC: start -->.*?${re_date}.*?${re_subj}.*?${re_link}(.*?)${re_desc}(.*?)$//is) {
		my ($time, $subj, $link, $name, $imgs, $desc, $comm) = (sprintf('%04d/%02d/%02d %02d:%02d', $1,$2,$3,$4,$5), $6, $7, $8, $9, $10, $11);
		($desc, $subj) = map { s/[\r\n]+//g; s/<br>/\n/g; $_ = $self->rewrite($_); } ($desc, $subj);
		my $item = { 'time' => $time, 'description' => $desc, 'subject' => $subj, 'link' => $res->request->uri->as_string, 'images' => [], 'comments' => [] , 'name' => $name, 'name_link' => $self->absolute_url($link, $base)};
		foreach my $image ($imgs =~ /<td width=130[^<>]*>(.*?)<\/td>/g) {
			next unless ($image =~ /<a [^<>]*'show_picture.pl\?img_src=(.*?)'[^<>]*><img src=([^ ]*) border=0>/);
			push(@{$item->{'images'}}, {'link' => $self->absolute_url($1, $base), 'thumb_link' => $self->absolute_url($2, $base)});
		}
		while ($comm =~ s/.*?${re_c_date}.*?${re_link}(.*?)${re_c_desc}.*?<\/table>//is){
			my ($time, $link, $name, $imgs, $desc) = (sprintf('%04d/%02d/%02d %02d:%02d', $1,$2,$3,$4,$5), $6, $7, $8, $9);

			my @comment_picture = ();
			my @comment_picture_small = ();
			foreach my $line ($desc =~ /<td width="130"[^<>]*.+<\/td>/ig) {
				$line =~ /<td width="130"[^<>]*><a.+(show_bbs_comment_picture.pl\?bbs_id=\d+\&id=\d+\&number=\d+).*><img src="(.+?)"[^<>]*><\/a><\/td>/isg;# ($1, $2);
				my ($large, $small) = ($1, $2);
				push(@comment_picture, 'http://mixi.jp/' . $large);
				push(@comment_picture_small, $small);
			}

			($name, $desc) = map { s/[\r\n]+//g; s/<br>/\n/g; $_ = $self->rewrite($_); } ($name, $desc);

			push(@{$item->{'comments'}}, {
					'time' => $time, 'link' => $self->absolute_url($link, $base), 'name' => $name, 'description' => $desc,
					'photos' => \@comment_picture,
					'thumbnails' => \@comment_picture_small
				}
			);
		}
		push(@items, $item);
	}
	return @items;
}

ハッシュの構造は、WWW::Mixiのドキュメントの記載に従うとこんな感じ。photosとthumbnailsを追加しています。

トピック（view_bbs.plのメイン部）を解析します。 返り値は、以下のようなハッシュリファレンスです。
{
	'link' => 'http://mixi.jp/view_bbs.pl?id=xxxxxx',
	'images' => [
		{
			'thumb_link' => 'http://img1.mixi.jp/photo/bbs/xx/xx/xxxxxxx_xxs.jpg',
			'link' => 'show_picture.pl?img_src=http://img1.mixi.jp/photo/bbs/xx/xx/xxxxxxx_xx.jpg'}
		},
	],
	'subject' => 'リリース情報',
	'time' => '2005/09/01 00:00',
	'name' => 'walrus',
	'name_link' => 'http://mixi.jp/show_friend.pl?id=xxxxx',
	'description' => 'リリース情報はこのトピックに掲載していきます。'
	'comments' => [
			{
				'photos'     => [ ], #写真の枚数だけ入ります。無ければ空の配列。
				'thumbnails' => [ ], #同上
				'link' => 'http://mixi.jp/show_friend.pl?id=xxxxx',
				'time' => '2005/09/01 05:34',
				'name' => 'walrus',
				'description' => '1.00版をリリースしました。'
			}
	]
}