アクセス規制情報取得CGI「またかよ」

投稿：2010-04-22

解説

2ちゃんねるの「まだかな」は全プロバイダの規制情報を表示するため、ベクたん(vectant.ne.jp)の情報を探すのが一苦労です。ベクたんは、他のプロバイダに回線を貸しているので、規制の頻度が多く、自分のプロバイダ以外でベクたんの規制情報を把握したい場合に個数が2桁になることもあるので手間がかかります。その辺の事情はVectantのホスト名をご覧ください。ベクたんズ(Vectantから回線を借りたプロバイダの会員)がアクセス規制を容易に参照できるCGI「またかよ」を作成しました。上のリンクに規制情報の一覧を入れていますけれど、実はそれが「またかよ」です。
CGIのソースはこちら。

#!/usr/bin/perl -w

use LWP::UserAgent;

$| = 1;

$htmlcache = '/home/olfa/www/matakayo.html';

my $SEM_UNDO = 0x1000;
my $IPC_KEY = 1234;
my $id = semget($IPC_KEY, 0, 0);

my $semop = pack("sss", 0, -1, $SEM_UNDO);
semop($id, $semop);


my @outhtml = get_html();
foreach $item (@outhtml)
{
    print "$item\n";
}


$semop = pack("sss", 0, 1, $SEM_UNDO);
semop($id, $semop);



sub get_html
{
    my @outhtml = ();
    if ((stat($htmlcache))[9] + 60 < time())
    {
        @outhtml = create_html();
        if (open(OUTHTML, '>' . $htmlcache))
        {
            foreach $item (@outhtml)
            {
                print OUTHTML "$item\n";
            }
            close(OUTHTML);
        }
    }
    elsif (open(OUTHTML, '<' . $htmlcache))
    {
        @outhtml = <OUTHTML>;
        close(OUTHTML);
        chomp(@outhtml);
    }
    else
    {
        sleep(10);
        @outhtml = create_html();
    }

    return @outhtml;
}



sub create_html
{
    my @outhtml = out_head();

    my @kisei_list = get_kisei_list();

    my %vectant_list = filter_vectant(@kisei_list);

    my @sorted_rex = sorted_key(\%vectant_list);

    foreach $item (@sorted_rex)
    {
        my $date_stamp = $vectant_list{$item}{'date'};
        push(@outhtml, "<TR><TD>$date_stamp</TD><TD>$item</TD></TR>");
    }
    
    push(@outhtml, out_tail());

    return @outhtml;
}



sub out_head
{
    my($second, $minute, $hour, $day, $month, $year) = localtime();
    $month++;
    $year += 1900;

    $month = sprintf("%02d", $month);
    $day = sprintf("%02d", $day);
    $hour = sprintf("%02d", $hour);
    $minute = sprintf("%02d", $minute);
    $second = sprintf("%02d", $second);

    my @outhtml = <<"EOL";
Content-type: text/html

<HTML>
<BODY>
<TABLE BORDER="1">
<CAPTION>matakayo.cgi for Vectant at $year/$month/$day $hour:$minute:$second</CAPTION>
<TR><TH>Date</TH><TH>Rex Pattern</TH></TR>
EOL

    chomp(@outhtml);
    return @outhtml;
}



sub out_tail
{
    my @outhtml = <<'EOL';
</TABLE>
</BODY>
</HTML>
EOL

    chomp(@outhtml);
    return @outhtml;
}



sub get_kisei_list
{
    my $ua = LWP::UserAgent->new;
    my $req = HTTP::Request->new(GET => 'http://qb6.2ch.net/_403/madakana.cgi');
    $req->header('Accept' => 'text/html');

    my $res = $ua->request($req);

    my @kisei_list = ();

    if ($res->is_success)
    {
        @kisei_list = split(/\n/, $res->content);
    }

    return @kisei_list;
}



sub filter_vectant
{
    my %vectant = ();
    my $kisei_start = 0;
    my $date_stamp = '';

    foreach $linebuff (@_)
    {
        if ($linebuff =~ /#########/)
        {
            $kisei_start = 1;
        }
        elsif (!$kisei_start)
        {
        }
        elsif ($linebuff =~ m#(\d+)/(\d+).*http://#)
        {
            $date_stamp = sprintf("%02d/%02d", $1, $2);
        }
        elsif ($linebuff =~ /^#/)
        {
        }
        elsif ($linebuff =~ /vectant/)
        {
            $linebuff =~ s/<[^>]*>//g;
            $vectant{$linebuff}{'date'} = $date_stamp;
        }
    }

    return %vectant;
}



sub sorted_key
{
    my $kisei = shift(@_);
    my @rex_pattern = sort {$kisei->{$b}{'date'} cmp $kisei->{$a}{'date'}} keys(%$kisei);

    return @rex_pattern;
}