あなたの情報（IP確認君 VIA ip.dtpwiki.jp）

#!/usr/bin/perl

use strict;
use warnings;
use CGI;
use File::Spec;
use FindBin; # mod_perl環境じゃない場合
#use FindBin::Real; # mod_perlなど
use HTML::Template;
use Time::Piece;
use CGI::Carp qw(fatalsToBrowser);

my $q = CGI->new();
my $t = HTML::Template->new( filehandle => *DATA , loop_context_vars => 1 );

# 表示項目、order
my @keys = qw (
  DATE_LOCAL
  HTTP_HOST 
  SERVER_PORT
  REMOTE_ADDR
  REMOTE_PORT
  HTTP_X_FORWARDED_FOR
  REMOTE_HOST
  HTTP_USER_AGENT
  HTTP_ACCEPT_LANGUAGE
  HTTP_FORWARDED
  REMOTE_USER 
  REMOTE_IDENT
  HTTP_COOKIE
  HTTP_REFERER
  HTTP_VIA
  PROXY_CONNECTION
  REQUEST_METHOD
  CONTENT_TYPE
  CONTENT_LENGTH
  HTTP_X_LOCKING
  HTTP_FROM
  HTTP_ACCEPT_ENCODING
  HTTP_ACCEPT
);

# 辞書
my $dict = {
  'DATE_LOCAL'      => { item    => '情報を取得した時間', },
  'HTTP_HOST'       => { item    => '現在接続しているサーバのホスト名',
                         comment => 'httpサーバのドメイン名', },
  'SERVER_PORT'     => { item    => '現在接続しているサーバのポート',
                         comment => 'httpサーバのポート（80番に設定されていることが多い）', },
  'REMOTE_ADDR'     => { item    => '現在接続している場所（現IP）',
                         comment => '（REMOTE_ADDR）', big => 1, },
  'REMOTE_PORT'     => { item    => '現在接続している場所のポート',
                         comment => 'クライアント側のポートは高次ポートになることが多い', },
  'HTTP_X_FORWARDED_FOR'   => { item    => '現在接続している場所（元IP）',
                         comment =>  '（FORWARDED_FOR）', },
  'REMOTE_HOST'     => { item    => 'プロバイダー名',
                         comment =>  'クライアントホスト名（REMOTE_HOST）',
                         big     => 1, },
  'HTTP_USER_AGENT' => { item    => 'ブラウザーとOS',
                         comment => '閲覧者のWeb Browserの種別（HTTP_USER_AGENT）', },
  'HTTP_ACCEPT_LANGUAGE' => {item => 'サポート言語',
                         comment => 'jaまたはJPNで日本語サポート', },
  'HTTP_FORWARDED'  => { item    => 'クライアントの場所',
                         comment => '（HTTP_FORWARDED）', },
  'REMOTE_USER'     => { item    => 'クライアントID',
                         comment => 'BASIC認証を経由していれば表示', },
  'REMOTE_IDENT'    => { item    => 'ユーザ名',
                         comment => 'RFC1413認証（IDENT）をサポートしていれば表示', },
  'HTTP_COOKIE'     => { item    => 'クッキー',
                         comment => 'アクセスの度このサーバにCookieの内容を送信しています', },
  'HTTP_REFERER'    => { item    => 'どこのURLから来たか',
                         comment => '直接URLを指定した場合は表示されない （HTTP_REFERER）', },
  'HTTP_VIA'        => { item    => 'proxyのバージョン等', comment => '（HTTP_VIA）', },
  'PROXY_CONNECTION'=> { item    => 'proxyの効果', comment => '（PROXY_CONNECTION）', },
  'REQUEST_METHOD'  => { item    => 'FORMの情報',
                         comment => 'データの入力方法 (GET or POST)', },
  'CONTENT_TYPE'    => { item    => 'FORMのタイプ',
                         comment => 'Serverに送るMIMEタイプ', },
  'CONTENT_LENGTH'  => { item    => 'FORMのバイト数',
                         comment => 'Serverに送るバイト数', },
  'HTTP_ACCEPT_ENCODING' => {item => 'エンコードの仕様',
                         comment => 'サーバ側が対応していればデータ転送量が減ります', },
  'HTTP_ACCEPT'     => { item    => 'MIMEの仕様', },
};

# テーブル用データ用意
my @items;
my $time = localtime();
$ENV{DATE_LOCAL} = $time->strftime('%Y年 %m月 %d日 　%p　 %H時 %M分 %S秒');
$ENV{REMOTE_HOST} = gethostbyaddr(pack("C4", split('\.', $ENV{REMOTE_ADDR})), 2) || $ENV{REMOTE_ADDR};
#foreach my $key ( keys %ENV ) { # 環境変数全部表示する時はこちらを生かす
foreach my $key ( @keys ) {
  my $hash = {
    key     => $key,
    item    => ( $dict->{$key}->{item} or $key ),
    value   => $ENV{$key},
    comment => $dict->{$key}->{comment},
  };
  $hash->{big} = 1 if $dict->{$key}->{big};
  push @items, $hash;
}

