WWW::Mixi更新

2007年3月14日 13:00 false | 個別ページ | コメント(0) | トラックバック(0)| Edit
最近どうもPlaggerからMixiの足跡のメールが来ないな～と思っていたら、Mixiがページのデザインを変更していたようです。
そこで、WWW::Mixiを更新しました。
*** /usr/local/lib/perl5/site_perl/5.8.8/WWW/Mixi.pm.ORIG	Sat Jan  6 21:54:02 2007
--- /usr/local/lib/perl5/site_perl/5.8.8/WWW/Mixi.pm	Mon Mar 12 22:39:48 2007
***************
*** 1230,1236 ****
  	return unless ($content =~ /<img [^<>]*?src=["']?http:\/\/img.mixi.jp\/img\/q_yellow2.gif['"]?[^<>]*?>[^\r\n]*\n(.+?)\n[^\r\n]*?<img [^<>]*?src=["']?http:\/\/img.mixi.jp\/img\/q_yellow3.gif['"]?[^<>]*?>/s);
  	$content = $1;
  	# parse relation
! 	if ($content =~ s/<td ALIGN=center COLSPAN=3>(.*?)<table BORDER=0 CELLSPACING=0 CELLPADDING=1 BGCOLOR=#D3B16D>//s) {
  		my $relation_part = $1;
  		my @nodes = ($relation_part =~ /(<a href=show_friend.pl\?id=\d+>.*?<\/a>)/g);
  		$outline->{'step'} = @nodes;
--- 1230,1236 ----
  	return unless ($content =~ /<img [^<>]*?src=["']?http:\/\/img.mixi.jp\/img\/q_yellow2.gif['"]?[^<>]*?>[^\r\n]*\n(.+?)\n[^\r\n]*?<img [^<>]*?src=["']?http:\/\/img.mixi.jp\/img\/q_yellow3.gif['"]?[^<>]*?>/s);
  	$content = $1;
  	# parse relation
! 	if ($content =~ s/<td align="center" colspan="3">(.*?)<table border="0" cellspacing="0" cellpadding="1" bgcolor="#D3B16D">//s) {
  		my $relation_part = $1;
  		my @nodes = ($relation_part =~ /(<a href=show_friend.pl\?id=\d+>.*?<\/a>)/g);
  		$outline->{'step'} = @nodes;
***************
*** 1244,1252 ****
  		}
  	}
  	# parse image
! 	if ($content =~ s/<table BORDER=0 CELLSPACING=0 CELLPADDING=3 WIDTH=250 BGCOLOR=#FFFFFF>(.*?)<\/table>//s) {
  		my $image_part = $1;
! 		$outline->{'image'} = ($image_part =~ s/<img SRC="(.*?)".*?VSPACE=2.*?>//) ? $self->absolute_url($1, $base) : '';
  	}
  	# parse nickname
  	if ($content =~ s/([^\n]+)さん\((\d+)\)<br>\n<span class="f08x">\((.*?)\)<\/span><br>//) {
--- 1244,1252 ----
  		}
  	}
  	# parse image
