#!/usr/bin/perl # flatbox.cgi: 自動箱保存オンライン by (滅) use Socket; &decode_query; ($host_and_port, $hako_path) = $FORM{'url'} =~ /^http:\/\/([^\/]+)(\/.*)/; &err('URLが不正です') if($host_and_port eq ""); ($host_name, $port_num) = split(':', $host_and_port); ($html_dir, $hako_num) = $hako_path =~ /^(.+)\/([^\/]+).html/; $list_cgi = "http://$host_and_port/$html_dir/"; $list_cgi =~ s/[^\/]+\/$/list.cgi/; #&err("$host_name\n$port_num\n$hako_path\n$html_dir\n$hako_num"); $prot = (getprotobyname('tcp'))[2]; $host = (gethostbyname($host_name))[4]; $port = ($port_num ne "") ? int($port_num) : 80; $sock = pack('S n a4 x8',AF_INET,$port,$host); $valid_votes = 0; # 有効投票数 $total_votes = 0; # 総投票数 socket(HAKO, PF_INET, SOCK_STREAM, $prot); connect(HAKO, $sock) || &err("$0: cannot connect to $host\n"); $_=select(HAKO); $|=1; select($_); print HAKO "GET $hako_path HTTP/1.0\r\n"; print HAKO "Host: $host_name\r\n"; print HAKO "Referer: $list_cgi\r\n"; print HAKO "\r\n"; &load_hako(); close(HAKO); #print "$vote_cgi\n"; #exit; $post_data = "allres=on&room=$hako_num"; $content_length = length($post_data); socket(ALL, PF_INET, SOCK_STREAM, $prot); connect(ALL, $sock) || &err("$0: cannot connect to $host\n"); $_=select(ALL); $|=1; select($_); print ALL "POST $vote_cgi HTTP/1.0\r\n"; print ALL "Host: $host_name\r\n"; print ALL "Content-Type: application/x-www-form-urlencoded\r\n"; print ALL "Content-Length: $content_length\r\n"; print ALL "Referer: $FORM{'url'}\r\n"; print ALL "\r\n"; print ALL "$post_data"; &load_all_log(); close(ALL); &sort_vote_titles; $hako_address = $FORM{'url'}; print "Content-Type: text/html; charset=Shift_JIS\r\n"; print "\r\n"; &print_head; &print_table; &print_comments; &print_foot; ############################################################################# #### cgi #### sub decode_query { my($buffer, $pair, $name, $value, $post, @pairs); if($ENV{'REQUEST_METHOD'} eq "POST"){ read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); $post = 1; }else{ $buffer = $ENV{'QUERY_STRING'}; $post = 0; } @pairs = split(/&/, $buffer); foreach $pair (@pairs) { ($name, $value) = split(/=/, $pair); $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $FORM{$name} = $value if($name && $value); } return $post; } sub err { my ($msg) = @_; print "Content-Type: text/plain; charset=Shift_JIS\r\n"; print "\r\n"; print "エラー: $msg\r\n"; exit(); } #### loading and parsing #### sub load_hako { while() { if (/(.*)<\/title>/i) { $hako_title = $1; } elsif (/^<div[^>]*>(.*)<\/div>/i) { $hako_time = $1; } elsif (/^<hr>(<a[^>]*><img[^>]*><\/a><br>)?(<pre>.*<\/pre>)/i) { # (...)? の部分は ivote 対応 my $img_tag = $1; $hako_comment = $2; if ($img_tag ne "") { $img_tag =~ s/href=\"([^\"]*)\"/<href>/i; my $href = &to_abs_path($1, $html_dir); $img_tag =~ s/<href>/href=\"http:\/\/$host_and_port$href\"/i; $img_tag =~ s/src=\"([^\"]*)\"/<src>/i; my $src = &to_abs_path($1, $html_dir); $img_tag =~ s/<src>/src=\"http:\/\/$host_and_port$src\"/i; $hako_comment = "$img_tag$hako_comment<br clear=\"all\">"; } } elsif ($hako_comment eq "" && /^(<font [^>]*>.*<\/font>)$/i) { # エロゲアン対応 $hako_comment = "<p>$1</p>"; } elsif (/^<a href=\"([^?]+)\?allres=on/i) { #print "detected: $1\n"; $vote_cgi = &to_abs_path($1, $html_dir); } elsif (/^<body +([^>]*)>/i) { $body_attributes = $1; } } if ($body_attributes eq "") { $body_attributes = 'bgcolor="#a1fe9f" text="#000000" link="#0000ff" vlink="#ff0000"'; } # print "$hako_title :$hako_time\n$hako_comment\n\n"; } sub to_abs_path { my ($url, $base) = @_; my $abs; if ($url =~ /^http:\/\/[^\/]+(\/.*)/) { $abs = $1; } elsif ($url =~ /^\/\//) { $abs = $url; } else { my @p = split('/', "$base/$url"); $abs = ""; for (my $i = $#p; $i >= 0; $i--) { my $elm = $p[$i]; if ($elm eq ".") { next; } elsif($elm eq "..") { $i--; next; } elsif($elm eq "") { next; } $abs = "/$elm$abs"; } } return $abs; } sub load_all_log() { while(<ALL>) { #($hako_address) = /^\[<a href=\"([^\"]+)\"/i if(/^\[<a/i); last if (/^<hr/i); } while(<ALL>) { if (/^<font/i || /^<b>/i) { $kou_valid = (/^<b>/i) ? 1 : 0; ($font_tag) = /^(<font[^>]*>)/i; # vote3改系での有効無効判定(色変えてたらダメ…) if (/^<font color=\"([^\"]+)\"/i) { $kou_valid = ($1 eq "#000000") ? 1 : 0; } ($kou_title, $kou_comment) = /<b>(.*)<\/b>.*(<pre>.*)$/i; if ($kou_title eq "") { # vote3系の非pre表示への対応 ($kou_title, $kou_comment) = /<b>(.*)<\/b><br><br>(<font.*)$/i; if ($kou_title eq "") { # エロゲアン対応 ($kou_title, $kou_comment) = /<b>(.*)<\/b>(<p><font.*)$/i; } } $kou_comment =~ s/<hr>//i; if ($votes{$kou_title} eq "") { $votes{$kou_title} = 0; } $all_votes{$kou_title}++; $total_votes++; if ($kou_valid == 1) { $votes{$kou_title}++; $valid_votes++; } else { $kou_comment = "$font_tag$kou_comment"; } if ($comments{$kou_title} eq "") { $comments{$kou_title} = []; } $list = $comments{$kou_title}; push @$list, $kou_comment; # print "item:$kou_title\ncomment:$kou_comment\n"; } } } sub sort_vote_titles { @sorted_titles = sort { $votes{$b} <=> $votes{$a} || $all_votes{$b} <=> $all_votes{$a} } keys %all_votes; } #### saving #### sub print_head { print <<"_HTML_"; <html> <head> <meta http-equiv="Content-type" content="text/html; charset=Shift_JIS"> <title>$hako_title
$hako_title