# テンプレート適用
$t->param( items => \@items );
$t->param( HTTP_HOST => $ENV{HTTP_HOST} );
#my $source = read_file( FindBin::Real::Script() ); # Findbin::Realのとき
my $source = read_file( File::Spec->catfile( $FindBin::RealBin, $FindBin::Script ) ); #FindBinのとき
$t->param( source => $source );
print $q->header( -type => 'text/html', -charset => 'UTF-8');
print $t->output();

sub read_file {
  my $filename = shift;
  open my $fh, '<', $filename or die $!;
  my $data = do { local $/; <$fh> };
  close $fh;
  return $data;
}

exit;

# CentOS 6
# yum install perl-CGI perl-HTML-Template perl-Time-Piece

# 以降HTML::Template用テンプレート
__DATA__
<!DOCTYPE html>
<html>
  <head>
    <meta charset="UTF-8">
    <title>IP確認君（VIA <tmpl_var escape="html" name="HTTP_HOST">）</title>
    <script type="text/javascript" src="scripts/shCore.js"></script>
    <script type="text/javascript" src="scripts/shBrushPerl.js"></script>
    <link type="text/css" rel="stylesheet" href="styles/shCoreDefault.css">
    <link type="text/css" rel="stylesheet" href="styles/shThemeDefault.css">
    <script type="text/javascript">SyntaxHighlighter.all();</script>
    <!--[if lt IE 9]>
    <script src="/IE9.js"></script>
    <![endif]-->

    <style>
header h1 {
  margin: 20px auto;
  text-align: center;
  width: 50%;
  font-size: large;
  padding: 4px;
  font-weight: normal;
  -webkit-border-radius: 12px;
  -moz-border-radius: 12px;
  border-radius: 12px;
}
header h1, thead th {
  background: #721C38;
  background: -webkit-gradient(linear, 0 0, 0 bottom, from(#721C38), to(#1F0A11));
  background: -webkit-linear-gradient(#721C38, #1F0A11);
  background: -moz-linear-gradient(#721C38, #1F0A11);
  background: -ms-linear-gradient(#721C38, #1F0A11);
  background: -o-linear-gradient(#721C38, #1F0A11);
  background: linear-gradient(#721C38, #1F0A11);
  -pie-background: linear-gradient(#721C38, #1F0A11);
  behavior: url(/PIE.htc);
  color: white;
}
article {
  padding: 20px;
}
table {
  margin: 20px auto;
  border: 2px solid white;
  border-collapse: collapse;
}
td, th {
  border: 2px solid white;
  padding: 4px;
  color: #333;
  font-size: small;
}
tbody th, tbody td {
  background: #FBCAD9;
  background: -webkit-gradient(linear, 0 0, 0 bottom, from(#FEF6F8), to(#FBCAD9));
  background: -webkit-linear-gradient(#FEF6F8, #FBCAD9);
  background: -moz-linear-gradient(#FEF6F8, #FBCAD9);
  background: -ms-linear-gradient(#FEF6F8, #FBCAD9);
  background: -o-linear-gradient(#FEF6F8, #FBCAD9);
  background: linear-gradient(#FEF6F8, #FBCAD9);
  -pie-background: linear-gradient(#FEF6F8, #FBCAD9);
  behavior: url(/PIE.htc);
  text-align: left;
}
.even th, .even td {
  background: #DDDDDD;
  background: -webkit-gradient(linear, 0 0, 0 bottom, from(#FFFFFF), to(#DDDDDD));
  background: -webkit-linear-gradient(#FFFFFF, #DDDDDD);
  background: -moz-linear-gradient(#FFFFFF, #DDDDDD);
  background: -ms-linear-gradient(#FFFFFF, #DDDDDD);
  background: -o-linear-gradient(#FFFFFF, #DDDDDD);
  background: linear-gradient(#FFFFFF, #DDDDDD);
  -pie-background: linear-gradient(#FFFFFF, #DDDDDD);
  behavior: url(/PIE.htc);
}
tbody th  {
  font-weight: normal;
}
tbody td {
  color: #800040;
}
tbody td.big {
  font-size: x-large;
  font-weight: bold;
}
    </style>
  </head>
  <body>
    <header>
      <h1>あなたの情報（IP確認君 VIA <tmpl_var name="HTTP_HOST">）</h1>
    </header>
    <article>
      <table>
        <thead>
          <tr>
            <th>取得項目</th>
            <th style="letter-spacing: 1em;">情報</th>
            <th style="letter-spacing: 1em;">解説</th>
          </tr>
        </thead>
        <tbody>
          <tmpl_loop name="items">
          <tr<tmpl_unless name="__odd__"> class="even"</tmpl_unless>>
            <th title="<tmpl_var escape="html" name="key" >">
              <tmpl_var escape="html" name="item">
            </th>
            <td<tmpl_if name="big"> class="big"</tmpl_if>>
              <tmpl_var escape="html" name="value" default="(none)">
            </td>
            <th>
              <tmpl_var escape="html" name="comment">
            </th>
          </tr>
          </tmpl_loop>
        </tbody>
      </table>
    </article>
    <article style="padding-left: 0px;">
      <pre class="brush: perl;">
<tmpl_var escape="html" name="source">
</pre>
    </article>
  </body>
</html>