! 	if ($content =~ s/<table border="0" cellspacing="0" cellpadding="3" width="250" bgcolor="#FFFFFF">(.*?)<\/table>//s) {
  		my $image_part = $1;
! 		$outline->{'image'} = ($image_part =~ s/<img src="(.*?)".*?vspace="2".*?>//) ? $self->absolute_url($1, $base) : '';
  	}
  	# parse nickname
  	if ($content =~ s/([^\n]+)さん\((\d+)\)<br>\n<span class="f08x">\((.*?)\)<\/span><br>//) {
***************
*** 1322,1328 ****
  	my $re_date = '(\d{4})年(\d{2})月(\d{2})日 (\d{1,2}):(\d{2})';
  	my $re_link = '<a href="?(.+?)"?>(.+?)<\/a>';
  	# get log part
! 	my $content_from = qq(\Q<ul class="log" style="margin: 0; padding: 0;">\E);
  	my $content_till = qq(\Q</ul>\E);
  	return $self->log("[warn] log part is missing.\n") unless ($content =~ /$content_from(.*?)$content_till/s);
  	$content = $1;
--- 1322,1328 ----
  	my $re_date = '(\d{4})年(\d{2})月(\d{2})日 (\d{1,2}):(\d{2})';
  	my $re_link = '<a href="?(.+?)"?>(.+?)<\/a>';
  	# get log part
! 	my $content_from = qq(\Q<ul class="log new_log" style="margin: 0; padding: 0;">\E);
  	my $content_till = qq(\Q</ul>\E);
  	return $self->log("[warn] log part is missing.\n") unless ($content =~ /$content_from(.*?)$content_till/s);
  	$content = $1;
***************
*** 1331,1337 ****
  	return $self->log("[warn] no log found in log part.\n") unless (@lines);
  	# parse each items
  	foreach my $line (@lines) {
! 		$line =~ /${re_date} (<a\b[^<>]*>)(.*)<\/a>/ or return $self->log("[warn] a tag, date or name in not found in '$line'.\n");
  		my $time = sprintf('%04d/%02d/%02d %02d:%02d', $1, $2, $3, $4, $5);
  		my $a    = $self->parse_standard_tag($6);
  		my $name = $self->rewrite($7);
--- 1331,1337 ----
  	return $self->log("[warn] no log found in log part.\n") unless (@lines);
  	# parse each items
  	foreach my $line (@lines) {
! 		$line =~ /${re_date} (<a\b[^<>]*>)([^<]*)<\/a>/ or return $self->log("[warn] a tag, date or name in not found in '$line'.\n");
  		my $time = sprintf('%04d/%02d/%02d %02d:%02d', $1, $2, $3, $4, $5);
  		my $a    = $self->parse_standard_tag($6);
  		my $name = $self->rewrite($7);
***************
*** 1422,1451 ****
  	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>';
! 	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, $desc) = (sprintf('%04d/%02d/%02d %02d:%02d', $1,$2,$3,$4,$5), $6, $7, $8);
! 			($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});
  		}
  		push(@items, $item);
  	}
  	return @items;
  }
  
  sub parse_view_diary {
  	my $self    = shift;
  	my $res     = (@_) ? shift : $self->response();
--- 1422,1491 ----
  	my $base    = $res->base->as_string;
  	my $content = $res->content;
  	my @items   = ();
+ 	my $re_comm = '<b>(\[.*?\]) トピック</b>';
  	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_no = '<b>(.*?[0-9]+?)</b>';
  	my $re_c_desc = '<td class="h120">(.+?)\n</td>';
  	my $re_link   = '<a href="?(.+?)"?>(.*?)<\/a>';
! 	if ($content =~ s/<!-- TOPIC: start -->.*?${re_comm}.*?${re_date}.*?${re_subj}.*?${re_link}(.*?)${re_desc}(.*?)$//is) {
! 		my ($community, $time, $subj, $link, $name, $imgs, $desc, $comm) = ($1, sprintf('%04d/%02d/%02d %02d:%02d', $2,$3,$4,$5,$6), $7, $8, $9, $10, $11, $12);
  		($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), 'community_name' => $community};
  		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_c_no}.*?${re_link}.*?${re_c_desc}.*?<\/table>//is){
! 			my ($time, $number, $link, $name, $desc) = (sprintf('%04d/%02d/%02d %02d:%02d', $1,$2,$3,$4,$5), $6, $7, $8, $9);
! #			($name, $desc) = map { s/[\r\n]+//g; s/<br>/\n/g; $_ = $self->rewrite($_); } ($name, $desc);
! 			my $comment = {'time' => $time, 'link' => $self->absolute_url($link, $base), 'name' => $name, 'description' => $desc, 'number' => $number, 'images' => []};
! 			push(@{$item->{'comments'}}, $comment);
! 			foreach my $image ($desc =~ /<td width="?130"?[^<>]*>(.*?)<\/td>/g) {
! 			    next unless ($image =~ /<img src=([^ ]*) border="?0"?>/);
! 			    push(@{$comment->{'images'}}, {'link' => $self->absolute_url($1, $base), 'thumb_link' => $self->absolute_url($1, $base)});
! 			}
  		}
  		push(@items, $item);
  	}
  	return @items;
  }
  