$hako_time


$hako_comment
現在のアンケート集計結果は以下のとおりです。
それぞれの選択項目をクリックするとコメントをみることができます。(古い投票順になっています。)
_HTML_ ; } sub print_table { print ''; print "\n"; print ''; print ''; print ''; print ''; print "\n"; $valid = -1; $rank = 0; $i = 0; foreach (@sorted_titles) { $i++; $kou_title = $_; $rank = $i if($valid != $votes{$_}); $valid = $votes{$_}; $total = $all_votes{$_}; # print "$_ : $valid ($total)\n"; print ""; print ""; print ""; $ratio = ($valid_votes == 0) ? 0 : int(100 * $valid / $valid_votes); $graph_width = $ratio * 3; $graph_width = 1 if ($graph_width < 1); print ""; print ""; print "\n"; } print "
順位選択項目有効票数(投票数)割合グラフ
$rank"; print "$kou_title"; print "$valid($total)$ratio%"; print "

\n"; print "有効投票総数$valid_votes票(投票総数$total_votes票)"; print "
\n"; } sub print_comments { #print "
\n"; $i = 0; foreach (@sorted_titles) { $i++; #print "

$_
\n

\n"; print "


"; print "$_\n

\n"; $list = $comments{$_}; $n = @$list; for($j = 0; $j < $n; $j++) { print "$$list[$j]\n"; print "
"; # if ($j + 1 != $n); } #print "
\n"; } #print "
\n"; } sub print_foot { print "
"; print "$hako_address から保存しました。"; print "
\n"; print "\n"; }