| Current Path : /home/tools/fm/ |
FreeBSD hs32.drive.ne.jp 9.1-RELEASE FreeBSD 9.1-RELEASE #1: Wed Jan 14 12:18:08 JST 2015 root@hs32.drive.ne.jp:/sys/amd64/compile/hs32 amd64 |
| Current File : //home/tools/fm/fmadmin.cgi |
#!/usr/bin/perl -w
#
# fmadmin.cgi
#
#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
#// use Module
#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
use strict;
use Jcode;
use CGI::FastTemplate;
use ADN::HTML;
use ADN::Utility;
#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
#// Controller
#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
#// ----------------------------------------------------------
#// 変数設定
#// ----------------------------------------------------------
my $query = ADN::Utility::query();
my $action = 0;
my $page = 1;
my $write = 0;
my $tips = '';
if ($query->{form}->{action}) { $action = $query->{form}->{action}; }
if ($query->{form}->{page}) { $page = $query->{form}->{page}; }
if ($query->{form}->{write}) { $write = $query->{form}->{write}; }
if ($query->{form}->{tips}) { $tips = $query->{form}->{tips}; }
#// ----------------------------------------------------------
#// 設定ファイルからハッシュリファレンス生成
#// ----------------------------------------------------------
my $file_conf = './fmadmin.conf';
my $conf = ADN::Utility::read_conf($file_conf);
my $path_tml = $conf->{PATH_TML};
$conf->{ACTION} = $action;
$conf->{PAGE} = $page;
$conf->{CONF} = $write;
$conf->{TIPS} = $tips;
$conf->{CONF_ADMIN} = $file_conf;
#// ----------------------------------------------------------
#// スイッチ
#// ----------------------------------------------------------
my $tml = new CGI::FastTemplate($path_tml);
my $check = 0;
#// トップページ
if ($action == 0) {
$check = 1;
index_conf($tml, $conf);
}
#// 新規項目作成
if ($action == 1) {
$check = 1;
if ($page == 1) { item_conf1($tml, $conf, $query); }
if ($page == 2) {
my $add = $query->{form}->{add};
if (!defined $add) {
item_conf2($tml, $conf, '', $query);
} else {
item_conf1($tml, $conf, $query);
}
}
if ($page == 3) { item_conf3($tml, $conf, $query); }
if ($page == 4) { item_conf4($tml, $conf, $query, $file_conf); }
}
#// 既存項目修正
if ($action == 2) {
$check = 1;
if ($page == 1) { change_conf1($tml, $conf, $query); }
if ($page == 2) {
my $add = $query->{form}->{add};
if (!defined $add) {
change_conf2($tml, $conf, $query);
} else {
change_conf1($tml, $conf, $query);
}
}
if ($page == 3) { change_conf3($tml, $conf, $query); }
if ($page == 4) { change_conf4($tml, $conf, $query, $file_conf); }
}
#// ステージング
if ($action == 3) {
$check = 1;
if ($page == 1) { stage_conf1($tml, $conf, $query); }
if ($page == 2) {
if ($write == 1) {
stage_conf0($tml, $conf, $query);
} else {
stage_conf2($tml, $conf, $query);
}
}
}
#// レイアウト設定
if ($action == 4) {
$check = 1;
if ($page == 1) { layout_conf1($tml, $conf, $query); }
if ($page == 2) {
if ($write == 1) {
layout_conf0($tml, $conf, $query);
} else {
layout_conf2($tml, $conf, $query);
}
}
}
#// メール設定
if ($action == 5) {
$check = 1;
if ($page == 1) { mail_conf1($tml, $conf, $query); }
if ($page == 2) {
if ($write == 1) {
mail_conf0($tml, $conf, $query);
} else {
mail_conf2($tml, $conf, $query);
}
}
}
#// CSV 設定
if ($action == 6) {
$check = 1;
if ($page == 1) { csv_conf1($tml, $conf, $query); }
if ($page == 2) {
if ($write == 1) {
csv_conf0($tml, $conf, $query);
} else {
csv_conf2($tml, $conf, $query);
}
}
}
#// スタイル設定
if ($action == 7) {
$check = 1;
if ($page == 1) { style_conf1($tml, $conf, $query); }
if ($page == 2) { style_conf2($tml, $conf, $query); }
if ($page == 3) {
if ($write == 1) {
style_conf0($tml, $conf, $query);
} else {
style_conf3($tml, $conf, $query);
}
}
}
#// 運転モード設定
if ($action == 8) {
$check = 1;
if ($page == 1) { maint_conf1($tml, $conf, $query); }
if ($page == 2) {
if ($write == 1) {
maint_conf0($tml, $conf, $query);
} else {
maint_conf2($tml, $conf, $query);
}
}
}
#// オンラインヘルプ
if ($action == 9) {
$check = 1;
show_tips($tml, $conf, $tips);
}
#// トピックス
if ($action == 10) {
$check = 1;
show_topics($tml, $conf);
}
#// ビューア
if ($action == 11) {
$check = 1;
viewer($tml, $conf, $query);
}
#// 不正なアクションモード
if ($check == 0) {
my @error = ();
my $msg = $conf->{ALERT_NO_TARGET};
my $ref = [];
$ref->[0] = $conf->{ALERT_NO_TARGET};
$ref->[1] = $conf->{TITLE_INDEX};
push(@error, $ref);
show_error($tml, $conf, \@error);
}
#// HTML 出力
ADN::HTML::write_adn($tml, $conf);
#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
#// Model (トップページ)
#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
sub index_conf {
my ($tml, $conf) = @_;
$tml->define(main => "index.html");
$tml->assign($conf);
#// リンク生成判定 前準備
my $path = $conf->{CUST_PATH_TML};
my $path0 = $conf->{CUST_PATH_TML0};
my $admin = $conf->{SCRIPT_ADMIN};
my $ls = $conf->{SYSTEM_LS};
my $check = `$ls $path`; chomp $check;
my $check0 = `$ls $path0`; chomp $check0;
my %link = ();
my $list0 = {
2 => "TITLE_TIPS_CHANGE",
3 => "TITLE_TIPS_STAGE",
4 => "TITLE_TIPS_LAYOUT",
5 => "TITLE_TIPS_MAIL",
6 => "TITLE_TIPS_CSV",
7 => "TITLE_TIPS_STYLE",
};
my $list = {
8 => "TITLE_TIPS_MAINT",
};
#// 本番環境リンク生成
my $script = "javascript:popup0('$conf->{SCRIPT_FORM}')";
my $title = $conf->{TITLE_FORM};
if ($check) { $title = ADN::HTML::mkhtml_link('', $script, $title); }
$link{TITLE_FORM} = $title;
#// 動作テストリンク生成
my $str0 = $conf->{SCRIPT_FORM} . '?mode=1';
my $script0 = "javascript:popup0('$str0')";
my $title0 = $conf->{TITLE_TIPS_FMTEST};
if ($check0) { $title0 = ADN::HTML::mkhtml_link('', $script0, $title0); }
$link{TITLE_TIPS_FMTEST} = $title0;
#// メニューリンク生成
if ($check0) {
foreach my $i (%$list0) {
next unless ($list0->{$i});
my $key = $list0->{$i};
my $str = $admin . '?action=' . $i;
my $value = ADN::HTML::mkhtml_link('', $str, $conf->{$key});
$link{$key} = $value;
}
}
if ($check) {
foreach my $i (%$list) {
next unless ($list->{$i});
my $key = $list->{$i};
my $str = $admin . '?action=' . $i;
my $value = ADN::HTML::mkhtml_link('', $str, $conf->{$key});
$link{$key} = $value;
}
}
$tml->assign(%link);
$tml->assign(MAKE_TITLE => $conf->{TITLE_INDEX});
}
#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
#// Model (新規項目作成)
#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
sub item_conf1 {
my ($tml, $conf, $query) = @_;
$tml->define( main => "item_p1.html",
list => "item_row1.html",
type => "item_type.html",
);
$tml->assign($conf);
#// 入力欄 表示
my $num = get_num($query, 'num');
foreach (1 .. $num) {
my $show_n = "NAME" . $_ . "_SHOW";
my $type_n = "NAME" . $_ . "_TYPE";
my $show_v = '';
if ($query->{form}->{$show_n}) {
$show_v = ADN::Utility::htmlchars($query->{form}->{$show_n});
}
my $type_v = '';
if ($query->{form}->{$type_n}) {
$type_v = ADN::Utility::htmlchars($query->{form}->{$type_n});
}
#// フォームタイプ欄 表示
$tml->clear("TYPE_ROW");
foreach my $i (1 .. 5) {
my $value0 = "TYPE0_VALUE" . $i; $value0 = $conf->{$value0};
my $text0 = "TYPE0_TEXT" . $i; $text0 = $conf->{$text0};
my $select = '';
if ($type_v ne '' && $type_v eq $value0) { $select = ' selected="selected"'; }
$tml->assign( MAKE_TYPE_VALUE => $value0,
MAKE_TYPE_TEXT => $text0,
MAKE_TYPE_SELECT => $select
);
$tml->parse(TYPE_ROW => ".type");
}
#// 表示名欄 表示
$tml->assign( MAKE_ITEM_NUM => $_,
MAKE_ITEM_SHOW => $show_n,
MAKE_ITEM_VALUE => $show_v,
MAKE_ITEM_TYPE => $type_n,
MAKE_ITEM_COLOR => tune_color($_, $conf),
);
$tml->parse(LIST_ROW => ".list");
}
$tml->assign( MAKE_ITEM => $num,
MAKE_ACTION => $conf->{ACTION},
MAKE_TITLE => $conf->{TITLE_ITEM1},
);
}
sub item_conf2 {
my ($tml, $conf, $conf0, $query) = @_;
my @error = ();
$tml->define( main => "item_p2.html",
list => "item_row2.html",
text => "conf_text.html",
radio => "conf_radio.html",
checkbox => "conf_checkbox.html",
select => "conf_select.html",
textarea => "conf_textarea.html",
addon => "conf_addon.html"
);
$tml->assign($conf);
#// 入力欄 表示
my @target = split(/ /, $conf->{BASENAME_ITEM});
my $num = get_num($query, 'item');
my $item = 1;
my $check = 0;
foreach (1 .. $num) {
my $show_n = "NAME" . $_ . "_SHOW";
my $type_n = "NAME" . $_ . "_TYPE";
my $name_n = "NAME" . $_ . "_NAME";
next if ($query->{form}->{$show_n} eq '' &&
$query->{form}->{$type_n} eq '');
#// 表示名・タイプのいずれかが空欄
if ($query->{form}->{$show_n} eq '' || $query->{form}->{$type_n} eq '') {
my $ref = [];
$ref->[0] = $conf->{ALERT_VALUE_BLANK};
$ref->[1] = ($query->{form}->{$show_n} eq '') ? $conf->{ITEM_NAME0} : $conf->{ITEM_NAME1};
push(@error, $ref);
show_error($tml, $conf, \@error);
}
$check = 1;
my %target = (); my $num0 = 0;
#// アサイン
foreach my $target (@target) {
if ($target eq "SHOW" || $target eq "TYPE") {
my $key = "MAKE_ITEM_KEY" . $num0;
#// 飛び石で入力された場合の番号調整
my $name = "NAME" . $item . "_" . $target;
my $name0 = "NAME" . $_ . "_" . $target;
my $value = 'MAKE_ITEM_' . $target;
$target{$key} = $name;
$target{$value} = get_value($name0, $query);
if ($target eq "TYPE") {
foreach my $key (%$conf) {
next if (!defined $conf->{$key});
next if ($key !~ /^TYPE0_VALUE/);
#// TYPE0_VALUEx の日本語表示
if ($conf->{$key} eq $target{$value}) {
$key =~ s/_VALUE/_TEXT/;
$target{MAKE_TYPE_TEXT} = $conf->{$key};
last;
}
}
}
} else {
my $name = "NAME" . $item . "_" . $target;
my $value = 'MAKE_ITEM_' . $target;
$target{$value} = $name;
$target{MAKE_TEXT_VALUE} = '';
$target{MAKE_TEXT_INIT} = '';
#// 既存項目修正の場合
if ($conf0) {
my $type = $query->{form}->{$type_n};
%target = verify1_conf2($type, \%target, $conf0, $target, $name);
}
}
$num0 += 1;
}
$target{MAKE_ITEM_COLOR} = tune_color($item, $conf);
$target{MAKE_ITEM_INPUT} = $item;
$target{MAKE_MUST_CHECK} = '';
#// 既存項目修正の場合
if ($conf0) { %target = verify2_conf2($name_n, \%target, $conf0); }
#// テンプレート
$tml->assign(%target);
$tml->parse(MAKE_CONF_ADDON => "addon");
my $type = $target{MAKE_ITEM_TYPE};
if ($type eq "text") { $tml->parse(MAKE_CONF_EXT => "text"); }
if ($type eq "radio") { $tml->parse(MAKE_CONF_EXT => "radio"); }
if ($type eq "checkbox") { $tml->parse(MAKE_CONF_EXT => "checkbox"); }
if ($type eq "select") { $tml->parse(MAKE_CONF_EXT => "select"); }
if ($type eq "textarea") { $tml->parse(MAKE_CONF_EXT => "textarea"); }
$tml->parse(LIST_ROW => ".list");
$item += 1;
}
#// 表示名・タイプがすべて空欄
if ($check == 0) {
my $ref = [];
$ref->[0] = $conf->{ALERT_VALUE_BLANK};
$ref->[1] = "$conf->{ITEM_NAME0} $conf->{ITEM_NAME1}";
push(@error, $ref);
show_error($tml, $conf, \@error);
}
#// アサイン
$tml->assign( MAKE_ACTION => $conf->{ACTION},
MAKE_TITLE => $conf->{TITLE_ITEM2},
);
}
sub item_conf3 {
my ($tml, $conf, $query) = @_;
my @error = ();
@error = check_dupli(
$query->{form}->{SORT_INPUT}, $conf->{ITEM_NAME3}, $conf);
push(@error, check_size($conf, $query));
if (@error) { show_error($tml, $conf, \@error); }
#// テンプレート
$tml->define( main => "item_p3.html",
list => "item_row3.html",
type => "item_type.html",
page => "item_type.html",
hidden => "item_hidden.html"
);
my $sort = get_input($query->{form}->{SORT_INPUT}, 1);
my $must = get_input($query->{form}->{MUST_INPUT});
$tml->assign($conf);
$tml->assign( MAKE_SORT_INPUT => $sort,
MAKE_MUST_INPUT => $must
);
#// 入力欄 表示 (ECC = Error Check Code)
my @target = split(/ /, $conf->{BASENAME_ITEM});
my @sort = split(/ /, $sort);
my @must = split(/ /, $must);
my $num = $#sort + 1;
my $ecc = key_num('ECC0_VALUE', $conf);
foreach (@sort) {
#// チェックタイプ 表示
$tml->clear("TYPE_ROW");
foreach my $i (1 .. $ecc) { #// fmadmin.conf
my $value0 = "ECC0_VALUE" . $i; $value0 = $conf->{$value0};
my $text0 = "ECC0_TEXT" . $i; $text0 = $conf->{$text0};
my $select = '';
$tml->assign( MAKE_TYPE_VALUE => $value0,
MAKE_TYPE_TEXT => $text0,
MAKE_TYPE_SELECT => $select
);
$tml->parse(TYPE_ROW => ".type");
}
#// 入力欄イメージ 作成
my %target = ();
$tml->clear("HIDDEN_ROW");
foreach my $target (@target) {
next if ($target eq "ECC0");
my $name = "NAME" . $_ . "_" . $target;
my $value = get_value($name, $query);
my $label = 'MAKE_ITEM_' . $target;
$target{$label} = $value;
$tml->assign( MAKE_HIDDEN_NAME => $name,
MAKE_HIDDEN_VALUE => $value
);
$tml->parse(HIDDEN_ROW => ".hidden");
}
#// ページ選択欄 表示
$tml->clear("PAGE_ROW");
foreach (1 .. $conf->{PAGE_SEP}) {
$tml->assign( MAKE_TYPE_VALUE => $_,
MAKE_TYPE_TEXT => $_,
MAKE_TYPE_SELECT => ''
);
$tml->parse(PAGE_ROW => ".page");
}
#// %target 代入
$target{MAKE_ITEM_ECC} = "NAME" . $_ . "_ECC0";
$target{MAKE_ITEM_PAGE} = "NAME" . $_ . "_PAGE";
$target{MAKE_ITEM_COLOR} = tune_color($_, $conf, \@must);
$target{MAKE_ITEM_IMAGE} = make_prev($_, \%target);
$tml->assign(%target);
$tml->parse(LIST_ROW => ".list");
}
$tml->assign( MAKE_ACTION => $conf->{ACTION},
MAKE_TITLE => $conf->{TITLE_ITEM3},
);
}
sub item_conf4 {
my ($tml, $conf, $query, $admin) = @_;
#// ページ数取得, 整理
my ($ref0, $ref1) = check_page($conf, $query);
my @page = @$ref0;
my @error = @$ref1;
#// エラー
if (@error) { show_error($tml, $conf, \@error); }
#// 各ページ内並び順取得
my @sort = split(/ /, $query->{form}->{SORT_INPUT});
my @must = split(/ /, $query->{form}->{MUST_INPUT});
my $sort = {};
my $must = {};
foreach my $page (@page) {
my $sort_i = "SORT_INPUT" . $page;
my $must_i = "MUST_INPUT" . $page;
foreach (@sort) {
my $name = "NAME" . $_ . "_PAGE";
my $value = ADN::Utility::z2asc($query->{form}->{$name});
if ($page == $value) { $sort->{$sort_i} .= "$_ "; }
}
foreach (@must) {
my $name = "NAME" . $_ . "_PAGE";
my $value = ADN::Utility::z2asc($query->{form}->{$name});
if ($page == $value) { $must->{$must_i} .= 'name' . $_ . ','; }
}
}
#// テンプレート
$tml->define(main => "item_p4.html");
$tml->assign($conf);
my $path = $conf->{CUST_PATH_TML0};
my $file = $path . $conf->{CONF_FORM};
my $fmadmin = $conf->{SCRIPT_ADMIN};
#// ファイルハンドル オープン
open CONF0, "+>$file";
#// 設定ファイルに書き出し (初期全般設定)
my $num = $#page + 1;
my $list = `$conf->{SYSTEM_CAT} $admin`;
my @init = split(/\n/, $list);
foreach (@init) {
next if ($_ =~ /^#\/\//);
if ($_ =~ /^INIT_/) {
$_ =~ s/^INIT_//;
$_ =~ s/(\t+)/\t/g;
my $input = 'TITLE_INPUT';
if ($_ =~ /^$input/) {
foreach my $page (@page) {
my $conv = $input . $page;
$_ =~ s/$input//;
print CONF0 $conv . $_;
print CONF0 " ($page/" . $num . ")\n";
}
} else {
print CONF0 "$_\n";
}
}
}
print CONF0 "\n";
#// 設定ファイルに書き出し (ページ数)
print CONF0 "PAGE_INPUT\t" . $num . "\n";
#// 設定ファイルに書き出し (SORT_INPUT)
foreach my $key (%$sort) {
next if (!defined $sort->{$key});
my $value = $sort->{$key}; $value =~ s/ $//;
if ($key =~ /^SORT_INPUT/) {
print CONF0 "$key\t$value\n";
}
}
#// 設定ファイルに書き出し (MUST_INPUT)
foreach my $key (%$must) {
next if (!defined $must->{$key});
my $value = $must->{$key}; $value =~ s/,$//;
if ($key =~ /^MUST_INPUT/) {
print CONF0 "$key\t$value\n";
}
}
print CONF0 "\n";
#// 設定ファイルに書き出し (NAMEx_XXXX)
foreach my $key (%$sort) {
next if (!defined $sort->{$key});
foreach my $num (split(/ /, $sort->{$key})) {
my $name = "NAME" . $num . "_";
my $type = "NAME" . $num . "_TYPE";
print CONF0 $name . "NAME" . "\t" . "name" . $num . "\n";
foreach (%{$query->{form}}) {
next if ($_ =~ /_PAGE$/);
my $flag = write_skip($type, $_, $query);
next if ($flag == 1);
if ($_ =~ /^$name/ && $_ !~ /_TEXT$/) {
print CONF0 "$_\t" . $query->{form}->{$_} . "\n";
}
}
write_conv($type, $name, $query);
}
print CONF0 "\n";
}
#// ファイルハンドル クローズ
close CONF0;
#// パーミッション変更
my $chmod = $conf->{SYSTEM_CHMOD};
`$chmod 666 $file`;
#// 動作確認リンク
my $script = $conf->{SCRIPT_FORM} . "?mode=1";
$tml->assign( MAKE_SCRIPT => $script,
MAKE_ACTION => $conf->{ACTION},
MAKE_TITLE => $conf->{TITLE_ITEM4},
);
#// テンプレート作成 (お客様用)
write_tml($file, $chmod, $path, $fmadmin, $conf->{SCRIPT_FORM});
copy_tml($conf);
}
#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
#// Model (既存項目修正)
#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
sub change_conf1 {
my ($tml, $conf, $query) = @_;
my $path = $conf->{CUST_PATH_TML0};
my $file = $path . $conf->{CONF_FORM};
my $conf0 = ADN::Utility::read_conf($file);
my $page = $conf0->{PAGE_INPUT};
#// item_conf1() に適用するための $query, $conf 挿入
my $num = 0;
foreach my $p (1 .. $page) {
my $sort_n = "SORT_INPUT" . $p;
my $sort_v = $conf0->{$sort_n};
my @item = split(/ /, $sort_v);
$num += $#item + 1;
foreach (@item) {
my $show_n = "NAME" . $_ . "_SHOW";
my $type_n = "NAME" . $_ . "_TYPE";
$query->{form}->{$show_n} = $conf0->{$show_n};
$query->{form}->{$type_n} = $conf0->{$type_n};
}
}
unless ($query->{form}->{num}) { $query->{form}->{num} = $num; }
$conf->{TITLE_ITEM1} = $conf->{TITLE_CHANGE1};
item_conf1($tml, $conf, $query);
}
sub change_conf2 {
my ($tml, $conf, $query) = @_;
my $path = $conf->{CUST_PATH_TML0};
my $file = $path . $conf->{CONF_FORM};
my $conf0 = ADN::Utility::read_conf($file);
my $page = $conf0->{PAGE_INPUT};
$conf->{TITLE_ITEM2} = $conf->{TITLE_CHANGE2};
item_conf2($tml, $conf, $conf0, $query);
}
sub change_conf3 {
my ($tml, $conf, $query) = @_;
$conf->{TITLE_ITEM3} = $conf->{TITLE_CHANGE3};
item_conf3($tml, $conf, $query);
}
sub change_conf4 {
my ($tml, $conf, $query, $file_conf) = @_;
$conf->{TITLE_ITEM4} = $conf->{TITLE_CHANGE4};
item_conf4($tml, $conf, $query, $file_conf);
}
#// ------------------------------------------------------------------
#// Model (Verify)
#// ------------------------------------------------------------------
sub verify1_conf2 { #// item_conf2() から呼ばれる
my ($type, $ref, $conf0, $target, $name) = @_;
my %target = %$ref;
if ($type eq "text") {
if ($target eq "SIZE") { $target{TEXT_INIT1} = $conf0->{$name}; }
if ($target eq "INIT") { $target{TEXT_INIT2} = $conf0->{$name}; }
}
if ($type eq "radio" || $type eq "checkbox" || $type eq "select") {
my $value_t = ''; my $value_i = '';
my $t = 1; my $i = 1;
my $base_t = "NAME" . $_ . "_TEXT";
my $base_i = "NAME" . $_ . "_INIT";
foreach my $key (%$conf0) {
next if (!defined $conf0->{$key});
next unless ($key =~ /$base_t/ || $key =~ /$base_i/);
if ($key =~ /$base_t/) {
my $name_t = $base_t . $t;
$value_t .= $conf0->{$name_t} . "\n";
$t++;
}
if ($key =~ /$base_i/) {
my $name_i = $base_i . $i;
if ($conf0->{$name_i}) {
$name_i =~ s/INIT/TEXT/;
$value_i .= $conf0->{$name_i} . "\n";
}
$i++;
}
}
$value_t =~ s/\n$//; $value_i =~ s/\n$//;
$target{MAKE_TEXT_VALUE} = $value_t;
$target{MAKE_TEXT_INIT} = $value_i;
}
if ($type eq "select") {
if ($target eq "SIZE") { $target{SELECT_INIT2} = $conf0->{$name}; }
if ($target eq "ADD0") {
if ($conf0->{$name}) { $target{SELECT_INIT5} = ' checked="checked"'; }
}
if ($target eq "OPTI") {
if ($conf0->{$name}) { $target{SELECT_INIT6} = ' checked="checked"'; }
}
}
if ($type eq "textarea") {
if ($target eq "COLS") { $target{TEXTAREA_INIT1} = $conf0->{$name}; }
if ($target eq "ROWS") { $target{TEXTAREA_INIT2} = $conf0->{$name}; }
if ($target eq "INIT") { $target{TEXTAREA_INIT3} = $conf0->{$name}; }
}
return %target;
}
sub verify2_conf2 { #// item_conf2() から呼ばれる
my ($name_n, $ref, $conf0) = @_;
my $page = $conf0->{PAGE_INPUT};
my $check = 0;
my %target = %$ref;
foreach my $p (1 .. $page) {
my $must_n = "MUST_INPUT" . $p;
my $must_v = $conf0->{$must_n};
if ($must_v) {
foreach (split(/,/, $must_v)) {
if ($_ eq $conf0->{$name_n}) {
$target{MAKE_MUST_CHECK} = ' checked="checked"';
$check = 1;
last;
}
}
}
last if ($check == 1);
}
return %target;
}
#// ------------------------------------------------------------------
#// Model (レイアウト設定)
#// ------------------------------------------------------------------
sub layout_conf1 {
my ($tml, $conf, $query) = @_;
$tml->define( main => "layout_p1.html",
row => "layout_row1.html"
);
$tml->assign($conf);
my $path = $conf->{CUST_PATH_TML0};
my $file = $path . $conf->{CONF_FORM};
my $conf0 = ADN::Utility::read_conf($file);
my $page = $conf0->{PAGE_INPUT};
foreach (1 .. $page) {
my $name = "TITLE_INPUT" . $_;
my $value = ADN::Utility::htmlchars($conf0->{$name});
$tml->assign( MAKE_NAME => $name,
MAKE_VALUE => $value
);
$tml->parse(INPUT_ROW => ".row");
}
my @title = qw( TITLE_CONFIRM TITLE_THANKS TITLE_MAINT TITLE_ERROR
TABLE_BASE TD_TITLE TD_INPUT TD_MUST_INPUT TD_ERROR );
foreach (@title) {
my $str = 'MAKE_' . $_;
$tml->assign($str => ADN::Utility::htmlchars($conf0->{$_}));
}
$tml->assign(MAKE_TITLE => $conf->{TITLE_LAYOUT1});
}
sub layout_conf0 {
my ($tml, $conf, $query) = @_;
#// ユーザ設定ファイル
my $cust_path = $conf->{CUST_PATH_TML0};
my $cust_old = $cust_path . $conf->{CONF_FORM};
my $cust_new = $cust_old . '.0';
_write_conf1($cust_old, $cust_new, $conf, $query, '');
#// 管理者設定ファイル
my $prefix = 'INIT_';
my $admin_old = $conf->{CONF_ADMIN};
my $admin_new = $admin_old . '.0';
_write_conf1($admin_old, $admin_new, $conf, $query, $prefix);
#// リダイレクト
$conf->{MAKE_URL} = make_uri($conf, "action=4&page=2");
ADN::HTML::redirect($tml, $conf);
}
sub layout_conf2 {
my ($tml, $conf, $query) = @_;
$tml->define(main => "layout_p2.html");
$tml->assign($conf);
my $path = $conf->{CUST_PATH_TML0};
my $file = $path . $conf->{CONF_FORM};
my $conf0 = ADN::Utility::read_conf($file);
my $input = '';
my $page = $conf0->{PAGE_INPUT};
foreach (1 .. $page) {
my $name = "TITLE_INPUT" . $_;
my $value = ADN::Utility::htmlchars($conf0->{$name});
$input .= ADN::HTML::mkhtml_br('', $value);
}
my @title = qw( TITLE_CONFIRM TITLE_THANKS TITLE_MAINT TITLE_ERROR
TABLE_BASE TD_TITLE TD_INPUT TD_MUST_INPUT TD_ERROR );
foreach (@title) {
my $str = 'MAKE_' . $_;
$tml->assign($str => ADN::Utility::htmlchars($conf0->{$_}));
}
#// 動作確認リンク
my $script = $conf->{SCRIPT_FORM} . "?mode=1";
$tml->assign( MAKE_TITLE => $conf->{TITLE_LAYOUT2},
MAKE_TITLE_INPUT => $input,
MAKE_SCRIPT => $script
);
}
#// ------------------------------------------------------------------
#// Model (ステージング)
#// ------------------------------------------------------------------
sub stage_conf1 {
my ($tml, $conf, $query) = @_;
$tml->define(main => "stage_p1.html");
$tml->assign($conf);
my $script = $conf->{SCRIPT_FORM} . "?mode=1";
$tml->assign( MAKE_SCRIPT => $script,
MAKE_TITLE => $conf->{TITLE_STAGE1},
);
}
sub stage_conf0 {
my ($tml, $conf, $query) = @_;
my $rm = $conf->{SYSTEM_RM};
my $cp = $conf->{SYSTEM_CP};
my $chmod = $conf->{SYSTEM_CHMOD};
my $from = $conf->{CUST_PATH_TML0};
my $to = $conf->{CUST_PATH_TML};
#// コピー
`$rm $to*`;
`$cp $from* $to`;
#// リダイレクト
$conf->{MAKE_URL} = make_uri($conf, "action=3&page=2");
ADN::HTML::redirect($tml, $conf);
}
sub stage_conf2 {
my ($tml, $conf, $query) = @_;
$tml->define(main => "stage_p2.html");
$tml->assign($conf);
$tml->assign(MAKE_TITLE => $conf->{TITLE_STAGE2});
}
#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
#// Model (メール設定)
#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
sub mail_conf1 {
my ($tml, $conf, $query) = @_;
$tml->define(main => "mail_p1.html");
$tml->assign($conf);
$conf->{INIT_MAIL_ADD0} =~ s/\x5c\x6e/\n/g;
$tml->assign( MAKE_MAIL_SUBJ => $conf->{INIT_MAIL_SUBJ},
MAKE_MAIL_FROM => $conf->{INIT_MAIL_FROM},
MAKE_MAIL_RCPT0 => $conf->{INIT_MAIL_RCPT0},
MAKE_MAIL_RCPT => $conf->{INIT_MAIL_RCPT},
MAKE_MAIL_COPY => $conf->{INIT_MAIL_COPY},
MAKE_MAIL_LINE => $conf->{INIT_MAIL_LINE},
MAKE_MAIL_ADD0 => $conf->{INIT_MAIL_ADD0},
MAKE_TITLE => $conf->{TITLE_MAIL1}
);
}
sub mail_conf0 {
my ($tml, $conf, $query) = @_;
#// メールアドレス形式, MX チェック
my @error = (); my %target = ();
my @target = qw( MAIL_FROM MAIL_RCPT0 MAIL_RCPT MAIL_COPY );
foreach (@target) {
my ($ref, $target) = ADN::Utility::mail_check($query->{form}->{$_});
if (@$ref) {
my @conv = ();
foreach (@$ref) {
my ($addr, $check) = split(/\t/);
my $msg = '';
if ($check == 1) { $msg = $conf->{ALERT_MAIL_ADDRESS}; }
if ($check == 2) { $msg = $conf->{ALERT_MAIL_MXCHECK}; }
$msg = ADN::HTML::mkhtml_br('', $msg) . "($addr)";
push(@conv, $msg);
}
my $title = "DISP_" . $_;
push(@conv, $conf->{$title});
push(@error, \@conv);
} else {
$target{$_} = $target;
$tml->assign($_ => ADN::Utility::htmlchars($target));
}
}
#// MAIL_LINE
my $line = $query->{form}->{MAIL_LINE}; $target{MAIL_LINE} = $line;
unless ($line =~ /^(\d){2}$/) {
my $ref = [];
$ref->[0] = "$line : " . $conf->{ALERT_MAIL_LINE};
$ref->[1] = $conf->{DISP_MAIL_LINE},
push(@error, $ref);
}
#// エラー
if (@error) { show_error($tml, $conf, \@error); }
#// 出力
my $subj = $query->{form}->{MAIL_SUBJ}; $target{MAIL_SUBJ} = $subj;
my $add0 = $query->{form}->{MAIL_ADD0};
my $tmp = $add0; $tmp =~ s/\r\n/\x5c\x6e/g;
$target{MAIL_ADD0} = $tmp;
#// 設定ファイル更新
write_conf($conf, \%target, 'MAIL_');
#// リダイレクト
$conf->{MAKE_URL} = make_uri($conf, "action=5&page=2");
ADN::HTML::redirect($tml, $conf);
}
sub mail_conf2 {
my ($tml, $conf, $query) = @_;
$tml->define(main => "mail_p2.html");
$tml->assign($conf);
$conf->{INIT_MAIL_ADD0} =~ s/\x5c\x6e/\n/g;
my $script = $conf->{SCRIPT_FORM} . "?mode=1";
$tml->assign( MAKE_MAIL_SUBJ => $conf->{INIT_MAIL_SUBJ},
MAKE_MAIL_FROM => $conf->{INIT_MAIL_FROM},
MAKE_MAIL_RCPT0 => $conf->{INIT_MAIL_RCPT0},
MAKE_MAIL_RCPT => $conf->{INIT_MAIL_RCPT},
MAKE_MAIL_COPY => $conf->{INIT_MAIL_COPY},
MAKE_MAIL_LINE => $conf->{INIT_MAIL_LINE},
MAKE_MAIL_ADD0 => $conf->{INIT_MAIL_ADD0},
MAKE_TITLE => $conf->{TITLE_MAIL2},
MAKE_SCRIPT => $script,
);
}
#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
#// Model (CSV 設定)
#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
sub csv_conf1 {
my ($tml, $conf, $query) = @_;
$tml->define(main => "csv_p1.html");
$tml->assign($conf);
$tml->assign( MAKE_CSV_PATH => $conf->{INIT_CSV_PATH},
MAKE_CSV_CHAR => $conf->{INIT_CSV_CHAR},
MAKE_CSV_TYPE => $conf->{INIT_CSV_TYPE},
MAKE_CSV_ITEM => $conf->{INIT_CSV_ITEM},
MAKE_TITLE => $conf->{TITLE_CSV1}
);
}
sub csv_conf0 {
my ($tml, $conf, $query) = @_;
my @error = (); my %target = ();
my $path = $query->{form}->{CSV_PATH};
my $touch = $conf->{SYSTEM_TOUCH};
my $rm = $conf->{SYSTEM_RM};
$path =~ s/;/ /;
#// CSV_PATH
if ( !-e $path ) {
`$touch $path`;
if ( !-e $path ) {
my $ref = [];
$ref->[0] = ADN::HTML::mkhtml_br('', $conf->{ALERT_CSV_PATH}) . "($path)";
$ref->[1] = $conf->{DISP_CSV_PATH},
push(@error, $ref);
}
}
#// CSV_CHAR
my $char = ADN::Utility::z2asc($query->{form}->{CSV_CHAR});
unless ($char eq "sjis" || $char eq "euc" || $char eq "jis") {
my $ref = [];
$ref->[0] = ADN::HTML::mkhtml_br('', $conf->{ALERT_CSV_CHAR}) . "($char)";
$ref->[1] = $conf->{DISP_CSV_CHAR},
push(@error, $ref);
}
#// CSV_TYPE
my $type = ADN::Utility::z2asc($query->{form}->{CSV_TYPE});
unless ($type eq "0" || $type eq "1") {
my $ref = [];
$ref->[0] = ADN::HTML::mkhtml_br('', $conf->{ALERT_CSV_TYPE}) . "($type)";
$ref->[1] = $conf->{DISP_CSV_TYPE},
push(@error, $ref);
}
#// エラー
if (@error) { show_error($tml, $conf, \@error); }
#// 出力
my @target = qw( CSV_PATH CSV_CHAR CSV_TYPE CSV_ITEM );
foreach (@target) {
$target{$_} = ADN::Utility::z2asc($query->{form}->{$_});
}
#// 設定ファイル更新
write_conf($conf, \%target, 'CSV_');
#// リダイレクト
$conf->{MAKE_URL} = make_uri($conf, "action=6&page=2");
ADN::HTML::redirect($tml, $conf);
}
sub csv_conf2 {
my ($tml, $conf, $query) = @_;
$tml->define(main => "csv_p2.html");
$tml->assign($conf);
my $script = $conf->{SCRIPT_FORM} . "?mode=1";
$tml->assign( MAKE_CSV_PATH => $conf->{INIT_CSV_PATH},
MAKE_CSV_CHAR => $conf->{INIT_CSV_CHAR},
MAKE_CSV_TYPE => $conf->{INIT_CSV_TYPE},
MAKE_CSV_ITEM => $conf->{INIT_CSV_ITEM},
MAKE_TITLE => $conf->{TITLE_CSV2},
MAKE_SCRIPT => $script,
);
}
#// ------------------------------------------------------------------
#// Model (スタイル設定)
#// ------------------------------------------------------------------
sub style_conf1 {
my ($tml, $conf, $query) = @_;
$tml->define(main => "style_p1.html");
$tml->assign($conf);
my $path = $conf->{CUST_PATH_TML0};
my $ls = $conf->{SYSTEM_LS};
my $list = `$ls $path`;
my $space = ' ' x 22;
my $link = '';
foreach (split(/\n/, $list)) {
next if ($_ =~ /\.conf$/);
my $base = $conf->{SCRIPT_ADMIN} . '?action=7&page=2&file=' . $_;
my $str = ADN::HTML::mkhtml_link('', $base, $_);
$link .= ADN::HTML::mkhtml_li($space, $str, '', 1);
}
$tml->assign( MAKE_LIST => $link,
MAKE_TITLE => $conf->{TITLE_STYLE1},
);
}
sub style_conf2 {
my ($tml, $conf, $query) = @_;
my @error = ();
my $target = $query->{form}->{file};
unless ($target) {
my $ref = [];
$ref->[0] = $conf->{ALERT_STYLE_NONE};
$ref->[1] = $conf->{TITLE_TIPS_STYLE};
push(@error, $ref);
show_error($tml, $conf, \@error);
}
my $path = $conf->{CUST_PATH_TML0};
my $file = $path . $target;
unless ( -e $file ) {
my $ref = [];
$ref->[0] = ADN::HTML::mkhtml_br('', $conf->{ALERT_STYLE_NOFILE}) . "($target)";
$ref->[1] = $conf->{TITLE_TIPS_STYLE};
push(@error, $ref);
show_error($tml, $conf, \@error);
}
$tml->define(main => "style_p2.html");
$tml->assign($conf);
#// ファイル取得
my $cat = $conf->{SYSTEM_CAT};
my $value = `$cat $file`;
my $script = $conf->{SCRIPT_ADMIN} . '?action=7';
$tml->assign( MAKE_STYLE => $target,
MAKE_VALUE => ADN::Utility::htmlchars($value),
MAKE_TITLE => $conf->{TITLE_STYLE2},
MAKE_SCRIPT => $script
);
}
sub style_conf0 {
my ($tml, $conf, $query) = @_;
my @error = ();
my $target = $query->{form}->{file};
unless ($target) {
my $ref = [];
$ref->[0] = $conf->{ALERT_STYLE_NONE};
$ref->[1] = $conf->{TITLE_TIPS_STYLE};
push(@error, $ref);
show_error($tml, $conf, \@error);
}
my $path = $conf->{CUST_PATH_TML0};
my $file = $path . $target;
unless ( -e $file ) {
my $ref = [];
$ref->[0] = ADN::HTML::mkhtml_br('', $conf->{ALERT_STYLE_NOFILE}) . "($target)";
$ref->[1] = $conf->{TITLE_TIPS_STYLE};
push(@error, $ref);
show_error($tml, $conf, \@error);
}
#// ファイル更新
my $chmod = $conf->{SYSTEM_CHMOD};
my $mv = $conf->{SYSTEM_MV};
my $file0 = $file . '.0';
open WRITE, "+>$file0";
print WRITE $query->{form}->{value};
close WRITE;
`$chmod 666 $file0`;
`$mv $file0 $file`;
#// リダイレクト
$conf->{MAKE_URL} = make_uri($conf, "action=7&page=3&file=$target");
ADN::HTML::redirect($tml, $conf);
}
sub style_conf3 {
my ($tml, $conf, $query) = @_;
$tml->define(main => "style_p3.html");
$tml->assign($conf);
my $target = $query->{form}->{file};
my $script = $conf->{SCRIPT_FORM} . "?mode=1";
my $start = $conf->{SCRIPT_ADMIN} . "?action=7";
my $path = $conf->{CUST_PATH_TML0};
my $file = $path . $target;
my $cat = $conf->{SYSTEM_CAT};
my $value = `$cat $file`;
$tml->assign( MAKE_STYLE => $target,
MAKE_VALUE => ADN::Utility::htmlchars($value),
MAKE_TITLE => $conf->{TITLE_STYLE3},
MAKE_SCRIPT => $script,
MAKE_START => $start,
);
}
#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
#// Model (運転モード設定)
#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
sub maint_conf1 {
my ($tml, $conf, $query) = @_;
my $maint = "maint_p1.html";
$tml->define(main => $maint);
$tml->assign($conf);
my $mode = $conf->{INIT_MAINT};
my $show = $conf->{DISP_MAINT0};
if ($mode == 1) { $show = $conf->{DISP_MAINT1}; }
$tml->assign( MAKE_DISP_SHOW => $show,
MAKE_DISP_MODE => $mode,
MAKE_SCRIPT => $conf->{SCRIPT_FORM},
MAKE_TITLE => $conf->{TITLE_MAINT1},
);
}
sub maint_conf0 {
my ($tml, $conf, $query) = @_;
my $mode = $query->{form}->{MAINT};
my $new = 0; my %target = ();
if ($mode == 0) { $new = 1; }
if ($mode == 1) { $new = 0; }
$target{MAINT} = $new;
#// 設定ファイル更新
write_conf($conf, \%target, 'MAINT');
my $cust_path = $conf->{CUST_PATH_TML};
my $cust_old = $cust_path . $conf->{CONF_FORM};
my $cust_new = $cust_old . '.0';
_write_conf0($cust_old, $cust_new, $conf, \%target, 'MAINT');
#// リダイレクト
$conf->{MAKE_URL} = make_uri($conf, "action=8&page=2");
ADN::HTML::redirect($tml, $conf);
}
sub maint_conf2 {
my ($tml, $conf, $query) = @_;
$tml->define(main => "maint_p2.html");
$tml->assign($conf);
my $mode = $conf->{INIT_MAINT};
my $show = $conf->{DISP_MAINT0};
if ($mode == 1) { $show = $conf->{DISP_MAINT1}; }
$tml->assign( MAKE_DISP_SHOW => $show,
MAKE_SCRIPT => $conf->{SCRIPT_FORM},
MAKE_TITLE => $conf->{TITLE_MAINT2},
);
}
#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
#// Model (オンラインヘルプ)
#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
sub show_tips {
my ($tml, $conf, $tips) = @_;
my $base = "tips_base.html";
my $body = "tips_" . $tips . ".html";
my $title_base = $conf->{TITLE_TIPS_BASE};
my $title_tips = "TITLE_TIPS_" . $tips;
$title_tips =~ tr/a-z/A-Z/;
$title_tips = $conf->{$title_tips};
my $title = "$title_base ( $title_tips )";
$tml->define(main => $base, tips => $body);
$tml->assign($conf);
$tml->assign(MAKE_TITLE => $title);
$tml->parse(MAKE_TIPS => "tips");
}
#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
#// Model (トピックス)
#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
sub show_topics {
my ($tml, $conf) = @_;
$tml->define(main => "topics.html");
$tml->assign($conf);
my $str0 = '?action=11&file=' .
$conf->{CUST_PATH_TML0} . $conf->{CONF_FORM};
my $str1 = $conf->{SCRIPT_FORM} . "?mode=1";
$tml->assign( MAKE_TITLE => $conf->{TITLE_TOPICS},
MAKE_CONF_FORM => $str0,
MAKE_FMTEST => $str1,
);
}
#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
#// Model (ビューア)
#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
sub viewer {
my ($tml, $conf, $query) = @_;
$tml->define(main => "viewer.html");
$tml->assign($conf);
my $file = $query->{form}->{file};
my @error = ();
my $ref = [];
unless ($file) {
$ref->[0] = $conf->{ALERT_NO_TARGET};
$ref->[1] = $conf->{TITLE_VIEWER};
push(@error, $ref);
show_error($tml, $conf, \@error);
}
unless ( -e $file ) {
$ref->[0] = $conf->{ALERT_STYLE_NOFILE};
$ref->[1] = $conf->{TITLE_VIEWER};
push(@error, $ref);
show_error($tml, $conf, \@error);
}
my $target = `$conf->{SYSTEM_CAT} $file`;
$tml->assign( MAKE_TITLE => $file,
MAKE_TARGET => ADN::Utility::htmlchars($target),
);
}
#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
#// Model (Misc)
#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
sub show_error {
my ($tml, $conf, $ref) = @_;
my @error = @$ref;
my $error = 'error.html';
my $row = 'error_row.html';
$tml->define(main => $error, row => $row);
$tml->assign($conf);
foreach (@error) {
my $title = pop(@$_);
my $msg = ADN::Utility::dump_array($_, "<br>\n");
$tml->assign( MAKE_ERROR_TITLE => ADN::Utility::htmlchars($title),
MAKE_ERROR_MSG => $msg
);
$tml->parse(ERROR_ROW => ".row");
}
$tml->assign(MAKE_TITLE => $conf->{TITLE_INDEX});
ADN::HTML::write_adn($tml, $conf);
exit;
}
sub tune_color {
my ($num, $conf, $ref) = @_;
my $color = '';
$color = ($num % 2 == 0) ? 'td_bg1' : 'td_bg2';
if ($ref) {
foreach (@$ref) {
if ($num == $_) {
$color = 'td_bg3';
last;
}
}
}
return $color;
}
sub get_value {
my ($key, $query) = @_;
my $value = '';
my $value0 = $query->{form}->{$key};
if ($value0) {
$value = ADN::Utility::htmlchars(ADN::Utility::z2asc($value0));
$value =~ s/[\t\r]//g;
}
return $value;
}
sub get_num {
my ($query, $name) = @_;
my $num = 10;
my $value = $query->{form}->{$name};
if ($value && ($value =~ /^\d$/ || $value =~ /^\d\d$/)) {
$num = ADN::Utility::htmlchars(ADN::Utility::z2asc($value));
$num =~ s/[\t\r]//g;
}
return $num;
}
sub get_input {
my ($target, $opt) = @_;
if ($target) {
if (ref($target) eq 'ARRAY') {
if ($opt && $opt == 1) { #// 配列修正
$target = check_sort($target);
}
$target = ADN::Utility::dump_array($target, ' ');
}
$target = ADN::Utility::z2asc($target);
} else {
$target = '';
}
return $target;
}
sub key_num {
my ($key, $ref) = @_;
my $num = 0;
foreach my $key0 (%$ref) {
if ($key0 =~ /$key/) { $num += 1; }
}
return $num;
}
sub make_uri {
my ($conf, $str) = @_;
my $uri = $conf->{SCRIPT_ADMIN} . '?' . ADN::Utility::htmlchars($str);
return $uri;
}
#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
#// Model (Checking)
#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
sub check_sort { #// 飛び石で入力された場合の番号調整
my $target = shift;
my @sort = ();
my @target = @$target;
my $count = $#target + 1;
my %target = ();
for (my $i = 0; $i < $count; $i++) {
my $num = $i + 1;
my $key = "key" . sprintf("%02d", ADN::Utility::z2asc($target[$i]));
$target{$key} = $num;
}
foreach (sort %target) {
next unless ($target{$_});
push(@sort, $target{$_});
}
return \@sort;
}
sub check_dupli {
my ($target, $title, $conf) = @_;
my @error = ();
if ($target) {
if (ref($target) eq 'ARRAY') {
foreach my $h (@$target) {
if ($h =~ /^(\d+)$/) {
my $count = 0;
$h = ADN::Utility::z2asc($h);
foreach my $i (@$target) {
if ($h eq ADN::Utility::z2asc($i)) {
$count += 1;
if ($count == 2) {
my $ref = [];
my $msg = "$h : " . $conf->{ALERT_VALUE_DUPLI};
$ref->[0] = ADN::Utility::htmlchars($msg);
$ref->[1] = $title;
push(@error, $ref);
return @error;
}
}
}
} else {
my $ref = [];
my $msg = "$h : " . $conf->{ALERT_VALUE_NONNUM};
$ref->[0] = ADN::Utility::htmlchars($msg);
$ref->[1] = $title;
push(@error, $ref);
return @error;
}
}
}
}
return @error;
}
sub check_page {
my ($conf, $query) = @_;
my @page = (); my @error = ();
foreach my $key (%{$query->{form}}) {
next if (!defined $query->{form}->{$key});
next unless ($key =~ /_PAGE$/);
my $flag = 0;
my $value = ($query->{form}->{$key}) ? $query->{form}->{$key} : '';
if (@page) {
foreach (@page) {
if ($_ eq $value) { $flag = 0; last; }
if ($_ ne $value) { $flag = 1; }
}
} else {
$flag = 1;
}
if ($flag == 1) { push(@page, $value); }
}
#// ページ 飛び石チェック
my @check = sort { $a <=> $b } @page;
my $i = 0;
foreach (@check) {
unless ($i == 0) {
if ($_ > ($i + 1)) {
my $title = '';
foreach my $key (%{$query->{form}}) {
next if (!defined $query->{form}->{$key});
next unless ($key =~ /_PAGE$/);
if ($query->{form}->{$key} == $_) {
$key =~ s/_PAGE/_SHOW/;
$title = $query->{form}->{$key};
last;
}
}
my $ref = [];
$ref->[0] = "$_ : " . $conf->{ALERT_PAGE_SKIP};
$ref->[1] = $title . " (" . $conf->{ITEM_NAME6} . ")";
push(@error, $ref);
}
}
$i = $_;
}
@page = @check;
return (\@page, \@error);
}
sub check_size {
my ($conf, $query) = @_;
my @error = ();
foreach (%{$query->{form}}) {
next if (!defined $query->{form}->{$_});
next unless ($_ =~ /_SIZE$/ || $_ =~ /_COLS$/ || $_ =~ /ROWS$/);
my $check = ADN::Utility::z2asc($query->{form}->{$_});
unless ($check =~ /^(\d+)$/) {
my $ref = [];
my $msg = "$check : " . $conf->{ALERT_VALUE_NONNUM};
my $show = $_; $show =~ s/_(SIZE|COLS|ROWS)$/_SHOW/;
$ref->[0] = ADN::Utility::htmlchars($msg);
$ref->[1] = $query->{form}->{$show};
push(@error, $ref);
return @error;
}
}
return @error;
}
#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
#// Model (HTML)
#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
sub make_prev {
my ($num, $target, $space) = @_;
my $name = "name" . $num;
my $type = $target->{MAKE_ITEM_TYPE};
my $prev = '';
if (!defined $space) { $space = ' ' x 16; }
#// TYPE => text
if ($type eq "text") {
my $size = $target->{MAKE_ITEM_SIZE};
my $init = $target->{MAKE_ITEM_INIT};
$prev = ADN::HTML::mkhtml_input($space, $type, $name, $init, $size);
}
#// TYPE => radio
if ($type eq "radio") {
my $count = 1;
foreach my $text (split(/\n/, $target->{MAKE_ITEM_TEXT})) {
my $on = ($target->{MAKE_ITEM_INIT} eq $text) ? 1 : 0;
$prev .= ADN::HTML::mkhtml_check($space, $type, $name, $count, $text, $on) . "\n";
$count += 1;
}
$prev =~ s/\n$//g;
}
#// TYPE => checkbox
if ($type eq "checkbox") {
my $count = 1;
foreach my $text (split(/\n/, $target->{MAKE_ITEM_TEXT})) {
my $on = 0;
foreach (split(/\n/, $target->{MAKE_ITEM_INIT})) {
if ($_ eq $text) { $on = 1; last; }
}
$prev .= ADN::HTML::mkhtml_check($space, $type, $name, $count, $text, $on) . "\n";
$count += 1;
}
$prev =~ s/\n$//g;
}
#// TYPE => select
if ($type eq "select") {
my $size = $target->{MAKE_ITEM_SIZE};
my $add0 = $target->{MAKE_ITEM_ADD0};
my $opti = ($target->{MAKE_ITEM_OPTI}) ? 1 : 0;
my $count = 1;
my $add = ' size="' . $size . '"' . $add0;
$prev = ADN::HTML::mkhtml_select0($space, $name, $add) . "\n";
if ($opti == 1) {
$prev .= ADN::HTML::mkhtml_option($space, '', '----------', 0) . "\n";
}
foreach my $text (split(/\n/, $target->{MAKE_ITEM_TEXT})) {
my $on = 0;
foreach (split(/\n/, $target->{MAKE_ITEM_INIT})) {
if ($_ eq $text) { $on = 1; last; }
}
$prev .= ADN::HTML::mkhtml_option($space, $count, $text, $on) . "\n";
$count += 1;
}
$prev .= ADN::HTML::mkhtml_select1($space);
}
#// TYPE => textarea
if ($type eq "textarea") {
my $cols = $target->{MAKE_ITEM_COLS};
my $rows = $target->{MAKE_ITEM_ROWS};
my $init = $target->{MAKE_ITEM_INIT};
$prev = ADN::HTML::mkhtml_tarea($space, $cols, $rows, '', $init);
}
return $prev;
}
sub make_input {
my ($num, $target, $count, $space) = @_;
my $text = "NAME" . $num . "_TYPE";
my $check = $target->{$text};
my $name = "\$NAME" . $num . "_NAME";
my $type = "\$NAME" . $num . "_TYPE";
my $input = '';
if (!defined $space) { $space = ' ' x 16; }
#// TYPE => text
if ($check eq "text") {
my $size = "\$NAME" . $num . "_SIZE";
my $init = "\$NAME" . $num . "_INIT";
$input = ADN::HTML::mkhtml_input($space, $type, $name, $init, $size) . "\n";
}
#// TYPE => radio
if ($check eq "radio" || $check eq "checkbox") {
for (my $i = 1; $i <= $count; $i++) {
my $value = "\$NAME" . $num . "_VALUE" . $i;
my $text = "\$NAME" . $num . "_TEXT" . $i;
my $init = "\$NAME" . $num . "_INIT" . $i;
$input .= ADN::HTML::mkhtml_check0($space, $type, $name, $value, $text, $init) . "\n";
}
}
#// TYPE => select
if ($check eq "select") {
my $text = "NAME" . $num . "_OPTI";
my $opti = ($target->{$text}) ? 1 : 0;
my $size = "\$NAME" . $num . "_SIZE";
my $add0 = "\$NAME" . $num . "_ADD0";
my $add = ' size="' . $size . '"' . $add0;
$input = ADN::HTML::mkhtml_select0($space, $name, $add) . "\n";
if ($opti == 1) {
$input .= ADN::HTML::mkhtml_option0($space, '', '----------', '') . "\n";
}
for (my $i = 1; $i <= $count; $i++) {
my $value = "\$NAME" . $num . "_VALUE" . $i;
my $text = "\$NAME" . $num . "_TEXT" . $i;
my $init = "\$NAME" . $num . "_INIT" . $i;
$input .= ADN::HTML::mkhtml_option0($space, $value, $text, $init) . "\n";
}
$input .= ADN::HTML::mkhtml_select1($space) . "\n";
}
#// TYPE => textarea
if ($check eq "textarea") {
my $cols = "\$NAME" . $num . "_COLS";
my $rows = "\$NAME" . $num . "_ROWS";
my $init = "\$NAME" . $num . "_INIT";
$input = ADN::HTML::mkhtml_tarea($space, $cols, $rows, '', $init, $name) . "\n";
}
return $input;
}
#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
#// Model (Write Conf)
#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
sub write_skip {
my ($type_n, $key, $query) = @_;
my $type_v = $query->{form}->{$type_n};
my $flag = 0;
$flag = 1 if ($key =~ /_INIT$/ && $type_v eq "radio");
$flag = 1 if ($key =~ /_INIT$/ && $type_v eq "checkbox");
$flag = 1 if ($key =~ /_INIT$/ && $type_v eq "select");
$flag = 1 if ($key =~ /_ADD0$/ && $type_v ne "select");
$flag = 1 if ($key =~ /_OPTI$/ && $type_v ne "select");
$flag = 1 if ($key =~ /_COLS$/ && $type_v ne "textarea");
$flag = 1 if ($key =~ /_ROWS$/ && $type_v ne "textarea");
return $flag;
}
sub write_conv {
my ($type_n, $name, $query) = @_;
my $type_v = $query->{form}->{$type_n};
my $text_n = $name . "TEXT";
my $init_n = $name . "INIT";
my $init_v = $query->{form}->{$init_n};
if ($type_v eq "radio" || $type_v eq "checkbox" || $type_v eq "select") {
my $num = 1;
print CONF0 "\n";
foreach (split(/\r\n/, $query->{form}->{$text_n})) {
my $value_n = $name . "VALUE" . $num;
my $text_n = $name . "TEXT" . $num;
my $init_n = $name . "INIT" . $num;
my $init = '';
foreach my $key (split(/\r\n/, $init_v)) {
if ($_ eq $key) {
$init = ($type_v eq "select") ? ' selected="selected"' : ' checked="checked"';
last;
}
}
print CONF0 "$value_n" . "\t" . $num . "\n";
print CONF0 "$text_n" . "\t" . $_ . "\n";
print CONF0 "$init_n" . "\t" . $init . "\n";
$num += 1;
}
}
print CONF0 "\n";
}
sub write_conf {
my ($conf, $ref0, $prefix) = @_;
#// ユーザ設定ファイル
my $cust_path = $conf->{CUST_PATH_TML0};
my $cust_old = $cust_path . $conf->{CONF_FORM};
my $cust_new = $cust_old . '.0';
_write_conf0($cust_old, $cust_new, $conf, $ref0, $prefix);
#// 管理者設定ファイル
$prefix = 'INIT_' . $prefix;
my $admin_old = $conf->{CONF_ADMIN};
my $admin_new = $admin_old . '.0';
_write_conf0($admin_old, $admin_new, $conf, $ref0, $prefix);
}
sub _write_conf0 {
my ($old, $new, $conf, $ref, $prefix) = @_;
my %target = %$ref;
#// 旧ユーザ設定ファイルを読み込み
open READ, "<$old";
my @read = <READ>;
close READ;
#// ファイルハンドル オープン
open WRITE, "+>$new";
#// 新ユーザ設定ファイルに書き出し
foreach (@read) {
chomp;
my $line = '';
if ($_ =~ /^$prefix/) {
my ($name, $value) = split(/\t/);
my $name0 = $name;
if ($name =~ /^INIT_/) { $name0 =~ s/^INIT_//; }
$line = "$name\t" . $target{$name0};
} else {
$line = $_;
}
print WRITE "$line\n";
}
#// ファイルハンドル クローズ
close WRITE;
#// パーミッション変更
my $cp = $conf->{SYSTEM_CP};
my $chmod = $conf->{SYSTEM_CHMOD};
my $mv = $conf->{SYSTEM_MV};
`$chmod 666 $new`;
`$mv $new $old`;
}
sub _write_conf1 {
my ($old, $new, $conf, $query, $prefix) = @_;
#// 旧ユーザ設定ファイルを読み込み
open READ, "<$old";
my @read = <READ>;
close READ;
#// ファイルハンドル オープン
open WRITE, "+>$new";
#// 新ユーザ設定ファイルに書き出し
foreach (@read) {
chomp;
if ($_ =~ /^#/) { print WRITE "$_\n"; next; }
if ($_ eq '') { print WRITE "$_\n"; next; }
if ($_ !~ /\t/) { print WRITE "$_\n"; next; }
my ($name, $value) = split(/\t/, $_);
my $name0 = $name;
if ($name =~ /^INIT_/) { $name0 =~ s/^INIT_//; }
if (exists $query->{form}->{$name0}) {
my $value = $query->{form}->{$name0};
print WRITE "$name\t" . $value . "\n";
} else {
print WRITE "$_\n";
}
}
#// ファイルハンドル クローズ
close WRITE;
#// パーミッション変更
my $chmod = $conf->{SYSTEM_CHMOD};
my $mv = $conf->{SYSTEM_MV};
`$chmod 666 $new`;
`$mv $new $old`;
}
#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
#// Model (Write Tml)
#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
sub write_tml {
my ($file, $chmod, $path, $fmadmin, $formmail) = @_;
my $conf = ADN::Utility::read_conf($file); #// ユーザ設定ファイル
my $num = $conf->{PAGE_INPUT};
foreach (1 .. $num) {
my $input = $path . 'input_p' . $_ . '.html';
my $title_n = "TITLE_INPUT" . $_;
my $sort_n = 'SORT_INPUT' . $_;
my $sort_v = $conf->{$sort_n};
my $must_n = "MUST_INPUT" . $_;
my $must_v = $conf->{$must_n};
if (!defined $must_v) { $must_v = ''; }
#// ファイルハンドル オープン
open WRITE, "+>$input";
#// ヘッダ 書き込み
print WRITE write_header($title_n, $must_v, $formmail);
#// ボディ 書き込み
foreach my $i (split(/ /, $sort_v)) {
my $name = "NAME" . $i . "_";
my %target = ();
#// テーブルヘッダ
my $show = $name . "SHOW";
my $td = 'TD_TITLE';
foreach my $m (split(/,/, $must_v)) {
$m =~ s/^name//;
if ($m == $i) { $td = 'TD_MUST_INPUT'; last; }
}
my $td_header = write_parts0($conf, $show, $td);
#// テーブルボディ
foreach my $key (%$conf) {
next if (!defined $conf->{$key});
if ($key =~ /^$name/) { $target{$key} = $conf->{$key}; }
}
my $text = $name . "TEXT";
my $num = key_num($text, $conf);
my $parts0 = make_input($i, \%target, $num);
#// テーブルフッタ
my $td_footer = write_parts1();
#// 書き込み
print WRITE $td_header;
print WRITE $parts0;
print WRITE $td_footer;
}
#// フッタ 書き込み
my $action = ($_ == $num) ? 1 : 0;
my $page = $_ + 1;
print WRITE write_footer($action, $page);
#// ファイルハンドル クローズ
close WRITE;
`$chmod 666 $input`;
}
}
sub copy_tml {
my $conf = shift;
my $cp = $conf->{SYSTEM_CP};
my $chmod = $conf->{SYSTEM_CHMOD};
my $from = $conf->{PATH_TML}; #// admin
my $to = $conf->{CUST_PATH_TML0};
foreach (split(/ /, $conf->{CONF_LAYOUT})) {
my $file0 = $from . "user_" . $_;
my $file1 = $to . $_;
unless ( -e $file1 ) {
`$cp $file0 $file1`;
`$chmod 666 $file1`;
}
}
}
sub write_header {
my ($title, $must, $formmail) = @_;
my $header = <<"TML_HEADER";
\$HEADER
<div>
<\$IMG_SQUARE0 />
\$$title \$TITLE_CHECK
</div>
<form method="post" action="$formmail" onsubmit="return checkempty('$must')">
<\$TABLE_BASE>
<tr>
<td colspan="2"><br /></td>
</tr>
TML_HEADER
return $header;
}
sub write_footer {
my ($action, $page) = @_;
my $hidden = '';
my $row = '';
my $space = ' ' x 14;
if ($action == 0) {
$hidden = $space .
'<input type="hidden" name="page" value="' .
$page . '" />' . "\n";
}
if ($page > 2) { $row = '$' . "INPUT_ROW"; }
my $footer = <<"TML_FOOTER";
<tr>
<td colspan="2"><br /></td>
</tr>
<tr>
<td colspan="2" align="center">
<input type="submit" value=" 次へ " />
<input type="reset" value=" 消去 " />
</td>
</tr>
</table>
<div>
<input type="hidden" name="mode" value="\$MAKE_MODE" />
<input type="hidden" name="action" value="$action" />
$hidden
$row </div>
</form>
\$FOOTER
TML_FOOTER
return $footer;
}
sub write_parts0 {
my ($conf, $show, $td) = @_;
my $parts = <<"PARTS0";
<!-- $conf->{$show} -->
<tr>
<\$$td>\$$show</td>
<\$TD_INPUT>
PARTS0
return $parts;
}
sub write_parts1 {
my $parts = <<"PARTS1";
</td>
</tr>
PARTS1
return $parts;
}