+ sub parse_view_enquete {
+ 	my $self    = shift;
+ 	my $res     = (@_) ? shift : $self->response();
+ 	return unless ($res and $res->is_success);
+ 	my $base    = $res->base->as_string;
+ 	my $content = $res->content;
+ 	my @items   = ();
+ 	my $re_comm = '<b>(\[.*?\]).*?</b>';
+ 	my $re_subj = '<td bgcolor=#ffffff width=530>(.+?)</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>(\d{1,2}):(\d{2})';
+ 	my $re_c_no = '<b>(.*?[0-9]+?)</b>';
+ 	my $re_c_desc = '<td class="h120">(.+?)</td>';
+ 	my $re_link   = '<a href="?(.+?)"?>(.*?)</a>';
+ 	if ($content =~ s/<td align=center colspan=2>.*?${re_comm}.*?${re_subj}.*?${re_desc}.*?${re_link}(.*?)$//is) {
+ 		my ($community, $subj, $desc, $link, $name, $comm) = ($1, $2, $3, $4, $5, $6);
+ #		($desc, $subj) = map { s/[\r\n]+//g; s/<br>/\n/g; $_ = $self->rewrite($_); } ($desc, $subj);
+ 		my $item = { 'description' => $desc, 'subject' => $subj, 'link' => $res->request->uri->as_string, 'comments' => [] , 'name' => $name, 'name_link' => $self->absolute_url($link, $base), 'community_name' => $community};
+ 		while ($comm =~ s/.*?${re_c_date}.*?${re_c_no}.*?${re_link}.*?${re_c_desc}.*?<\/table>//is){
+ 			my ($time, $number, $link, $name, $desc) = (sprintf('%04d/%02d/%02d %02d:%02d', $1,$2,$3,$4,$5), $6, $7, $8, $9);
+ #			($name, $desc) = map { s/[\r\n]+//g; s/<br>/\n/g; $_ = $self->rewrite($_); } ($name, $desc);
+ 			my $comment = {'time' => $time, 'link' => $self->absolute_url($link, $base), 'name' => $name, 'description' => $desc, 'number' => $number, 'images' => []};
+ 			push(@{$item->{'comments'}}, $comment);
+ 			foreach my $image ($desc =~ /<td width="?130"?[^<>]*>(.*?)<\/td>/g) {
+ 			    next unless ($image =~ /<img src=([^ ]*) border="?0"?>/);
+ 			    push(@{$comment->{'images'}}, {'link' => $self->absolute_url($1, $base), 'thumb_link' => $self->absolute_url($1, $base)});
+ 			}
+ 		}
+ 		push(@items, $item);
+         }
+ 	return @items;
+ }
+ 
  sub parse_view_diary {
  	my $self    = shift;
  	my $res     = (@_) ? shift : $self->response();
***************
*** 1463,1469 ****
  		my $level = { 'description' => $self->rewrite($2), 'link' => $self->absolute_url($1, $base) } if ($content =~ /<img src="([^"]+)" alt="([^"]+)" height="\d+" hspace="\d+" width="\d+">/);
  		($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' => [], 'level' => $level };
! 		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)});
  		}
--- 1503,1509 ----
  		my $level = { 'description' => $self->rewrite($2), 'link' => $self->absolute_url($1, $base) } if ($content =~ /<img src="([^"]+)" alt="([^"]+)" height="\d+" hspace="\d+" width="\d+">/);
  		($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' => [], 'level' => $level };
! 		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)});
  		}
***************
*** 1473,1479 ****
  			push(@{$item->{'comments'}}, {'time' => $time, 'link' => $self->absolute_url($link, $base), 'name' => $name, 'description' => $desc});
  		}
  		push(@items, $item);
! 	}
  	return @items;
  }
  
--- 1513,1519 ----
  			push(@{$item->{'comments'}}, {'time' => $time, 'link' => $self->absolute_url($link, $base), 'name' => $name, 'description' => $desc});
  		}
  		push(@items, $item);
