CGI プログラム１５(主機入力テストプログラム)
戻る
<![CDATA[
#!C:/perl/bin/perl
# ma_start.pl 主机和零件数据输入
# 07.12.17
use strict;
use DBI;
use HTML::Template;
my (%t,@loop,@rec,$n);
$t{dsn} = "DBI:mysql:host=localhost;database=cookbook";
$t{dbh} = DBI->connect($t{dsn}, "cbuser", "cbpass") or die "Cannot connect to server\n";
$t{dbh}->do("SET NAMES utf8");
if(!$t{dbh}){
print "SQL read ERROR!\n";
exit;
}
$t{sth} = $t{dbh}->prepare("select * from main_type1");
$t{sth}->execute;
@loop = ();
while (@rec = $t{sth}->fetchrow_array) {
my %row = (
id => $rec[0],
name => $rec[1],
series => $rec[2],
GR => $rec[3],
DWG => $rec[4],
memo => $rec[5]
);
push(@loop, \%row);
}
$t{sth}->finish;
$t{dbh}->disconnect;
$t{template} = HTML::Template->new(filename => 'ma_start.htm');
$t{template}->param(LOOP => \@loop);
# HTMLファイル出力
print $t{template}->output;
1;
-------------------------------------------------------------------------------
<!-- ma_start.htm -->
<html>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
<head><title>ma_start</title>
<head>
<body bgcolor="#fcf5ca">
<h2>ma_start</h2>
<a href="http://localhost/index.html">http://localhost/index.html</a>
<hr>
<form method="POST" action="ma_add.pl">
<input type="submit" value="主機追加">ma_add.pl
</form>
主機修正=>ma_modify.pl<br>
パーツ入力=>mp_start.pl
<hr>
<table>
<tr bgcolor=white>
<th>ID</th>
<th>NAME</th>
<th>series</th>
<th>GR</th>
<th>DWG</th>
<th>memo</th>
<th>主機修正</th>
<th>パーツ入力</th>
</tr>
<TMPL_LOOP NAME="LOOP">
<tr bgcolor=cyan>
<td><TMPL_VAR NAME="id"></td>
<td><TMPL_VAR NAME="name"></td>
<td><TMPL_VAR NAME="series"></td>
<td><TMPL_VAR NAME="GR"></td>
<td><TMPL_VAR NAME="DWG"></td>
<td><TMPL_VAR NAME="memo"></td>
<td>
<form method="POST" action="ma_modify.pl">
<input type="hidden" name="id" value="<TMPL_VAR NAME="id">">
<input type="submit" value="主機修正">
</form>
</td>
<td>
<form method="POST" action="mp_start.pl">
<input type="hidden" name="id" value="<TMPL_VAR NAME="id">">
<input type="submit" value="パーツ入力">
</form>
</td>
<tr>
</TMPL_LOOP>
</table>
<hr>
</body>
</html>
-------------------------------------------------------------------------------
#!C:/perl/bin/perl
# ma_add.pl 追加主机项目开始画面
# 07.12.17
use strict;
use DBI;
use HTML::Template;
my (%t,@loop,@rec,$n);
# 取出最大的ID
$t{dsn} = "DBI:mysql:host=localhost;database=cookbook";
$t{dbh} = DBI->connect($t{dsn}, "cbuser", "cbpass") or die "Cannot connect to server\n";
$t{dbh}->do("SET NAMES utf8");
if(!$t{dbh}){
print "SQL read ERROR!\n";
exit;
}
$t{id} = $t{dbh}->selectrow_array("select max(id) from main_type1");
$t{id} = $t{id} + 1;
$t{ptable} = sprintf("%06d",$t{id});
$t{ptable} = 'a' . $t{ptable};
$t{dbh}->disconnect;
$t{template} = HTML::Template->new(filename => 'ma_add.htm');
$t{template}->param(maxid => $t{id});
$t{template}->param(ptable => $t{ptable});
# HTMLファイル出力
print $t{template}->output;
1;
-------------------------------------------------------------------------------
<html>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
<head><title>ma_add</title>
<head>
<body bgcolor="#fcf5ca">
<!-- 主机追加开始画面 -->
<h2>主机追加开始画面(ma_add)</h2>
<a href="http://localhost/scripts/ma_start.pl">http://localhost/scripts/ma_start.pl</a>
<hr>
<form method="POST" action="ma_insert.pl">
ID==><TMPL_VAR NAME="maxid"><br>
<input type="hidden" name="id" value="<TMPL_VAR NAME="maxid">">
<input type="hidden" name="ptable" value="<TMPL_VAR NAME="ptable">">
<input type="submit" value="决定">
<input type="reset" value="取消">
</form>
按下决定后,在输入以上数据的同时,也生成零件表格<TMPL_VAR NAME="ptable">。
<hr>
</body>
</html>
-------------------------------------------------------------------------------
#!C:/perl/bin/perl
# ma_insert.pl 追加主机项目执行画面
# 07.12.18
use strict;
use CGI;
use DBI;
use HTML::Template;
my (%t,@loop,@rec,$n);
$t{q} = new CGI;
$t{id} = $t{q}->param("id");
$t{ptable} = $t{q}->param("ptable");
$t{dsn} = "DBI:mysql:host=localhost;database=cookbook";
$t{dbh} = DBI->connect($t{dsn}, "cbuser", "cbpass") or die "Cannot connect to server\n";
$t{dbh}->do("SET NAMES utf8");
if(!$t{dbh}){
print "SQL read ERROR!\n";
exit;
}
# 生成零件表
$t{sql} = 'DROP TABLE IF EXISTS ' . $t{ptable} . ';';
$t{dbh}->do($t{sql});
$t{sql} = 'CREATE TABLE ' . $t{ptable};
$t{sql} .= ' (';
$t{sql} .= 'id INT AUTO_INCREMENT,';
$t{sql} .= 'name VARCHAR(50),';
$t{sql} .= 'code VARCHAR(50),';
$t{sql} .= 'group_id INT,';
$t{sql} .= 'dwg_id INT,';
$t{sql} .= 'price TEXT,';
$t{sql} .= 'oem TEXT,';
$t{sql} .= 'memo TEXT,';
$t{sql} .= 'PRIMARY KEY (id));';
$t{DO} = $t{dbh}->do($t{sql});
# 插入主机数据
$t{sql} = 'INSERT INTO main_type1 (id) VALUES("';
$t{sql} .= $t{id} . '")';
$t{DO1} = $t{dbh}->do($t{sql});
$t{dbh}->disconnect;
$t{template} = HTML::Template->new(filename => 'ma_insert.htm');
$t{template}->param(id => $t{id});
$t{template}->param(DO => $t{DO});
$t{template}->param(ptable => $t{ptable});
$t{template}->param(DO1 => $t{DO1});
$t{template}->param(sql => $t{sql});
# HTMLファイル出力
print $t{template}->output;
1;
-------------------------------------------------------------------------------
<html>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
<head><title>ma_insert</title>
<head>
<body bgcolor="#fcf5ca">
<!-- 主机追加执行画面 -->
<h2>ma_insert</h2>
<form method="POST" action="ma_start.pl">
<input type="submit" value="ma_start">==>返回
</form>
<hr>
id==><TMPL_VAR NAME="id"><br>
DO==><TMPL_VAR NAME="DO">,ptable==><TMPL_VAR NAME="ptable"><br>
DO1==><TMPL_VAR NAME="DO1"><br>
sql==><TMPL_VAR NAME="sql"><br>
<hr>
</body>
</html>
-------------------------------------------------------------------------------
#!C:/perl/bin/perl
# ma_modify.pl 主机項目修正执行画面
# 07.12.18,19
use strict;
use CGI;
use DBI;
use HTML::Template;
my (%t,@loop,@rec,$n);
$t{q} = new CGI;
$t{id} = $t{q}->param("id");
$t{dsn} = "DBI:mysql:host=localhost;database=cookbook";
$t{dbh} = DBI->connect($t{dsn}, "cbuser", "cbpass") or die "Cannot connect to server\n";
$t{dbh}->do("SET NAMES utf8");
if(!$t{dbh}){
print "SQL read ERROR!\n";
exit;
}
# 取出主机数据
($t{name},$t{series},$t{GR},$t{DWG},$t{memo}) = $t{dbh}->selectrow_array("select name,series,GR,DWG,memo from main_type1 where id = $t{id}");
$t{dbh}->disconnect;
@{ $t{GRs} } = split(/==/,$t{GR});
@loop = ();
for $n ( 1 .. $#{ $t{GRs} } ) {
my %row = (
id => $t{id},
NO => $n,
name => $t{GRs}[$n]
);
push(@loop, \%row);
}
$t{template} = HTML::Template->new(filename => 'ma_modify.htm');
$t{template}->param(id => $t{id});
$t{template}->param(name => $t{name});
$t{template}->param(series => $t{series});
$t{template}->param(GRLOOP => \@loop);
$t{template}->param(DWG => $t{DWG});
$t{template}->param(memo => $t{memo});
# HTMLファイル出力
print $t{template}->output;
1;
-------------------------------------------------------------------------------
<html>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
<head><title>ma_modify</title>
<head>
<body bgcolor="#fcf5ca">
<!-- 主机修正开始画面 -->
<h2>主机修正开始画面(ma_modify)</h2>
<a href="http://localhost/scripts/ma_start.pl">http://localhost/scripts/ma_start.pl</a>
<hr>
ID==><TMPL_VAR NAME="id"><br>
<hr>
<!-- form method="POST" action="ma_add2.pl" -->
<form method="POST" action="ma_addone.pl">
NAME=><input type="text" name="name" size=50 value="<TMPL_VAR NAME="name">"><br>
<input type="hidden" name="id" value="<TMPL_VAR NAME="id">">
<input type="hidden" name="item" value="name">
<input type="submit" value="确定">
</form>
<hr>
<form method="POST" action="ma_addone.pl">
series=><input type="text" name="name" value="<TMPL_VAR NAME="series">"><br>
<input type="hidden" name="id" value="<TMPL_VAR NAME="id">">
<input type="hidden" name="item" value="series">
<input type="submit" value="确定">
</form>
<hr>
<table>
<tr bgcolor=white>
<th>NO</th>
<th>name</th>
<th>GR修正</th>
</tr>
<TMPL_LOOP NAME="GRLOOP">
<tr bgcolor=cyan>
<td><TMPL_VAR NAME="NO"></td>
<td><TMPL_VAR NAME="name"></td>
<td>
<form method="POST" action="ma_grmodify.pl">
<input type="hidden" name="id" value="<TMPL_VAR NAME="id">">
<input type="hidden" name="NO" value="<TMPL_VAR NAME="NO">">
<input type="submit" value="GR修正">
</form>
</td>
<tr>
</TMPL_LOOP>
</table>
<br>
<form method="POST" action="ma_addtwo.pl">
<input type="hidden" name="id" value="<TMPL_VAR NAME="id">">
<input type="submit" value="GR入力">
</form>
<hr>
DWG=><input type="text" name="DWG" value="<TMPL_VAR NAME="DWG">"><br>
<hr>
memo=><input type="text" name="memo" value="<TMPL_VAR NAME="memo">"><br>
<hr>
</body>
</html>
-------------------------------------------------------------------------------
#!C:/perl/bin/perl
# ma_addone.pl 追加主机1项目
# 07.12.18
use strict;
use CGI;
use DBI;
use HTML::Template;
my (%t,@loop,@rec,$n);
$t{q} = new CGI;
$t{name} = $t{q}->param("name");
$t{id} = $t{q}->param("id");
$t{item} = $t{q}->param("item");
# 取出最大的ID
$t{dsn} = "DBI:mysql:host=localhost;database=cookbook";
$t{dbh} = DBI->connect($t{dsn}, "cbuser", "cbpass") or die "Cannot connect to server\n";
$t{dbh}->do("SET NAMES utf8");
if(!$t{dbh}){
print "SQL read ERROR!\n";
exit;
}
$t{sql} = 'UPDATE main_type1 set ' . $t{item} . ' = "';
$t{sql} .= $t{name} . '" where id = ' . $t{id};
$t{DO} = $t{dbh}->do($t{sql});
$t{dbh}->disconnect;
$t{template} = HTML::Template->new(filename => 'ma_addone.htm');
$t{template}->param(id => $t{id});
$t{template}->param(name => $t{name});
$t{template}->param(item => $t{item});
$t{template}->param(sql => $t{sql});
$t{template}->param(DO => $t{DO});
# HTMLファイル出力
print $t{template}->output;
1;
-------------------------------------------------------------------------------
<html>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
<head><title>ma_addone</title>
<head>
<body bgcolor="#fcf5ca">
<h2>主机1项目追加画面(ma_addone)</h2>
<form method="POST" action="ma_modify.pl">
<input type="hidden" name="id" value="<TMPL_VAR NAME="id">">
<input type="submit" value="ma_modify">==>返回
</form>
<hr>
ID==><TMPL_VAR NAME="id"><br>
<TMPL_VAR NAME="item">==><TMPL_VAR NAME="name"><br>
sql==><TMPL_VAR NAME="sql"><br>
DO==><TMPL_VAR NAME="DO"><br>
<hr>
</body>
</html>
-------------------------------------------------------------------------------
#!C:/perl/bin/perl
# ma_addtwo.pl 追加主机1项目
# 07.12.18
use strict;
use CGI;
use DBI;
use HTML::Template;
my (%t,@loop,@rec,$n);
$t{q} = new CGI;
$t{id} = $t{q}->param("id");
$t{group} = $t{q}->param("group");
# 取出现在的GR
$t{dsn} = "DBI:mysql:host=localhost;database=cookbook";
$t{dbh} = DBI->connect($t{dsn}, "cbuser", "cbpass") or die "Cannot connect to server\n";
$t{dbh}->do("SET NAMES utf8");
if(!$t{dbh}){
print "SQL read ERROR!\n";
exit;
}
if ($t{group} == 0 ) {
$t{GR} = $t{dbh}->selectrow_array("select GR from main_type1 where id = $t{id}");
if ( $t{GR} ) {
@{ $t{line} } = split(/==/,$t{GR});
$t{group} = '';
for $n ( 0 .. $#{ $t{line} } ) {
$t{group} .= $t{line}[$n];
}
} else {
$t{group} = 'Example';
}
}
$t{dbh}->disconnect;
$t{template} = HTML::Template->new(filename => 'ma_addtwo2.htm');
$t{template}->param(id => $t{id});
$t{template}->param(group => $t{group});
# HTMLファイル出力
print $t{template}->output;
1;
-------------------------------------------------------------------------------
<html>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
<head><title>ma_addtwo2</title>
<head>
<body bgcolor="#fcf5ca">
<h2>主机多项目追加画面(ma_addtwo2)</h2>
<form method="POST" action="ma_modify.pl">
<input type="hidden" name="id" value="<TMPL_VAR NAME="id">">
<input type="submit" value="ma_modify">==>返回
</form>
<hr>
<form method="POST" action="ma_mread.pl">
<textarea name="group" cols="60" rows="10" wrap="hard">
<TMPL_VAR NAME="group"></textarea>
<input type="hidden" name="id" value="<TMPL_VAR NAME="id">">
<input type="hidden" name="item" value="GR">
<br>
<input type="submit" value="确定">
</form>
<hr>
</body>
</html>
-------------------------------------------------------------------------------
#!C:/perl/bin/perl
# ma_mread.pl 追加主机1项目
# 07.12.18
use strict;
use CGI;
use DBI;
use HTML::Template;
my (%t,@loop,@rec,$n,@fld);
$t{q} = new CGI;
$t{id} = $t{q}->param("id");
$t{group} = $t{q}->param("group");
$t{item} = $t{q}->param("item");
@{ $t{line} } = split(/\n/,$t{group});
$t{GR} = '==';
for $n ( 0 .. $#{ $t{line} } ) {
$t{GR} .= $t{line}[$n] . '==';
}
#
$t{dsn} = "DBI:mysql:host=localhost;database=cookbook";
$t{dbh} = DBI->connect($t{dsn}, "cbuser", "cbpass") or die "Cannot connect to server\n";
$t{dbh}->do("SET NAMES utf8");
if(!$t{dbh}){
print "SQL read ERROR!\n";
exit;
}
$t{sql} = 'UPDATE main_type1 set ' . $t{item} . ' = "';
$t{sql} .= $t{GR} . '" where id = ' . $t{id};
$t{DO} = $t{dbh}->do($t{sql});
$t{dbh}->disconnect;
$t{template} = HTML::Template->new(filename => 'ma_mread.htm');
$t{template}->param(id => $t{id});
$t{template}->param(item => $t{item});
$t{template}->param(GR => $t{GR});
$t{template}->param(sql => $t{sql});
$t{template}->param(DO => $t{DO});
# HTMLファイル出力
print $t{template}->output;
1;
-------------------------------------------------------------------------------
<html>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
<head><title>ma_mread</title>
<head>
<body bgcolor="#fcf5ca">
<h2>主机的GR输入(ma_mread)</h2>
<form method="POST" action="ma_modify.pl">
<input type="hidden" name="id" value="<TMPL_VAR NAME="id">">
<input type="submit" value="返回">
</form>
<hr>
ID==><TMPL_VAR NAME="id"><br>
<TMPL_VAR NAME="item">==><TMPL_VAR NAME="GR"><br>
sql==><TMPL_VAR NAME="sql"><br>
DO==><TMPL_VAR NAME="DO"><br>
<hr>
</body>
</html>
-------------------------------------------------------------------------------
#!C:/perl/bin/perl
# ma_grmodify.pl 修改主机1项目
# 07.12.19
use strict;
use CGI;
use DBI;
use HTML::Template;
my (%t,@loop,@rec,$n,@fld);
$t{q} = new CGI;
$t{id} = $t{q}->param("id");
$t{NO} = $t{q}->param("NO");
# 取出主机1项目
$t{dsn} = "DBI:mysql:host=localhost;database=cookbook";
$t{dbh} = DBI->connect($t{dsn}, "cbuser", "cbpass") or die "Cannot connect to server\n";
$t{dbh}->do("SET NAMES utf8");
if(!$t{dbh}){
print "SQL read ERROR!\n";
exit;
}
$t{GR} = $t{dbh}->selectrow_array("select GR from main_type1 where id = $t{id}");
@{ $t{line} } = split(/==/,$t{GR});
$t{GR1} = $t{line}[$t{NO}];
$t{dbh}->disconnect;
$t{template} = HTML::Template->new(filename => 'ma_grmodify.htm');
$t{template}->param(id => $t{id});
$t{template}->param(NO => $t{NO});
$t{template}->param(GR => $t{GR1});
# HTMLファイル出力
print $t{template}->output;
1;
-------------------------------------------------------------------------------
<html>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
<head><title>ma_grmodify</title>
<head>
<body bgcolor="#fcf5ca">
<h2>主机1项目修改画面(ma_grmodify)</h2>
<form method="POST" action="ma_modify.pl">
<input type="hidden" name="id" value="<TMPL_VAR NAME="id">">
<input type="submit" value="ma_modify">==>返回
</form>
<hr>
<form method="POST" action="ma_grmodify2.pl">
修改后请点击「确定」按钮<br>
<input type="text" name="GR1" size=100 value="<TMPL_VAR NAME="GR">">
<input type="hidden" name="id" value="<TMPL_VAR NAME="id">">
<input type="hidden" name="NO" value="<TMPL_VAR NAME="NO">">
<br>
<input type="submit" value="确定">
</form>
<hr>
</body>
</html>
-------------------------------------------------------------------------------
#!C:/perl/bin/perl
# ma_grmodify2.pl 修改主机1项目
# 07.12.19
use strict;
use CGI;
use DBI;
use HTML::Template;
my (%t,@loop,@rec,$n,@fld);
$t{q} = new CGI;
$t{GR1} = $t{q}->param("GR1");
$t{id} = $t{q}->param("id");
$t{NO} = $t{q}->param("NO");
# 取出主机1项目
$t{dsn} = "DBI:mysql:host=localhost;database=cookbook";
$t{dbh} = DBI->connect($t{dsn}, "cbuser", "cbpass") or die "Cannot connect to server\n";
$t{dbh}->do("SET NAMES utf8");
if(!$t{dbh}){
print "SQL read ERROR!\n";
exit;
}
$t{GR} = $t{dbh}->selectrow_array("select GR from main_type1 where id = $t{id}");
@{ $t{line} } = split(/==/,$t{GR});
for $n ( 0 .. $#{ $t{line} } ) {
$t{G1} = $t{line}[$n];
if ( $n == $t{NO} ) {
$t{G1} = $t{GR1};
}
push(@{ $t{newline} },$t{G1});
}
$t{GR} = '';
for $n ( 0 .. $#{ $t{newline} } ) {
$t{GR} .= $t{newline}[$n] . '==';
}
$t{item} = 'GR';
$t{sql} = 'UPDATE main_type1 set ' . $t{item} . ' = "';
$t{sql} .= $t{GR} . '" where id = ' . $t{id};
$t{DO} = $t{dbh}->do($t{sql});
$t{dbh}->disconnect;
$t{template} = HTML::Template->new(filename => 'ma_grmodify2.htm');
$t{template}->param(id => $t{id});
$t{template}->param(DO => $t{DO});
$t{template}->param(sql => $t{sql});
# HTMLファイル出力
print $t{template}->output;
1;
-------------------------------------------------------------------------------
<html>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
<head><title>ma_grmodify2</title>
<head>
<body bgcolor="#fcf5ca">
<h2>主机1项目结果画面(ma_grmodify2)</h2>
<form method="POST" action="ma_modify.pl">
<input type="hidden" name="id" value="<TMPL_VAR NAME="id">">
<input type="submit" value="ma_modify">==>返回
</form>
<hr>
DO==><TMPL_VAR NAME="DO"><br>
sql==><TMPL_VAR NAME="sql"><br>
<hr>
</body>
</html>
-------------------------------------------------------------------------------
]]>
戻る