2019年06月14日

perl再入門(2)・・・perlのプログラムを追う(前回の続き)

nanako1.jpg

今日のカープの敗戦がほぼ決定的でつまらないのでperlの続きでもやります。

<report.cgi>
--------------------------------------------------------------

#-----------------------------------------------------------
# 解析
#-----------------------------------------------------------
sub analyze_log {
# ランダムモード
if ($cf{rand} > 0) {
srand;
my $rand = int(rand($cf{rand}));
if ($rand != 0) { load_img(); }
}

# リンク元取得
my $ref;
if ($cf{ssi}) {
$ref = $ENV{HTTP_REFERER};
} else {
$ref = $ENV{QUERY_STRING};

# escapeで取得のためURLデコードしておく
$ref = $cgi->url_decode($ref) if ($ref);
}

# リンク元解析
if ($ref =~ /^https?:\/\/[-.!~*'()\w;\/?:\@&=+\$,%#]+/i) {

# URLデコード
$ref = $cgi->url_decode($ref);

# コード変換
require Jcode;
$ref = Jcode->new($ref)->sjis;

# 無害化
$ref = $cgi->htmlize($ref);
$ref =~ s/'/'/g;

} else {
$ref = '';
}

# リンク元集計での除外指定
if ($cf{myurl}) {
my $flg;
foreach ( split(/\s+/, $cf{myurl}) ) {
if (index($ref,$_) >= 0) { $flg++; last; }
}
if ($flg) { $ref = ''; }
}

# ホスト/IP除外
my ($addr,$host) = get_host();

# ブラウザ情報取得
my $hua = $ENV{HTTP_USER_AGENT};

my ($os,$agent);
if ($hua =~ /AOL/) { $agent = 'AOL'; }
elsif ($hua =~ /Opera/i) { $agent = 'Opera'; }
elsif ($hua =~ /PlayStation/i) { $agent = 'PlayStation'; }
elsif ($hua =~ /Googlebot/i) { $agent = 'Googlebot'; }
elsif ($hua =~ /slurp\@inktomi\.com/i) { $agent = 'Slurp/cat'; }
elsif ($hua =~ /Infoseek SideWinder/i) { $agent = 'Infoseek SideWinder'; }
elsif ($hua =~ /FAST\-WebCrawler/i) { $agent = 'FAST-WebCrawler'; }
elsif ($hua =~ /ia_archiver/i) { $agent = 'ia_archiver'; }
elsif ($hua =~ /Chrome/i) { $agent = 'Chrome'; }
elsif ($hua =~ /Safari/i) { $agent = 'Safari'; }
elsif ($hua =~ /Firefox/i) { $agent = 'Firefox'; }
elsif ($hua =~ /MSIE (\d+)/i) { $agent = "MSIE $1"; }
elsif ($hua =~ m|Mozilla/5.+Trident/7|i) { $agent = "MSIE 11"; }
elsif ($hua =~ /Netscape/i) { $agent = 'Netscape'; }
elsif ($hua =~ /Mozilla/i) { $agent = 'Mozilla'; }
elsif ($hua =~ /Gecko/i) { $agent = 'Gecko'; }
elsif ($hua =~ /Lynx/i) { $agent = 'Lynx'; }
elsif ($hua =~ /Cuam/i) { $agent = 'Cuam'; $os = 'Windows'; }
elsif ($hua =~ /Ninja/i) { $agent = 'Ninja'; $os = 'Windows'; }
elsif ($hua =~ /WWWC/i) { $agent = 'WWWC'; $os = 'Windows'; }
elsif ($hua =~ /DoCoMo/i) { $agent = $os = 'DoCoMo'; }
elsif ($hua =~ /^MOT-|^J-PHONE|^SoftBank|^Vodafone|NetFront/i) { $agent = $os = 'SoftBank'; }
elsif ($hua =~ /^UP\.Browser|^KDDI/i) { $agent = $os = 'EZweb'; }
elsif ($hua =~ /L\-mode/i) { $agent = $os = 'L-mode'; }
elsif ($hua =~ /ASTEL/i) { $agent = $os = 'ASTEL'; }
elsif ($hua =~ /PDXGW/i) { $agent = $os = 'H"'; }

$agent = $cgi->htmlize($agent) if ($agent);
$agent =~ s/['\r\n\0]//g;

if ($hua =~ /win[dows ]*95/i) { $os = 'Win95'; }
elsif ($hua =~ /win[dows ]*9x/i) { $os = 'WinMe'; }
elsif ($hua =~ /win[dows ]*98/i) { $os = 'Win98'; }
elsif ($hua =~ /win[dows ]*XP/i) { $os = 'WinXP'; }
elsif ($hua =~ /win[dows ]*NT ?5\.1/i) { $os = 'WinXP'; }
elsif ($hua =~ /Win[dows ]*NT ?5/i) { $os = 'Win2000'; }
elsif ($hua =~ /win[dows ]*2000/i) { $os = 'Win2000'; }
elsif ($hua =~ /Win[dows ]*NT ?5\.2/i) { $os = 'Win2003'; }
elsif ($hua =~ /Win[dows ]*NT 6\.0/i || $hua =~ /Vista/i) { $os = 'WinVista'; }
elsif ($hua =~ /Win[dows ]*NT 6\.1/i) { $os = 'Win7'; }
elsif ($hua =~ /Win[dows ]*NT 6\.2/i) { $os = 'Win8'; }
elsif ($hua =~ /Win[dows ]*NT 6\.3/i) { $os = 'Win8.1'; }
elsif ($hua =~ /Win[dows ]*NT/i) { $os = 'WinNT'; }
elsif ($hua =~ /Win[dows ]*CE/i) { $os = 'WinCE'; }
elsif ($hua =~ /shap pda browser/i) { $os = 'ZAURUS'; }
elsif ($hua =~ /Mac/i) { $os = 'Mac'; }
elsif ($hua =~ /X11|SunOS|Linux|HP-UX|FreeBSD|NetBSD|OSF1|IRIX/i) { $os = 'UNIX'; }
elsif ($hua =~ /iPhone/i) { $os = 'iPhone'; }
elsif ($hua =~ /iPad/i) { $os = 'iPad'; }
elsif ($hua =~ /Android/i) { $os = 'Android'; }

# 時間取得
$ENV{TZ} = "JST-9";
my $hour = (localtime(time))[2];

# ログ読み込み
my @data;
open(DAT,"+< $cf{logfile}") or die "open err: $cf{logfile}";
eval 'flock(DAT, 2);';
my $top = ;

# IPチェック
if ($cf{ip_chk}) {
chomp($top);
if ($addr eq $top) {
close(DAT);
&load_img;
}
}

# 記事数を調整
my $i = 0;
while () {
$i++;
push(@data,$_);

last if ($i >= $cf{maxlog} - 1);
}

# 更新
seek(DAT, 0, 0);
print DAT "$addr\n";
print DAT "$agent<>$os<>$host<>$ref<>$hour<>\n";
print DAT @data;
truncate(DAT, tell(DAT));
close(DAT);

# 表示
&load_img;
}

--------------------------------------------------------------

ここは長いので2回か3回に分けてやります。

sub analyze_log {
・・・・・
}
は関数ですね。

で、中身を見て行きます。

# ランダムモード
if ($cf{rand} > 0) {
srand;
my $rand = int(rand($cf{rand}));
if ($rand != 0) { load_img(); }
}

$cf{rand}はinit.cgiのファイルを見れば分かります。

ちなみにinit.cgiは次のような構成になっています。

# モジュール宣言/変数初期化
use strict;
my %cf;
・・・
$cf{version} = 'Access Report v5.5';
・・・
$cf{pass} = '';
・・・
$cf{ssi} = 1;
・・・
$cf{logfile} = './data/log.cgi';
・・・
・・・
$cf{rand} = 0;
・・・
・・・
・・・


前回やったところで、

# 設定ファイル認識
require "./init.cgi";
my %cf = init();

というのがあったと思いますが、%cfに$cf{version} = 'Access Report v5.5';とか$cf{pass} = '';とが読み込まれるのですね。

で、$cf{rand} = 0;も読み込まれます。この設定では0ですね。

init.cgiのコメントをみると

# アトランダム機能
# → 0以外で有効。その数値の確率でしかログ保存を行わない。
# → 1日当りの訪問回数が上記$cf{maxlog}回を超えるサイトの場合、時間帯の平準化を行う機能。
# → 例:$cf{rand} = 100; であれば、確率的に100回に1度しか集計を行わない。

とあります。まあ、私のホームページはこの心配はしなくていいので初期値の0のままで行きます。

if文の中の説明はとりあえずあとにします。

さて、次です。

# リンク元取得
my $ref;
if ($cf{ssi}) {
$ref = $ENV{HTTP_REFERER};
} else {
$ref = $ENV{QUERY_STRING};

# escapeで取得のためURLデコードしておく
$ref = $cgi->url_decode($ref) if ($ref);
}

これはまず結果の例を表示してみましょう。

perl-link1.jpg

大体のイメージは掴めたでしょう。

$cf{ssi}の値によって処理が変わります。init.cgiを見てみると

# SSIモード (0=no 1=yes)
# → SSIの利用可能なサーバ限定(呼び出しタグに注意)

これだけだとよく分かりませんね。大元のKentさんのサイトに次のような説明があります。


ACCESS REPORTの機能的な特長は以下のとおりです。
1.どこからリンクされてきたかという「リンク元情報」「ブラウザ情報」「ホスト名情報」「アクセス時間帯」等を集計し、その割合をグラフ表示します。
2.オプションにより、SSIを使わず 「CGI + JavaScript」で動作するモードと、「CGI + SSI」で動作する2つのモードが可能です。
(CGI + SSIモードのほうが、より正確なリンク元、ブラウザ情報等を取得することができますが、プロバイダでSSIが利用可能であることや、フレームページでの利用ができないなどの制限があります)

要するにSSIを使わずにJavaScriptを使うモードとSSIを使うモードがあるということです。私が使用している「さくらのレンタルサーバ」はSSIが利用可能ですので、SSIを使うモードを選択しています。

$ref = $ENV{HTTP_REFERER}; の結果が上の表のようになるわけです。

JavaScriptを使うモードの場合、

# escapeで取得のためURLデコードしておく
$ref = $cgi->url_decode($ref) if ($ref);

という処理が必要ですが、JavaScriptのエスケープの問題なので、後で説明します。

ずいぶんごたごたした説明になりましたが、この回はここまでとします。

では、また次回に。

最後にカープの交流戦は悪魔ですわ。何か呪われていますね。




posted by tsurutsuru at 20:34| Comment(0) | 日常茶飯事

perl再入門(1)・・・perlのプログラムを追う

nanako1.jpg

では早速始めましょう。

CGIのプログラムは次の5つです。

report.cgi ------------- 解析プログラム
init.cgi --------------- 設定ファイル
list.cgi --------------- 集計表示プログラム
check.cgi -------------- 動作チェックプログラム
data/log.cgi ----------- データファイル

従って、この5つのプログラムが理解できれば、このCGIプロフラムが理解できることになります。

この中で中心的なプログラムはreport.cgiですから、このプログラムを最初から追って行きましょう。

尚、説明で頓珍漢なことを書くかもしれませんが、あとで気付いたらその都度修正します。

<report.cgi>
--------------------------------------------------------------
#!/usr/local/bin/perl

#┌─────────────────────────────────
#│ アクセス解析システム
#│ Access Report : report.cgi - 2013/03/22
#│ copyright (c) KentWeb
#│ http://www.kent-web.com/
#└─────────────────────────────────

# モジュール宣言
use strict;
use CGI::Carp qw(fatalsToBrowser);
use lib "./lib";
use CGI::Minimal;

# 設定ファイル認識
require "./init.cgi";
my %cf = init();

# データ受理
my $cgi = CGI::Minimal->new;

# 解析
analyze_log();
--------------------------------------------------------------

最初の
#!/usr/local/bin/perl
ですが、CGIはサーバー側に置いて実行するので、そのときにperlがサーバ側のどこにあるのか明確にしないと困ります。それでperlのあるディレクトリをこのように書くのですね。

次のモジュール宣言ですが、これはプログラムで使用するモジュールをあらかじめ読み込んでおくためのものです。
# モジュール宣言
use strict;
use CGI::Carp qw(fatalsToBrowser);
use lib "./lib";
use CGI::Minimal;

use strict; は変数などをちゃんと定義しないとエラーにしますよ、のモジュールです。

use CGI::Carp qw(fatalsToBrowser); は、エラーメッセージをブラウザ上から確認出来るようにするためのものです。いちいちエラーメッセージをサーバー上で確認するのは大変ですからねえ。

さて、次と次ですが、libディレクトリには次のようなファイルがあります。
lib/Jcode.pm ----------- コード変換モジュール [入手先]
lib/CGI/Minimal.pm ----- データ受理モジュール [入手先]

use lib "./lib"; はJcode.pmを読み込むためのものですね。主に漢字コードをシフトJISに変換するためのモジュールでしょうか。日本語は漢字があるのでとてもやっかいですね。

use CGI::Minimal; は次の説明でお分かりになるでしょう。
「PerlのモジュールCGI::Minimalは、よく使う機能、主にリクエストの処理程度に絞った軽量なモジュールです。標準のCGIモジュールはほとんどフレームワークみたいな存在なので、使い方によってはその大きさからコストが生じる場合があります。かといって車輪の再開発をする必要もなく、リクエストを取得する程度の小さなスクリプトではCGI::Minimalが役に立ちます。」 云わば省エネですね。

次の設定ファイル認識に行きましょう。
# 設定ファイル認識
require "./init.cgi";
my %cf = init();

requireとuseの違いは、次の説明でOKでしょう。
「実行時にモジュールを読み込むにはrequireを使用します。useがコンパイル時にモジュールを読み込むのに対して、requireは実行時に読み込みます。」

次のmy %cf = init(); ですが、次の表を見て下さい。
perl-hensu1.jpg

この中のハッシュになります。ハッシュとは「ハッシュとは、連想配列とも呼ばれ、「キー」と「値」を1組のペアとして関連付けされた配列です。 ただし、配列自体は順序付けされていないところに特徴があります。
ハッシュの変数のことを、ハッシュ変数といい、% (パーセント) + 英字1文字から始まり、それ以降は数字、英字およびアンダースコア ( _ ) を用いることができます。また大文字と小文字が区別されますので、たとえば %a と %A は別物として扱われます。」です。

ハッシュの例として
%fruit = ("red" => "apple", "yellow" => "banana");

init()はinit.cgiのところでご説明しますが、init.cgiの中にあるハッシュの配列を読み込むのですね。

# 解析
analyze_log();
はご想像つくように関数を呼び出しています。これはまた後で。

以上で第1回目は終わりです。

最後に
# 設定ファイル認識
などの行の先頭の#はその行がコメントであることを示します。

では、次回をお楽しみに。

(追記)
# データ受理
my $cgi = CGI::Minimal->new;

を忘れていました。これはオブジェクトを定義しています。

$cgi->xxxxxxx でいろんなことが出来ます。

CGI::Minimal->new; は new CGI::Minimal でもいいはずです。







posted by tsurutsuru at 12:14| Comment(0) | 日常茶飯事

perl再入門(0)・・・perlを再び学習します

nanako1.jpg

30代の終わりの頃だったか、perlを独習して自分のものにしたのですが、あれから20年以上も経過してperlもほとんど忘れてしまった。

今度自分のホームページのアクセスレポートを出そうと思って適当なperlのサンプルプログラムはないかとググってみあたら、perlのプログラムでは有名なKentさんのサイトにちょうどピッタリのがあったので、早速使わせてもらっている。

Kentさんのサイトはこちらです。
===> http://www.kent-web.com/data/report.html

CGIの中身を見てみたが詳細が追えなくなっています。

そこでこのプログラムを使ってperlを再度学び直そうと思います。

次回から実際のプログラムを上から追って説明して行きます。

そして、最終的には自分用にカスタマイズしようと思っています。

さあ、次回から始めます。perl再入門ゴー!

posted by tsurutsuru at 11:12| Comment(0) | 日常茶飯事