!         }
  	return @items;
  }
  
***************
*** 1582,1588 ****
  	my $label_time = "(?:\Q日　付\E|\Q日&nbsp;付\E)";
  	my $label_name = "(?:\Q差出人\E|\Q宛&nbsp;先\E)";
  	my $label_subj = "(?:\Q件　名\E|\Q件&nbsp;名\E)";
! 	my $time  = sprintf('%04d/%02d/%02d %02d:%02d', $1, $2, $3, $4, $5) if ($content =~ /<$td>$s<font(?:$attr)*>$label_time<\/font>$s:$s(\d{4})年(\d{2})月(\d{2})日$s(\d{2}):(\d{2})<\/td>/is);
  	my $subj  = $self->rewrite($1) if ($content =~ /<$td>$s<font(?:$attr)*>$label_subj<\/font>$s:$s($str)<\/td>/is);
  	my $desc  = $self->rewrite($1) if ($content =~ /<td(?:$attr)*CLASS=h120(?:$attr)*>$s($str)<\/td>/is);
  	my $image = $self->absolute_url($1, $base) if ($content =~ /<$td><a(?:$attr)*><img(?:$attr)*src=["']?([^"'\s<>]+)["'](?:$attr)*><\/a><\/td>/is);
--- 1622,1628 ----
  	my $label_time = "(?:\Q日　付\E|\Q日&nbsp;付\E)";
  	my $label_name = "(?:\Q差出人\E|\Q宛&nbsp;先\E)";
  	my $label_subj = "(?:\Q件　名\E|\Q件&nbsp;名\E)";
! 	my $time  = sprintf('%04d/%02d/%02d %02d:%02d', $1, $2, $3, $4, $5) if ($content =~ /<$td>$s<font(?:$attr)*>$label_time<\/font>$s:$s(\d{4})年(\d{2})月(\d{2})日$s(\d{2})時(\d{2})分$s<\/td>/is);
  	my $subj  = $self->rewrite($1) if ($content =~ /<$td>$s<font(?:$attr)*>$label_subj<\/font>$s:$s($str)<\/td>/is);
  	my $desc  = $self->rewrite($1) if ($content =~ /<td(?:$attr)*CLASS=h120(?:$attr)*>$s($str)<\/td>/is);
  	my $image = $self->absolute_url($1, $base) if ($content =~ /<$td><a(?:$attr)*><img(?:$attr)*src=["']?([^"'\s<>]+)["'](?:$attr)*><\/a><\/td>/is);
***************
*** 2246,2251 ****
--- 2286,2298 ----
  	my $url  = shift or return;
  	$self->set_response($url, @_) or return undef;
  	return $self->parse_view_bbs();
+ }
+ 
+ sub get_view_enquete {
+ 	my $self = shift;
+ 	my $url  = shift or return;
+ 	$self->set_response($url, @_) or return undef;
+ 	return $self->parse_view_enquete();
  }
  
  sub get_view_community {
パッチはMixi.patch-20070314.tar.gzからダウンロードできます。
トラックバック(0)

このブログ記事を参照しているブログ一覧: WWW::Mixi更新
このブログ記事に対するトラックバックURL: https://www.wizard-limit.net/cgi-bin/mt/mt-tb.cgi/1160
コメントする

名前
メールアドレス
URL
ログイン情報を記憶
Gravatarにサインアップ(FREE)するとGravatarに対応したblogのコメントにあなたのアバターが表示されます。
このページは、falseが2007年3月14日 13:00に書いたブログ記事です。
ひとつ前のブログ記事は「Pin in the map」です。
次のブログ記事は「VMware Serverに乗り換え」です。
最近のコンテンツはインデックスページで見られます。過去に書かれたものはアーカイブのページで見られます。
WWW::Mixi更新

カテゴリ

トラックバック(0)

コメントする

検索

このブログ記事について

広告

PC日記 PCに関するもろもろもろ・・・	[HOME] [falseの雑記帳] [PC日記] [FF11日記] [Wiki]