#!/usr/bin/perl -I../share
$| = 1;
#
# RCS Infomation.
# 削除変更禁止 ------------------------------------------------------------------------------------------------------------------ #
$CGI{'RCS_ID'} = "$Id: main.pl 3.8 2003/01/03 06:48:38 Administrator Exp Administrator $damy";
$CGI{'RCS_SOURCE'} = "$Source: D:/Users/Administrator/projects/works/salut/C-005_tkcounter1-S/visit\\RCS/main.pl $damy";
# ------------------------------------------------------------------------------------------------------------------------------- #
#
# 以下，情報の変更・削除を禁じます ---------------------------------------------------------------------------------------------- #
# TKCOUNTER1：JavaScript式マルチカウンタ：visit/main.pl
# Copyright(C) NTTPC Communications, Inc. 2001
# Programmed by Tomonori Kamitaki
#
# [注意事項]
# スクリプト中の削除変更禁止やそれに関するコメントがあるコードは，
# 著作権保護の為に一切の変更を認めません。
#
# [利用規程および規約]
# スクリプト配布元であるSalut!（サリュ）のホームページをご覧下さい。
# Salut!（サリュ）ホームページ => http://www.salut.ne.jp/
#
# ---------------------------------------------------------------------------------------------------------------------- ここまで #
# 以下，情報の変更・削除を禁じます ---------------------------------------------------------------------------------------------- #
$CGI{'TITLE'} = "TKCOUNTER1";
$CGI{'COPYRIGHT'} = "Copyright(C) NTTPC Communications, Inc. 2001";
$CGI{'COPYRIGHT_URL'} = "http://www.nttpc.co.jp/";
$CGI{'VERSION'} = "Ver. 2.00";
$CGI{'REVISION'} = '$Revision: 3.8 $';
$CGI{'REVISION'} =~ s/^\D*(\d+\.\d+)\D*$/$1/;
$CGI{'PROG_BY'} = "Tomonori Kamitaki";
$CGI{'PROG_MAIL'} = "";
$CGI{'INFOMATION'} = $CGI{'TITLE'}." by Salut! Web Master's Heaven";
$CGI{'INFOMATION_URL'} = "http://www.salut.ne.jp/";
$CGI{'SUPPORT_MAIL'} = "";
$CGI{'COOKIE_AUTHOR'} = $CGI{'TITLE'};
# ---------------------------------------------------------------------------------------------------------------------- ここまで #
# 変数の設定 1（環境に応じて設定します）----------------------------------------------------------------------------------------- #
# 文字エンコード指定：（ jis | sjis | euc ）から選択。（通常は，変更不要）
# 文字コード変換へは，jcode.plを使用します。[ COUNT_NAME ] に漢字を使用する場合には必ず設定して下さい。
# $g_char_encoding = "sjis"; # ※省略時は，変換を省きます。
# 管理用パスワード（英数字8文字以内：必ず変更して下さい）
# $g_admin_pass = "0123";
# ロックファイル保存用パス
$g_lock_file = "../tmp/tkcounter1.lok";
# ロックのタイプ（ lock_type : lockWithOpen = 0, lockWithSym = 1 ）
$g_lock_type = 1;
# ロックに高速リトライサイクルモードを使用する（ ON = 1, OFF = 0 ）
# このモードは，通常 [ ON = 1 ] でご使用下さい。
# このモードによって受ける恩威は，データベースの動作レスポンス向上とサーバでのプログラム常駐実時間の軽減です。
# 環境によって正しく動かない場合があります。その場合は，[ OFF = 0 ] にしてご使用下さい。
$g_lock_fast_cycle = 1;
# ------------------------------------------------------------------------------------------------------------------ 変数の設定 1 #
# 変数の設定 2（通常は変更不要：変更した場合の動作保証はありません）------------------------------------------------------------- #
# tkcounter1 の設定ファイル
$g_usr{'config'} = "../share/global.cfg";
# 保存ログファイル名
$g_usr{'log_data'} = "../log/log.dat";
# 保存ログファイルのヘッダ
$g_usr{'log_head'} = "../share/log_header.cfg";
# HTML／JavaScriptテンプレートファイル
$g_usr{'js_user_default'} = "../share/tpl/usr_default_tpl.js"; # ユーザーモード：JavaScript(カウンタ値)出力
$g_usr{'js_user_error'} = "../share/tpl/usr_error_tpl.js"; # ユーザーモード：JavaScriptエラー出力
$g_usr{'html_user_default'} = "../share/tpl/usr_default_tpl.html"; # ユーザーモード：一覧表示
$g_usr{'html_user_error'} = "../share/tpl/usr_error_tpl.html"; # ユーザーモード：エラー表示
# ------------------------------------------------------------------------------------------------------------------ 変数の設定 2 #
#ライブラリをロード
require 'tk_util2.pl';
#グローバル変数
%g_in;
# メイン処理
&main();
# メイン処理関数
sub main
{
my($error, %usr_cfg, %proc_mode);
# 入力内容を読み込み
&tk_util2::parseInput(\%g_in, $g_char_encoding);
# 設定ファイルの読込
if($error = &tk_util2::readDataFile($g_usr{'config'}, $tk_util2::k_config_a, \%usr_cfg)) { &error($error); }
# 設定内容のチェック
&usr_config_check(\%usr_cfg);
# ファイルロックの開始
if($error = &lock_start($g_lock_file, $g_lock_type)) { &error($error, 0, 1); }
# 処理の指定はあるかな？
if($g_in{'mode'}) {
# 処理関数のリファレンス・テーブル作成
%proc_mode = (
"default" , \&mode_default,
"info" , \&mode_info
);
# 指定された処理関数は，存在するかな？
if(exists $proc_mode{$g_in{'mode'}}) {
# あり
# 処理関数へのリファレンスを取り出し
$proc_ref = $proc_mode{$g_in{'mode'}};
# 処理関数を実行
&$proc_ref(\%usr_cfg);
} else {
# 未定義処理：エラー表示を行う
&error("プログラムは，未定義な処理内容をリクエストされました。
処理は続行不能\です。URLや入力フォーム等が間違っていないか確かめてから再度アクセスしてみて下さい。");
}
} else {
# 省略時の処理を実行
&mode_default(\%usr_cfg);
}
# ロックファイル終了
&lock_end($g_lock_file);
}
# インフォメーション・ページ生成
sub mode_info
{
my($usr_cfg_ref) = @_;
# コードを追加する事は，改造に当たります。[注意事項]，[利用規程および規約]を良くお読みの上，コードの追加を行って下さい。
&error("インフォメーション・モードをリクエストされました。
インフォメーション・モードは，ユーザ自身でプログラムするモードです。
マニュアルページ以外で表\示させたい情報がある時に使用します。
この機能\は，サポート対象外ですが，CGIやPerl等の書籍，WWWページ情報などを参考にプログラムにチャレンジしてみるのも良いでしょう。
by ".$CGI{'PROG_BY'}."
");
}
# デフォルト処理
sub mode_default
{
my($usr_cfg_ref) = @_;
my($error, $proc_ref, %usr_log, %r_index, $comment_num);
# コマンド指定はあるか？
if(!(exists $g_in{'COMMAND'})) {
# ない：省略時（カウント更新）の設定にする
$g_in{'COMMAND'} = "COUNT_UPDATE";
}
# 処理関数のリファレンス・テーブル作成
%proc_mode = (
"COUNT_UPDATE" , \&process_count_upd,
"COUNT_LIST" , \&process_count_list,
);
# 指定された処理関数は，存在するかな？
if(exists $proc_mode{$g_in{'COMMAND'}}) {
# あり
# 処理関数へのリファレンスを取り出し
$proc_ref = $proc_mode{$g_in{'COMMAND'}};
# 処理関数を実行
&$proc_ref($usr_cfg_ref);
} else {
# 未定義処理：エラー表示を行う
&error("プログラムは，未定義な処理コマンドをリクエストされました。
処理は続行不能\です。URLや入力フォーム等が間違っていないか確かめてから再度アクセスしてみて下さい。");
}
}
# カウント更新
sub process_count_upd
{
my($usr_cfg_ref) = @_;
my($error, %proc_mode, $proc_ref, %usr_log, %r_index, %p_index, @usr_head, $comment_num);
# # HTTP_REFERERはあるか？
# if(!($ENV{'HTTP_REFERER'})) {
# # ない：エラーを表示
# &error("HTTP_REFERERの無いアクセスです。処理を中断します。");
# }
# カウント名の指定はあるか？
if(exists $g_in{$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-count_name_item_name'}}) {
# カウント名あり：
# ログデータの読込
if($error = &tk_util2::readDataFile($g_usr{'log_data'}, $tk_util2::k_csv_data, \%usr_log, "<>")) { &error($error); }
# 記事処理の為のインデックスを[COUNT_NAME]で生成
&get_usr_log_index_by(\%usr_log, $usr_cfg_ref, \%p_index, \%r_index, $usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-count_name_item_name'});
# カウントログ・チェック／追加して記事（カウント）番号を取得
$comment_num = &count_log_check_and_add(\%usr_log, $usr_cfg_ref, \%p_index);
# コマンド指定はあるか？
if(!(exists $g_in{'COUNTER_TYPE'})) {
# ない：省略時（カウント更新）の設定にする
$g_in{'COUNTER_TYPE'} = "JS";
}
# 処理関数のリファレンス・テーブル作成
%proc_mode = (
"JS" , \&output_javascript_counter,
"DAMY_GIF" , \&output_damy_image_counter,
);
# 指定された処理関数は，存在するかな？
if(exists $proc_mode{$g_in{'COUNTER_TYPE'}}) {
# あり
# 処理関数へのリファレンスを取り出し
$proc_ref = $proc_mode{$g_in{'COUNTER_TYPE'}};
# 処理関数を実行
&$proc_ref(\%usr_log, $usr_cfg_ref, $comment_num);
} else {
# 未定義処理：エラー表示を行う
&error("プログラムは，未定義なカウンタ・タイプをリクエストされました。
処理は続行不能\です。URLや入力フォーム等が間違っていないか確かめてから再度アクセスしてみて下さい。");
}
# 保存データのヘッダを読込み
if($error = &tk_util2::readDataFile($g_usr{'log_head'}, $tk_util2::k_plain_txt, \@usr_head)) { &error($error); }
# ログデータの保存
if($error = &tk_util2::saveDataFile($g_usr{'log_data'}, $tk_util2::k_csv_data, \%usr_log, \@usr_head, "", "<>")) { &error($error); }
} else {
# なし：エラー処理
&error("カウント名の指定がありません。", 3);
}
}
# JavaScriptカウンタ
sub output_javascript_counter
{
my($usr_log_ref, $usr_cfg_ref, $comment_num) = @_;
my($error, %tpl_html, %cookie);
my($tpl_html_name) = $g_usr{'js_user_default'};
# 動作限定ホストのチェックをするのか？
if($usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-count_limited_host'}) {
# チェックする：
if(!($ENV{'HTTP_REFERER'} =~ m/$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-count_limited_host'}/)) {
&error("動作限定以外のホストから呼び出されました。処理を中断します。", 3);
}
}
# 出力用テンプレートの読込
if($error = &tk_util2::readDataFile($tpl_html_name, $tk_util2::k_tpl_html, \%tpl_html)) { &error($error); }
# # クッキーの取得
# &get_cookie($CGI{'COOKIE_AUTHOR'}, \%cookie);
# 出力用テンプレートをセットアップ
&setup_tpl_html(\%tpl_html, $usr_cfg_ref, \%cookie);
# # クッキーを保存
# &set_cookie($CGI{'COOKIE_AUTHOR'}, \%cookie);
# カウントを更新（カウントアップ処理）
&count_update($usr_log_ref, $usr_cfg_ref, $comment_num);
# MIMEヘッダを出力
&out_mime_header($tpl_html{'MIME_TYPE'});
# メイン・ヘッダを出力
print $tpl_html{'MAIN_HEAD'};
# 記事・ヘッダを出力
print &save_data_replace($tpl_html{'COMMENT_MAIN_HEAD'}, \%tpl_html, $usr_log_ref, \%cookie, $comment_num);
# 記事・フッタを出力
print &save_data_replace($tpl_html{'COMMENT_MAIN_FOOT'}, \%tpl_html, $usr_log_ref, \%cookie, $comment_num);
# メイン・フッタを出力
print $tpl_html{'MAIN_FOOT'};
}
# ダミー画像カウンタ
sub output_damy_image_counter
{
my($usr_log_ref, $usr_cfg_ref, $comment_num) = @_;
my($error, %tpl_html, %cookie);
# 動作限定ホストのチェックをするのか？
if($usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-count_limited_host'}) {
# チェックする：
if(!($ENV{'HTTP_REFERER'} =~ m/$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-count_limited_host'}/)) {
&error("", 10);
}
}
# # クッキーの取得
# &get_cookie($CGI{'COOKIE_AUTHOR'}, \%cookie);
# # クッキーを保存
# &set_cookie($CGI{'COOKIE_AUTHOR'}, \%cookie);
# カウントを更新（カウントアップ処理）
&count_update($usr_log_ref, $usr_cfg_ref, $comment_num);
# MIMEヘッダを出力
&out_mime_header("image/gif");
# ダミー画像（1px * 1px の透明GIF）
my(@damy_gif) = (
'47', '49', '46', '38', '39', '61', '01', '00',
'01', '00', '80', '00', '00', 'FF', 'FF', 'FF',
'00', '00', '00', '21', 'F9', '04', '01', '00',
'00', '00', '00', '2C', '00', '00', '00', '00',
'01', '00', '01', '00', '00', '02', '02', '44',
'01', '00', '3B'
);
# ダミー画像を出力
foreach (@damy_gif) {
my($data) = pack('C*',hex($_));
print $data;
}
}
# カウントログ・チェック／追加関数
sub count_log_check_and_add
{
my($usr_log_ref, $usr_cfg_ref, $p_index_ref) = @_;
my($comment_num, $log_date, $date);
# 既存ログにカウント名は存在するか？
if($p_index_ref->{$g_in{$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-count_name_item_name'}}}) {
# あり：既存カウント
# 記事（カウントログ）番号を取得
$comment_num = $p_index_ref->{$g_in{$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-count_name_item_name'}}};
# ログの日付を取得
($log_date) = split(/ /, $usr_log_ref->{$comment_num."-".$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}."-date_item_name"}});
# 今日の日付を取得
($date) = split(/ /, &get_date_and_time());
# 今日以外の日付であるかチェック
if(!($log_date eq $date)) {
# 今日以外の日付：昨日の日付を取得
$date = &get_yday_date();
# 昨日の日付であるかチェック
if($log_date eq $date) {
# 昨日の日付である：
# 昨日のカウント数を今日のカウント数から取得
$usr_log_ref->{$comment_num."-".$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}."-yday_count_item_name"}} = $usr_log_ref->{$comment_num."-".$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}."-today_count_item_name"}};
# 今日のカウント数を初期化
$usr_log_ref->{$comment_num."-".$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}."-today_count_item_name"}} = 0;
} else {
# 昨日より以前である：
# 昨日のカウント数を初期化
$usr_log_ref->{$comment_num."-".$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}."-yday_count_item_name"}} = 0;
# 今日のカウント数を初期化
$usr_log_ref->{$comment_num."-".$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}."-today_count_item_name"}} = 0;
}
} else {
# 今日の日付である：何もしない
}
} else {
# なし：新規カウント
# 最大記事（カウンタ）登録数以内であるか？
if($usr_log_ref->{'id-Nums'} < $usr_cfg_ref->{$usr_cfg_ref->{'id-0'}."-item_max"}) {
# 以内：
# 総カウント数を初期化
$g_in{$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}."-total_count_item_name"}} = 0;
# 今日のカウント数を初期化
$g_in{$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}."-today_count_item_name"}} = 0;
# 昨日のカウント数を初期化
$g_in{$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}."-yday_count_item_name"}} = 0;
# 記事（カウントログ）を追加
&add_data_process($usr_log_ref, $usr_cfg_ref);
# 記事（カウントログ）番号を取得
$comment_num = $g_in{$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}."-comment_num_item_name"}};
} else {
# 以上：エラー処理
&error("最大記事（カウンタ）登録数を越えています。", 3);
# &error("最大記事（カウンタ）登録数を越えています。");
}
}
# 記事（カウント）番号を返す
return $comment_num;
}
# カウント更新関数（カウントアップ処理）
sub count_update
{
my($usr_log_ref, $usr_cfg_ref, $comment_num) = @_;
my($remote_host);
# HTTP_REFERERをカウント先URLにセット
$usr_log_ref->{$comment_num."-".$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}."-count_url_item_name"}} = $ENV{'HTTP_REFERER'};
# アクセス日時をセット
$usr_log_ref->{$comment_num."-".$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}."-date_item_name"}} = &get_date_and_time();
# 環境変数[REMOTE_HOST]はセットされているか？
if(!$ENV{'REMOTE_HOST'}){
# なし：Socket読込
use Socket;
# [REMOTE_ADDR]から[REMOTE_HOST]を取得
$remote_host = gethostbyaddr(inet_aton($ENV{'REMOTE_ADDR'}),AF_INET);
} else {
$remote_host = $ENV{'REMOTE_HOST'};
}
# アクセス元ホストを取得
if(!$remote_host) {
# IPアドレスを取得
$remote_host = $ENV{'REMOTE_ADDR'};
}
# 同一ホストからの連続カウント更新を拒否は ON なのか？
if($usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-refusal_same_host_update'}) {
# ON：前回アクセスのホストは同一ホストなのか？
if($remote_host eq $usr_log_ref->{$comment_num."-".$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}."-host_item_name"}}) {
# 同一ホスト：カウント更新しない
return;
}
}
# 同一ホストではない：カウント更新
# アクセス元ホストをセット
$usr_log_ref->{$comment_num."-".$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}."-host_item_name"}} = $remote_host;
# 総カウント数をセット
$usr_log_ref->{$comment_num."-".$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}."-total_count_item_name"}}++;
# 今日のカウント数をセット
$usr_log_ref->{$comment_num."-".$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}."-today_count_item_name"}}++;
# 総カウント桁数を更新
&count_digit_update(\($usr_log_ref->{$comment_num."-".$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}."-total_count_item_name"}}), $usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-count_digit'});
# 今日のカウント桁数を更新
&count_digit_update(\($usr_log_ref->{$comment_num."-".$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}."-today_count_item_name"}}), $usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-count_digit'});
# 昨日のカウント桁数を更新
&count_digit_update(\($usr_log_ref->{$comment_num."-".$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}."-yday_count_item_name"}}), $usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-count_digit'});
}
# カウンタ桁数の更新（既存カウンタの桁数が設定桁数より大きい時は更新しない）
sub count_digit_update
{
my($count_ref, $digit) = @_;
my($i, $diff_digit_num, $diff_digit_str);
# 前部のゼロをカット = カウンタ有効桁数のみにする
$$count_ref =~ s/^0*//go;
# 桁数差を計算
$diff_digit_num = $digit - length($$count_ref);
# 桁数差があるか？（ゼロ以下は考慮しない = 既存カウンタの有効桁数が大きい時は更新しない）
if($diff_digit_num) {
# 差あり：桁数を修正
# 桁数差分のゼロを作成
for($i = 0; $i < $diff_digit_num; $i++) {
$diff_digit_str .= "0";
}
# 差分桁をカウンタ前部に付ける
$$count_ref = $diff_digit_str.$$count_ref;
}
}
# カウント集計一覧
sub process_count_list
{
my($usr_cfg_ref) = @_;
&process_default($usr_cfg_ref);
}
# 省略時の処理を実行：記事一覧モード
sub process_default
{
my($usr_cfg_ref) = @_;
my($tpl_html_default);
# モード？管理||ユーザー
if($g_in{'mode'} eq "admin") {
# 管理モード：管理用HTMLを設定
$tpl_html_default = $g_usr{'html_admin_default'};
} else {
# ユーザーモード：ユーザー用HTMLを設定
$tpl_html_default = $g_usr{'html_user_default'};
}
# 記事一覧を表示
&general_purpose_log_view_process($usr_cfg_ref, $tpl_html_default);
}
# 記事の削除
sub process_delete
{
my($usr_cfg_ref) = @_;
my($tpl_html_delete);
# モード？管理||ユーザー
if($g_in{'mode'} eq "admin") {
# 管理モード：管理用HTMLを設定
$tpl_html_delete = $g_usr{'html_admin_default'};
} else {
if(1) {
&error("ユーザーは，リクエストされた操作の実行を許可されていません。");
}
# ユーザーモード：ユーザー用HTMLを設定
$tpl_html_delete = $g_usr{'html_user_default'};
}
# 記事番号の指定はあるか？
if(exists $g_in{$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}."-comment_num_item_name"}}) {
# ある：記事を削除
my($error, %usr_log, %tpl_html, @p_index, %r_index, @del_index, $cm_num);
# 記事番号を取得
$cm_num = $g_in{$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}."-comment_num_item_name"}};
# ログデータの読込
if($error = &tk_util2::readDataFile($g_usr{'log_data'}, $tk_util2::k_csv_data, \%usr_log, "<>")) { &error($error); }
# 記事処理の為のインデックスを生成
# &get_usr_log_index(\%usr_log, $usr_cfg_ref, \@p_index, \%r_index);
# プログラム依存コード ---------------------------------------------------------------------------- #
# 記事番号を削除リストへ
push(@del_index, $cm_num);
# ---------------------------------------------------------------------------- プログラム依存コード #
# 削除リストの記事を削除
&delete_data(\%usr_log, \@del_index);
# 記事処理の為のインデックスを再生成
# undef @p_index; # 再生成の為に値をクリア
# undef %r_index; # 再生成の為に値をクリア
&get_usr_log_index(\%usr_log, $usr_cfg_ref, \@p_index, \%r_index);
# プログラム依存コード ------------------------------------------------------------------------------------------- #
# [total_count_item_name] の順位付けと割合の計算する
&compute_ranking_and_rate(\%usr_log, $usr_cfg_ref, $usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-total_count_item_name'});
# [today_count_item_name] の順位付けと割合の計算する
&compute_ranking_and_rate(\%usr_log, $usr_cfg_ref, $usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-today_count_item_name'});
# [yday_count_item_name] の順位付けと割合の計算する
&compute_ranking_and_rate(\%usr_log, $usr_cfg_ref, $usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-yday_count_item_name'});
# ------------------------------------------------------------------------------------------- プログラム依存コード #
# テンプレートHTMLの読込
if($error = &tk_util2::readDataFile($g_usr{'html_admin_default'}, $tk_util2::k_tpl_html, \%tpl_html)) { &error($error); }
# 記事を表示
&show_log_view(\%tpl_html, \%usr_log, $usr_cfg_ref, \@p_index, \%r_index, 1);
# 保存データのヘッダを読込み
if($error = &tk_util2::readDataFile($g_usr{'log_head'}, $tk_util2::k_plain_txt, \@usr_head)) { &error($error); }
# ログデータの保存
if($error = &tk_util2::saveDataFile($g_usr{'log_data'}, $tk_util2::k_csv_data, \%usr_log, \@usr_head, "", "<>")) { &error($error); }
} else {
# ない：記事一覧モード
&general_purpose_log_view_process($usr_cfg_ref, $g_usr{'html_admin_default'});
}
}
# 最大記事登録数の制限チェック
sub check_max_log
{
my($usr_log_ref, $usr_cfg_ref, $p_index_ref, $r_index_ref) = @_;
my($oldest, $latest, $tmp, @del_index);
# 最大ログ数以内であるか？
if($usr_log_ref->{'id-Nums'} <= $usr_cfg_ref->{$usr_cfg_ref->{'id-0'}."-item_max"}) {
# 最大ログ数以内です
return 0;
} else {
# 最大ログ数を越えている：一番古い記事番号を取得
# とりあえずログの最初の記事番号を取得
$oldest = $usr_log_ref->{'id-0'};
# 一番古い記事番号を探す
for($i = 0; $i < $usr_log_ref->{'id-Nums'}; $i++) {
if($oldest > $usr_log_ref->{'id-'.$i}) {
$oldest = $usr_log_ref->{'id-'.$i};
}
}
}
# プログラム依存コード -------------------------------------------------------------------------------------------------------------- #
# 記事番号を削除リストへ
push(@del_index, $oldest);
# 削除リストの記事を削除
&delete_data_process($usr_log_ref, \@del_index);
# 変更通知を返す
return 1;
# -------------------------------------------------------------------------------------------------------------- プログラム依存コード #
}
# 順位付けと割合の計算
sub compute_ranking_and_rate
{
my($usr_log_ref, $usr_cfg_ref, $log_item_name) = @_;
my($i, %p_index, @p_index);
# 記事処理の為のインデックスを[ $log_item_name ]で生成
for($i = 0; $i < $usr_log_ref->{'id-Nums'}; $i++) {
# 桁数を更新
# &count_digit_update(\($usr_log_ref->{$usr_log_ref->{'id-'.$i}.'-'.$log_item_name}), 1);
# 記事インデックスに追加
$p_index{$usr_log_ref->{$usr_log_ref->{'id-'.$i}.'-'.$log_item_name}} .= $usr_log_ref->{'id-'.$i}.",";
}
# キーでソートして順位インデックスを作成
@p_index = sort { $b <=> $a } keys %p_index;
# ランクカウンタを初期化
$i=0;
# 順位インデックスでループ
for(@p_index) {
# 順位インデックス値から記事番号インデックスを作成
@c_index = split(/,/, $p_index{$_});
# ゼロ割算阻止チェック
if($_ > 0) {
# 割合を計算
$rate = int($_ / @p_index[0] * $usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-rate_width'});
if(!($rate)) {
$rate = 1;
}
} else {
# ゼロをセット
$rate = 1;
}
# 順位カウンタをインクリメント
$i++;
# 記事番号インデックスでループ
for(@c_index) {
# ログに順位を追加
$usr_log_ref->{$_.'-'.$log_item_name.'-RANK'} = $i;
# ログに割合を追加
$usr_log_ref->{$_.'-'.$log_item_name.'-RATE'} = $rate
}
}
}
# 汎用ログ一覧表示処理ルーチン
sub general_purpose_log_view_process
{
my($usr_cfg_ref, $tpl_html_name, $log_disble) = @_;
my($error, %usr_log, %tpl_html, @p_index, %r_index);
# ログの処理を実行するか？
if(!($log_disble)) {
# 処理する：ログデータの読込
if($error = &tk_util2::readDataFile($g_usr{'log_data'}, $tk_util2::k_csv_data, \%usr_log, "<>")) { &error($error); }
# プログラム依存コード ------------------------------------------------------------------------------------------- #
# [total_count_item_name] の順位付けと割合の計算する
&compute_ranking_and_rate(\%usr_log, $usr_cfg_ref, $usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-total_count_item_name'});
# [today_count_item_name] の順位付けと割合の計算する
&compute_ranking_and_rate(\%usr_log, $usr_cfg_ref, $usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-today_count_item_name'});
# [yday_count_item_name] の順位付けと割合の計算する
&compute_ranking_and_rate(\%usr_log, $usr_cfg_ref, $usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-yday_count_item_name'});
# ------------------------------------------------------------------------------------------- プログラム依存コード #
}
# テンプレートHTMLの読込
if($error = &tk_util2::readDataFile($tpl_html_name, $tk_util2::k_tpl_html, \%tpl_html)) { &error($error); }
# 記事処理の為のインデックスを生成
&get_usr_log_index(\%usr_log, $usr_cfg_ref, \@p_index, \%r_index);
# 記事を表示
&show_log_view(\%tpl_html, \%usr_log, $usr_cfg_ref, \@p_index, \%r_index);
}
# 記事表示
sub show_log_view
{
my($tpl_html_ref, $usr_log_ref, $usr_cfg_ref, $p_index_ref, $r_index_ref, $mode_is_input) = @_;
my($error, %cookie, $tmp, $i, $j);
# 記事はあるのか？
if($usr_log_ref->{'id-Nums'}) {
# ある：クッキーの取得
# &get_cookie($CGI{'COOKIE_AUTHOR'}, \%cookie);
# モードは，入力なのか？
if($mode_is_input == 1) {
# 記事番号をクッキーに保存
# $cookie{$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}."-comment_num_item_name"}} = $g_in{$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}."-comment_num_item_name"}};
}
# tpl_htmlをセットアップ
&setup_tpl_html($tpl_html_ref, $usr_cfg_ref, \%cookie, 0, 0, 0, 0);
# クッキーを保存
# &set_cookie($CGI{'COOKIE_AUTHOR'}, \%cookie);
# MIMEヘッダを出力
&out_mime_header($tpl_html{'MIME_TYPE'});
# メイン・ヘッダを出力
print $tpl_html_ref->{'MAIN_HEAD'};
# プログラム準依存コード ------------------------------------------------------------------------------------- #
# 記事の処理ループ
for(@$p_index_ref) {
# 記事上側のデータ置換して出力
print &save_data_replace($tpl_html_ref->{'COMMENT_MAIN_HEAD'}, $tpl_html_ref, $usr_log_ref, \%cookie, $_);
# 記事下側のデータ置換して出力
print &save_data_replace($tpl_html_ref->{'COMMENT_MAIN_FOOT'}, $tpl_html_ref, $usr_log_ref, \%cookie, $_);
}
# ------------------------------------------------------------------------------------- プログラム準依存コード #
} else {
# tpl_htmlをセットアップ
&setup_tpl_html($tpl_html_ref, $usr_cfg_ref, $cookie_ref, 0, 0, 0, 0);
# HTMLヘッダを出力
&out_html_header();
# メイン・ヘッダを出力
print $tpl_html_ref->{'MAIN_HEAD'};
}
# メイン・フッタを出力
print $tpl_html_ref->{'MAIN_FOOT'};
}
# 保存データの置換処理
sub save_data_replace
{
my($ret, $tpl_html_ref, $save_data_ref, $cookie_ref, $key) = @_;
# データ判別型特別置換文字列（ ==%%keyword::propaty%%== ）の処理
$ret =~ s/==%%(SAVE)::(.+?)%%==/&special_replace($1, $2, $tpl_html_ref->{$2}, \$save_data_ref->{$key.'-'.$2}, $cookie_ref)/geo;
# 単純データ置換え文字列（ __%%keyword::propaty%%__ ）の処理
$ret =~ s/__%%SAVE::(.+?)%%__/$save_data_ref->{$key.'-'.$1}/go;
# `結果を返す
return $ret;
}
# ==%%keyword::propaty%%== の置換文字列の処理
sub special_replace
{
my($key, $pty, $tpl_html_str, $data_str_ref, $cookie_ref) = @_;
# 定義されているのか？
if($$data_str_ref && !($$data_str_ref eq $cookie_ref->{'default-'.$pty})) {
# なんらかの定義があれば置換する
$tpl_html_str =~ s/__%%($key)::($pty)%%__/$$data_str_ref/go;
# 処理結果を返す
return $tpl_html_str;
} else {
# 何もしない（つまり空白）
return;
}
}
# 記事のインデックスを生成
sub get_usr_log_index
{
# プログラム依存コード ---------------------------------------- #
my($usr_log_ref, $usr_cfg_ref, $p_index_ref, $r_index_ref) = @_;
my($i, $j, @p_index);
for($i = 0, $j = 0; $i < $usr_log_ref->{'id-Nums'}; $i++) {
# 記事インデックスに追加
$p_index[$j++] = $usr_log_ref->{'id-'.$i};
}
# 管理モード？ユーザーモード？
if($g_in{'mode'} eq "admin") {
# 記事を降順にソート
@{$p_index_ref} = sort {$b <=> $a} @p_index;
} else {
# 記事を番号順にソート
@{$p_index_ref} = sort {$a <=> $b} @p_index;
}
# ---------------------------------------- プログラム依存コード #
}
# 記事のインデックスを指定項目で生成
sub get_usr_log_index_by
{
# プログラム依存コード ------------------------------------------------------------------------------ #
my($usr_log_ref, $usr_cfg_ref, $p_index_ref, $r_index_ref, $item_name) = @_;
my($i);
for($i = 0; $i < $usr_log_ref->{'id-Nums'}; $i++) {
# 記事インデックスに追加
$p_index_ref->{$usr_log_ref->{$usr_log_ref->{'id-'.$i}.'-'.$item_name}} = $usr_log_ref->{'id-'.$i};
}
# ------------------------------------------------------------------------------ プログラム依存コード #
}
# tpl_html の初期化（tpl_html中の[ save ]以外のkeywordに対する置換処理）
sub setup_tpl_html
{
my($tpl_html_ref, $usr_cfg_ref, $cookie_ref, $page_num, $cm_start, $cm_end, $p_index_num) = @_;
my($error, $prev, $next, $hash_key, $ret, $chk1, $chk2, $i);
# ページ処理を実行するか？
if($page_num) {
# ページ処理用前処理
# 前ページはあるか？
if($cm_start > 0) {
# 前ページあり
$prev = $page_num - 1;
} else {
# 前ページなし
$prev = 0;
}
# 次ページはあるか？
if($cm_end < $p_index_num) {
# 次ページあり
$next = $page_num + 1;
} else {
# 次ページなし
$next = 0;
}
}
# ハッシュ・キーを取り出す
foreach $hash_key (sort keys %$tpl_html_ref) {
# 削除変更禁止 ------------------------------------------------------------------ #
$chk1 += $tpl_html_ref->{$hash_key} =~ s/__%%CGI::(INFOMATION)%%__/$CGI{$1}/go;
# ------------------------------------------------------------------ 削除変更禁止 #
# 削除変更禁止 ------------------------------------------------------------------ #
$chk2 += $tpl_html_ref->{$hash_key} =~ s/__%%CGI::(INFOMATION_URL)%%__/$CGI{$1}/go;
# ------------------------------------------------------------------ 削除変更禁止 #
# 削除変更禁止 ------------------------------------------------------------------ #
$tpl_html_ref->{$hash_key} =~ s/__%%CGI::(.+?)%%__/$CGI{$1}/go;
# ------------------------------------------------------------------ 削除変更禁止 #
# ページ処理データ置換え文字列の処理
for($i = 0; $i < $usr_cfg_ref->{'id-Nums'}; $i++) {
# 次ページのデータ判別型特別置換文字列（ ==%%$usr_cfg_ref->{'id-'.$i}::NEXT_PAGE%%== ）の処理
$tpl_html_ref->{$hash_key} =~ s/==%%($usr_cfg_ref->{'id-'.$i})::(NEXT_PAGE)%%==/&special_replace($1, $2, $tpl_html_ref->{$2}, \$next)/goe;
# 前ページのデータ判別型特別置換文字列（ ==%%$usr_cfg_ref->{'id-'.$i}::PREV_PAGE%%== ）の処理
$tpl_html_ref->{$hash_key} =~ s/==%%($usr_cfg_ref->{'id-'.$i})::(PREV_PAGE)%%==/&special_replace($1, $2, $tpl_html_ref->{$2}, \$prev)/goe;
}
# 単純データ置換え文字列（ __%%keyword::propaty%%__ ）の処理
for($i = 0; $i < $usr_cfg_ref->{'id-Nums'}; $i++) {
# 単純データ置換え文字列（ __%%$usr_cfg_ref->{'id-'.$i}::propaty%%__ ）の処理
$tpl_html_ref->{$hash_key} =~ s/__%%($usr_cfg_ref->{'id-'.$i})::(.+?)%%__/$usr_cfg_ref->{$1.'-'.$2}/go;
}
# 単純データ置換え文字列（ __%%g_in::propaty%%__ ）の処理
$tpl_html_ref->{$hash_key} =~ s/__%%G_IN::(.+?)%%__/$g_in{$1}/go;
# クッキー処理
$tpl_html_ref->{$hash_key} =~ s/__%%CLIENT_COOKIE::(.+?)%%__/&cookie_proc($cookie_ref, $1)/geo;
}
# 削除変更禁止 -------------------------------------------------------------------------------------------------------------- #
if(!($chk1)) {
# 駄目
$error .= " [ __%%CGI::INFOMATION%%__ ]";
}
# -------------------------------------------------------------------------------------------------------------- 削除変更禁止 #
# 削除変更禁止 -------------------------------------------------------------------------------------------------------------- #
if(!($chk2)) {
# 駄目
$error .= " [ __%%CGI::INFOMATION_URL%%__ ]";
}
# -------------------------------------------------------------------------------------------------------------- 削除変更禁止 #
# 削除変更禁止 -------------------------------------------------------------------------------------------------------------- #
if(length($error)) {
# 駄目
&error("置換え文字列 $error が足りません。$chk1, $chk2");
}
# -------------------------------------------------------------------------------------------------------------- 削除変更禁止 #
# 削除変更禁止 -------------------------------------------------------------------------------------------------------------- #
if(!($chk1 == $chk2)) {
# 駄目
&error("置換え文字列 [ __%%CGI::INFOMATION%%__ ] [ __%%CGI::INFOMATION_URL%%__ ] の数が合いません。ERR = $chk1, $chk2", 1);
}
# -------------------------------------------------------------------------------------------------------------- 削除変更禁止 #
}
# クッキー処理
sub cookie_proc
{
my($cookie_ref, $propaty) = @_;
my($p_name, $p_value);
# プロパティをプロパティ名とプロパティ値に分解
($p_name, $p_value) = split(/=/, $propaty);
# 暗号化前の入力フォームの中に対応するプロパティはあるか？
if(exists $g_in{'src-'.$p_name}) {
# ある：フォームからプロパティをセット
$cookie_ref->{$p_name} = $g_in{'src-'.$p_name};
# 入力されたフォームの中に対応するプロパティはあるか？
} elsif(exists $g_in{$p_name}) {
# ある：フォームからプロパティをセット
$cookie_ref->{$p_name} = $g_in{$p_name};
} else {
# ない：プロパティに対するクライアントのクッキーはあるか？
if(exists $cookie_ref->{$p_name}) {
# ある：
} else {
# ない：デフォルトの設定値は，あるのか？
if(length($p_value)) {
# ある：デフォルト値をセット
$cookie_ref->{$p_name} = $p_value;
} else {
# ない：空白をセット
$cookie_ref->{$p_name} = "";
}
}
}
# デフォルト値があれば値を保存（入力フォームとの比較の為）
if($p_value) {
$cookie_ref->{'default-'.$p_name} = $p_value;
}
# 値を返す
return $cookie_ref->{$p_name};
}
# クッキーを取得
sub get_cookie
{
my($cookie_author, $cookie_ref) = @_;
my($c_author, $c_str);
my($c_it_name, $c_it_value);
# クッキーを取得して分解
for(split(/;/, $ENV{'HTTP_COOKIE'})) {
($c_author, $c_str) = split(/=/, $_);
$c_author =~ s/\s//g;
if($c_author eq $cookie_author) {
last;
}
}
# クッキー中身を分解して値をセット
for(split(/,/, $c_str)) {
($c_it_name, $c_it_value) = split(/<>/, $_);
$cookie_ref->{$c_it_name} = $c_it_value;
}
}
# クッキーを発行
sub set_cookie
{
my($coockie_author, $cookie_ref) = @_;
my($cookie_str, $key, $secg, $ming, $hourg, $mdayg, $mong, $yearg, $wdayg, $ydayg, $isdstg, @mong, @weekg, $date_gmt);
# クッキーは国際時間をキーとし、保存日数は60日間
($secg, $ming, $hourg, $mdayg, $mong, $yearg, $wdayg, $ydayg, $isdstg) = gmtime(time + 60 * 24 * 60 * 60);
# 曜日と週を配列で定義
@mong = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
@weekg = ('Sunday', 'Monday', 'Tuesday', 'Wednesday', 'Thursday', 'Friday', 'Saturday');
# 60日後の国際時間を指定フォーマット化
$date_gmt = sprintf("%s, %02d\-%s\-%04d %02d\:%02d\:%02d GMT", $weekg[$wdayg], $mdayg, $mong[$mong], $yearg+1900, $hourg, $ming, $secg);
# 保存するクッキー情報を生成
foreach $key (sort keys %$cookie_ref) {
# デフォルト値をスキップ
if($key =~ /default-(.+?)/) {
next;
}
# クッキー文字列へ追加
$cookie_str .= "$key"."<>"."$cookie_ref->{$key}".",";
}
# 不要な最後の[,]を削除
chop($cookie_str);
# クッキーの標準フォーマットに整えます。
print "Set-Cookie: $coockie_author=$cookie_str; expires=$date_gmt\n";
}
# 設定内容のチェック
sub usr_config_check
{
my($config_ref) = @_;
# 最大記事登録数のチェック
if(!($config_ref->{$config_ref->{'id-0'}."-item_max"})) {
# デフォルト設定：10件
$config_ref->{$config_ref->{'id-0'}."-item_max"} = 10;
} elsif($config_ref->{$config_ref->{'id-0'}."-item_max"} > 25) {
# 最大件数：25件
$config_ref->{$config_ref->{'id-0'}."-item_max"} = 25;
}
# ページタイトルのチェック
if(!($config_ref->{$config_ref->{'id-0'}."-TITLE"})) {
# デフォルト設定：tkezdb1
$config_ref->{$config_ref->{'id-0'}."-TITLE"} = $CGI{'TITLE'};
}
# ページタイトル(WIN)のチェック
if(!($config_ref->{$config_ref->{'id-0'}."-WIN_TITLE"})) {
# デフォルト設定：tkezdb1
$config_ref->{$config_ref->{'id-0'}."-WIN_TITLE"} = $CGI{'TITLE'};
}
# 戻る為のリンク先のチェック
if(!($config_ref->{$config_ref->{'id-0'}."-RETURN_URL"})) {
# デフォルト設定：HTTP_REFERER
$config_ref->{$config_ref->{'id-0'}."-RETURN_URL"} = $ENV{'HTTP_REFERER'};
}
# 戻る為のリンク先のタイトル／名前のチェック
if(!($config_ref->{$config_ref->{'id-0'}."-RETURN_URL_TITLE"})) {
# 戻る為のリンク先は設定されているのか？
if($config_ref->{$config_ref->{'id-0'}."-RETURN_URL"}) {
# デフォルト：戻る
$config_ref->{$config_ref->{'id-0'}."-RETURN_URL_TITLE"} = "戻る";
} else {
# デフォルト：無し
$config_ref->{$config_ref->{'id-0'}."-RETURN_URL_TITLE"} = "";
}
}
# 記事番号のデータ・アイテム名のチェック
if(!($config_ref->{$config_ref->{'id-0'}."-comment_num_item_name"})) {
# デフォルト設定：COMMENT_NUM
$config_ref->{$config_ref->{'id-0'}."-comment_num_item_name"} = "COMMENT_NUM";
}
# カウント名のデータ・アイテム名のチェック
if(!($config_ref->{$config_ref->{'id-0'}."-count_name_item_name"})) {
# デフォルト設定：COUNT_NAME
$config_ref->{$config_ref->{'id-0'}."-count_name_item_name"} = "COUNT_NAME";
}
# カウント先URLのデータ・アイテム名のチェック
if(!($config_ref->{$config_ref->{'id-0'}."-count_url_item_name"})) {
# デフォルト設定：COUNT_URL
$config_ref->{$config_ref->{'id-0'}."-count_url_item_name"} = "COUNT_URL";
}
# 総カウント数のデータ・アイテム名のチェック
if(!($config_ref->{$config_ref->{'id-0'}."-total_count_item_name"})) {
# デフォルト設定：TOTAL_COUNT
$config_ref->{$config_ref->{'id-0'}."-total_count_item_name"} = "TOTAL_COUNT";
}
# 今日のカウント数のデータ・アイテム名のチェック
if(!($config_ref->{$config_ref->{'id-0'}."-today_count_item_name"})) {
# デフォルト設定：TODAY_COUNT
$config_ref->{$config_ref->{'id-0'}."-today_count_item_name"} = "TODAY_COUNT";
}
# 昨日のカウント数のデータ・アイテム名のチェック
if(!($config_ref->{$config_ref->{'id-0'}."-yday_count_item_name"})) {
# デフォルト設定：YDAY_COUNT
$config_ref->{$config_ref->{'id-0'}."-yday_count_item_name"} = "YDAY_COUNT";
}
# 日時のデータ・アイテム名のチェック
if(!($config_ref->{$config_ref->{'id-0'}."-date_item_name"})) {
# デフォルト設定：DATE
$config_ref->{$config_ref->{'id-0'}."-date_item_name"} = "DATE";
}
# ホストのデータ・アイテム名のチェック
if(!($config_ref->{$config_ref->{'id-0'}."-host_item_name"})) {
# デフォルト設定：HOST
$config_ref->{$config_ref->{'id-0'}."-host_item_name"} = "HOST";
}
}
# データ処理関数
sub add_data_process
{
my($data_ref, $config_ref) = @_;
my($i, $my_cm_num, $my_id_num);
# プログラム依存コード ------------------------------------------------------------------------------------------------------------- #
# 編集なのか？新規入力なのか？
if($g_in{$config_ref->{$config_ref->{'id-0'}."-comment_num_item_name"}}) {
# 編集
$my_cm_num = $g_in{$config_ref->{$config_ref->{'id-0'}."-comment_num_item_name"}};
} else {
# 新規入力
# 最後の記事番号を取得
for($i = 0; $i < $data_ref->{'id-Nums'}; $i++) {
if( $my_cm_num < $data_ref->{'id-'.$i} ) {
$my_cm_num = $data_ref->{'id-'.$i};
}
}
# 最後の記事番号に1を足して新規記事番号にする
$my_cm_num++;
# データ操作用IDを取得
$my_id_num = "id-".$data_ref->{'id-Nums'}++;
# 記事番号をIDに登録
$data_ref->{$my_id_num} = $my_cm_num;
# 記事一覧のページ番号を1にセット
$g_in{'PAGE_NUM'} = 1;
}
# ------------------------------------------------------------------------------------------------------------- プログラム依存コード #
# 新規記事番号を記事番号へ
$g_in{$config_ref->{$config_ref->{'id-0'}."-comment_num_item_name"}} = $my_cm_num;
# # プログラム依存コード ------------------------------------------------------------------------------------------------------------- #
# # 入力されたパスワードを退避（後処理で必要な場合がある）
# $g_in{'src-'.$config_ref->{$config_ref->{'id-0'}.'-pass_item_name'}} = $g_in{$config_ref->{$config_ref->{'id-0'}.'-pass_item_name'}};
# # 入力されたパスワードを暗号化
# &encrypt_data(\$g_in{$config_ref->{$config_ref->{'id-0'}.'-pass_item_name'}});
# # ------------------------------------------------------------------------------------------------------------- プログラム依存コード #
# 入力データを保存先変数へ
for($i = 0; $i < $data_ref->{'csv-itName-nums'}; $i++) {
$data_ref->{$my_cm_num."-".$data_ref->{'csv-itName-'.$i}} = $g_in{$data_ref->{'csv-itName-'.$i}};
}
}
# 記事データを削除して記事データIDを再構成します。
sub delete_data
{
my($usr_log_ref, $del_index_ref) = @_;
my($id, $true_or_false, @tmp_id_index, %tmp_cm_index, $i);
# テンポラリ記事IDを取得
for($i = 0; $i < $usr_log_ref->{'id-Nums'}; $i++) {
# 記事IDをテンポラリ記事IDリストへ
push(@tmp_id_index, $i);
# テンポラリ記事IDをキーとして記事番号をテンポラリ記事番号ハッシュへ
$tmp_cm_index{$i} = $usr_log_ref->{'id-'.$i};
}
# IDカウンタを初期化
$i = 0;
# テンポラリIDをソートしてIDを取得
for(sort{$a <=> $b} @tmp_id_index) {
# 値を有効にセット
$true_or_false = 1;
# IDをセット
$id = $_;
# 削除リストチェックを取得
for(@$del_index_ref) {
# 削除リストに該当するか
if( $usr_log_ref->{'id-'.$id} == $_ ) {
# 該当する：記事IDは無効
$true_or_false = 0;
# ループを抜ける
last;
}
}
# 有効な記事IDか？
if($true_or_false) {
# 有効：有効ID番号をキーとしてテンポラリ記事番号の値を記事データ・ハッシュへ
$usr_log_ref->{'id-'.$i} = $tmp_cm_index{$id};
# IDカウンタをインクリメント
$i++
}
}
$usr_log_ref->{'id-Nums'} = $i;
}
# データ暗号化
sub encrypt_data
{
my($src_data_ref) = @_;
my(@SALT, $salt, $enc_data);
# 乱数初期化処理
srand;
# 乱数発生の為の種リストを作成
@SALT = ('a'..'z', 'A'..'Z', '0'..'9', '.', '/');
# 種リストで乱数を発生させて暗号化用の種を生成
$salt = $SALT[int(rand(@SALT))] . $SALT[int(rand(@SALT))];
# 暗号化したパスワードを生成
$enc_data = crypt($$src_data_ref, $salt) || crypt ($$src_data_ref, '$1$' . $salt);
# 暗号化した文字を元変数へ代入
$$src_data_ref = $enc_data;
}
# 暗号データ照合処理（ 一致 = 1, 不一致 = 0 ）
sub decrypt_data
{
my($src_data, $enc_data) = @_;
my($salt, $key);
# 種を取得
$salt = $enc_data =~ /^\$1\$(.*)\$/ && $1 || substr($enc_data, 0, 2);
# パスワードを照合
if (crypt($src_data, $salt) eq "$enc_data" || crypt($src_data, '$1$' . $salt) eq "$enc_data") {
# 一致
return 1;
} else {
# 不一致
return 0;
}
}
# HTMLヘッダの出力関数
sub out_html_header
{
print("Content-type: text/html", "\n");
print("Pragma: no-cache");
print("\n\n");
}
# MIMEヘッダの出力関数
sub out_mime_header
{
my($mime_type) = @_;
# MIMEの指定はあるか？
if($mime_type) {
# ある：行末の改行をカット（あれば）
$mime_type =~ s/\n$//go;
} else {
# ない：省略時（text/html）のMIMEをセット
$mime_type = "text/html";
}
print("Content-type: ", $mime_type, "\n");
print("Pragma: no-cache");
print("\n\n");
}
# 日付／時間の取得
sub get_date_and_time
{
my($sec, $min, $hour, $mday, $mon, $year, $wday, $isdst, $week, $date);
$ENV{'TZ'} = "JST-9";
($sec, $min, $hour, $mday, $mon, $year, $wday, $isdst) = localtime(time);
$year += 1900;
$mon++;
if($mon < 10) {
$mon = "0$mon";
}
if($mday < 10) {
$mday = "0$mday";
}
if($hour < 10) {
$hour = "0$hour";
}
if($min < 10) {
$min = "0$min";
}
if($sec < 10) {
$sec = "0$sec";
}
$week = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat')[$wday];
# 日時のフォーマット
$date = "$year\/$mon\/$mday($week) $hour\:$min\:$sec";
return $date;
}
# 昨日の日付／時間を取得
sub get_yday_date
{
my($sec, $min, $hour, $mday, $mon, $year, $wday, $isdst, $week, $date);
my(%mon_tbl);
$ENV{'TZ'} = "JST-9";
($sec, $min, $hour, $mday, $mon, $year, $wday, $isdst) = localtime(time - 86400);
$year += 1900;
$mon++;
if($mon < 10) {
$mon = "0$mon";
}
if($mday < 10) {
$mday = "0$mday";
}
$week = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat')[$wday];
$date = "$year\/$mon\/$mday($week)";
return $date;
}
# ロックファイル開始
# $lock_type : lockWithOpen = 0, lockWithSym = 1
sub lock_start
{
my($lock_file, $lock_type, $retry) = @_;
my($error) = "lock_start(); lockWithSym エラー";
# リトライの回数指定はあるか？
if(!($retry)) {
# 省略時は，3回
$retry = 3;
# リトライサイクルは，高速モードか？
if($g_lock_fast_cycle) {
# リトライ回数を4倍する
$retry *= 4;
}
}
# 1分以上古いロックは削除する
if(-e $lock_file) {
# ファイルの作成された時間を取得
my($mtime) = (stat($lock_file))[9];
# 一分以上古いファイルなのか？
if($mtime < time - 60) {
# ロックを解除
&lock_end($lock_file);
}
}
# ファイル無になるまでリトライ回数分繰り返し分実行する
while(-e $lock_file) {
# ある：リトライサイクルは，高速モードか？
# リトライ回数範囲内か？
if(--$retry <= 0) {
# リトライ回数を超えた：ファイル作成失敗
return $error;
}
# リトライサイクルは，高速モードか？
if($g_lock_fast_cycle) {
# より早いサイクルでリトライを実行させます
select(undef, undef, undef, 0.25);
} else {
# セーフモード
sleep(1);
}
}
# ロックファイルの種類は？
if($lock_type == 1) {
# リンク作成
symlink(".", $lock_file) or die return $error;
} else {
# ロックファイルを作成
open(LOCK, ">$lock_file") or die return $error;
close(LOCK);
}
# 処理結果を返す
return;
}
# ロックファイル終了
sub lock_end
{
my($lock_file) = @_;
# ロックファイルはあるか？
if(-e $lock_file) {
# ある：ロックファイルを削除
unlink($lock_file);
}
}
# エラー処理関数
# $error_type : auto_text = 0 (html or plain, htmlを優先)
# plain_text = 1
# html_text = 2
# js_text = 3
# gif = 10
# $error_lock：解除 = 0; 放置 = 1;
# ※auto_text は，HTMLテンプレートがある時は HTML ない時は plain でエラーを表示します。
sub error
{
my($errorStr, $error_type, $error_lock) = @_;
my($tpl_html_error);
# HTMLを設定
$tpl_html_error = $g_tpl_html_path_ref->{'ERROR'};
# ロック解除あり？
if(!($error_lock)) {
# ロック解除：
&lock_end($g_lock_file);
}
# モード？管理||ユーザー
if($g_in{'mode'} eq "admin") {
# 管理モード：管理用HTMLを設定
$tpl_html_error = $g_usr{'html_admin_error'};
} else {
# ユーザーモード：ユーザー用HTMLを設定
$tpl_html_error = $g_usr{'html_user_error'};
}
# エラーの種類は？
if($error_type < 10) {
# text：タイプは？auto || plain
if($error_type == 0) {
# カウンタ名指定はあるか？
if($g_in{'COUNT_NAME'}) {
# 存在する（JS）
$error_type = 3;
} else {
# 存在しない
# auto：エラー用テンプレートHTMLは存在するか？
if(!(-e $tpl_html_error)) {
# 存在しない（plain text）
$error_type = 1;
} else {
# 存在する（HTML）
$error_type = 2;
}
}
}
# エラー文字をセット
$g_in{'ERROR'} = $errorStr;
# plain？
if($error_type == 1) {
# HTMLヘッダを出力
&out_html_header();
# エラーメッセージを出力
print "Error : $errorStr\n";
# エラー時のデッバグ用にフォーム変数の内容を出力
&testHashOut("g_in", \%g_in);
# html？
} elsif($error_type == 2) {
my(%tpl_html, %usr_cfg);
# 設定ファイルの読込
if($error = &tk_util2::readDataFile($g_usr{'config'}, $tk_util2::k_config_a, \%usr_cfg)) {
# 読込エラー：HTMLヘッダを出力
&out_html_header();
# エラーメッセージを出力
print "Error : $errorStr
Error : $error\n";
} else {
# 設定内容のチェック
&usr_config_check(\%usr_cfg);
# HTML処理
&general_purpose_log_view_process(\%usr_cfg, $tpl_html_error, 1);
}
# エラー時のデッバグ用にフォーム変数の内容を出力
&testHashOut("g_in", \%g_in);
# js_text？
} elsif($error_type == 3) {
my(%tpl_html, %usr_cfg);
$tpl_html_error = $g_usr{'js_user_error'};
# 設定ファイルの読込
if($error = &tk_util2::readDataFile($g_usr{'config'}, $tk_util2::k_config_a, \%usr_cfg)) {
# 読込エラー：HTMLヘッダを出力
&out_mime_header("application/x-javascript");
# エラーメッセージを出力
print "document.write(\"Error : $errorStr
Error : $error\")\;\n";
} else {
# 設定内容のチェック
&usr_config_check(\%usr_cfg);
# HTML処理
&general_purpose_log_view_process(\%usr_cfg, $tpl_html_error, 1);
}
# エラー時のデッバグ用にフォーム変数の内容を出力
&testHashOut("g_in", \%g_in, "/* ---%%SEP%%--- */");
}
} else {
# gif：ERROR GIF IMAGE を作成
my(@err_gif) = (
'47', '49', '46', '38', '39', '61', '2d', '00',
'0f', '00', '80', '00', '00', '00', '00', '00',
'ff', 'ff', 'ff', '2c', '00', '00', '00', '00',
'2d', '00', '0f', '00', '00', '02', '49', '8c',
'8f', 'a9', 'cb', 'ed', '0f', 'a3', '9c', '34',
'81', '7b', '03', 'ce', '7a', '23', '7c', '6c',
'00', 'c4', '19', '5c', '76', '8e', 'dd', 'ca',
'96', '8c', '9b', 'b6', '63', '89', 'aa', 'ee',
'22', 'ca', '3a', '3d', 'db', '6a', '03', 'f3',
'74', '40', 'ac', '55', 'ee', '11', 'dc', 'f9',
'42', 'bd', '22', 'f0', 'a7', '34', '2d', '63',
'4e', '9c', '87', 'c7', '93', 'fe', 'b2', '95',
'ae', 'f7', '0b', '0e', '8b', 'c7', 'de', '02',
'00', '3b'
);
# gif イメージヘッダを出力
print "Content-type: image/gif\n\n";
foreach (@err_gif) {
my($data) = pack('C*',hex($_));
print $data;
}
}
exit(1);
}
# 任意のハッシュの一覧を出力（テスト用）
sub testHashOut
{
my($info, $hash, $comment_block) = @_;
my($key, $cb_head, $cb_foot);
# コメントブロックの指定はあるか？
if($comment_block) {
# ある：指定の設定を適用
($cb_head, $cb_foot) = split(/%%SEP%%/, $comment_block);
} else {
# ない：省略時（HTML）の設定を適用
$cb_head = "";
}
print("\n\n", $cb_head, " Test Hash Out ($info) ---\n\n");
print("key = value\n");
print("--------------------------------------------------------\n");
foreach $key (sort keys %$hash) {
print("$key = $hash->{$key}\n");
}
print("--------------------------------------------------------\n");
print("\n--- end of Test Hash Out ($info) ", $cb_foot, "\n\n");
}
#EOF
1;