CGI プログラム１６(パーツ入力テストプログラム)
戻る
<![CDATA[
#!C:/perl/bin/perl
# mp_start.pl Parts数据输入
use strict;
use CGI;
use DBI;
use HTML::Template;
my (%t,@loop,$ref,@rec,$n);
$t{q} = new CGI;
$t{id} = $t{q}->param("id");
# 零件表格名
$t{ptable} = sprintf("%06d",$t{id});
$t{ptable} = 'a' . $t{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{name},$t{series},$t{GR}) = $t{dbh}->selectrow_array("select name,series,GR from main_type1 where id = $t{id}");
# 取出零件名
# Table1の処理
$t{sth} = $t{dbh}->prepare("select id,name,code,group_id from $t{ptable}");
$t{sth}->execute;
@loop = ();
while (@rec = $t{sth}->fetchrow_array) {
my %row = (
aid => $t{id},
id => $rec[0],
name => $rec[1],
code => $rec[2],
group_id => $rec[3]
);
push(@loop, \%row);
}
$t{dbh}->disconnect;
$t{template} = HTML::Template->new(filename => 'mp_start.htm');
$t{template}->param(id => $t{id});
$t{template}->param(ptable => $t{ptable});
$t{template}->param(name => $t{name});
$t{template}->param(series => $t{series});
$t{template}->param(GR => $t{GR});
$t{template}->param(LOOP => \@loop);
# HTMLファイル出力
print $t{template}->output;
1;
-------------------------------------------------------------------------------
<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
# mp_input.pl Parts输入
use strict;
use CGI;
use HTML::Template;
my (%t,@loop,@rec,$n);
$t{q} = new CGI;
$t{id} = $t{q}->param("id");
$t{group} = $t{q}->param("group");
# 零件Table名
$t{ptable} = sprintf("%06d",$t{id});
$t{ptable} = 'a' . $t{ptable};
$t{template} = HTML::Template->new(filename => 'mp_input.htm');
$t{template}->param(id => $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>パーツ入力画面(mp_input)</title>
<head>
<body bgcolor="#fcf5ca">
<h2>パーツ入力画面(mp_input)</h2>
<form method="POST" action="mp_start.pl">
<input type="hidden" name="id" value="<TMPL_VAR NAME="id">">
<input type="submit" value="mp_input">==>返回
</form>
<hr>
ptalbe=><TMPL_VAR NAME="ptable"><br>
<form method="POST" action="mp_insert.pl">
<textarea name="group" cols="60" rows="10" wrap="hard">
</textarea>
<input type="hidden" name="id" value="<TMPL_VAR NAME="id">">
<br>
<input type="submit" value="确定">
</form>
<hr>
</body>
</html>
-------------------------------------------------------------------------------
#!C:/perl/bin/perl
# mp_select.pl 选择GR画面
use strict;
use CGI;
use DBI;
use HTML::Template;
my (%t,@loop,$ref,@rec,$n);
$t{q} = new CGI;
$t{aid} = $t{q}->param("aid");
$t{id} = $t{q}->param("id");
# 零件表格名
$t{ptable} = sprintf("%06d",$t{id});
$t{ptable} = 'a' . $t{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;
}
# 取出GR数据
$t{GR} = $t{dbh}->selectrow_array("select GR from main_type1 where id = $t{id}");
$t{dbh}->disconnect;
#
@{ $t{GRs} } = split(/==/,$t{GR});
for $n ( 1 .. $#{ $t{GRs} } ) {
my %row = (
grid => $n,
name => $t{GRs}[$n]
);
push(@loop, \%row);
}
$t{template} = HTML::Template->new(filename => 'mp_select.htm');
$t{template}->param(aid => $t{aid});
$t{template}->param(id => $t{id});
$t{template}->param(GR => $t{GR});
$t{template}->param(LOOP => \@loop);
# HTMLファイル出力
print $t{template}->output;
1;
-------------------------------------------------------------------------------
<html>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
<head><title>mp_select</title>
<head>
<body bgcolor="#fcf5ca">
<h2>选择GR画面(mp_select)</h2>
<form method="POST" action="mp_start.pl">
<input type="hidden" name="id" value="<TMPL_VAR NAME="aid">">
<input type="submit" value="mp_input">==>返回
</form>
<hr>
aID==><TMPL_VAR NAME="aid"><br>
pID==><TMPL_VAR NAME="id"><br>
GR=><TMPL_VAR NAME="GR"><br>
<hr>
<form method="POST" action="mp_select2.pl">
<table>
<tr bgcolor=white>
<th>NO</th>
<th>GROUP名</th>
<th>选择</th>
</tr>
<TMPL_LOOP NAME="LOOP">
<tr bgcolor=cyan>
<td><TMPL_VAR NAME="grid"></td>
<td><TMPL_VAR NAME="name"></td>
<td>
<input type="radio" name = "GR" value="<TMPL_VAR NAME="grid">">
</td>
</tr>
</TMPL_LOOP>
</table>
<input type="hidden" name=aid value="<TMPL_VAR NAME="aid">">
<input type="hidden" name=pid value="<TMPL_VAR NAME="id">">
<input type="submit" value="GR选择">
</form>
<hr>
</body>
</html>
-------------------------------------------------------------------------------
#!C:/perl/bin/perl
# mp_select2.pl GR确定
use strict;
use CGI;
use DBI;
use HTML::Template;
my (%t,@loop,$ref,@rec,$n);
$t{q} = new CGI;
$t{aid} = $t{q}->param("aid");
$t{pid} = $t{q}->param("pid");
$t{grid} = $t{q}->param("GR");
# 零件表格名
$t{ptable} = sprintf("%06d",$t{aid});
$t{ptable} = 'a' . $t{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;
}
# 更新group_id
$t{sql} = 'UPDATE ' . $t{ptable} . ' set group_id = "';
$t{sql} .= $t{grid} . '" where id = ' . $t{pid};
$t{DO} = $t{dbh}->do($t{sql});
$t{dbh}->disconnect;
$t{template} = HTML::Template->new(filename => 'mp_select2.htm');
$t{template}->param(aid => $t{aid});
$t{template}->param(pid => $t{pid});
$t{template}->param(grid => $t{grid});
$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>mp_select2</title>
<head>
<body bgcolor="#fcf5ca">
<h2>GR确定(mp_select2)</h2>
<form method="POST" action="mp_start.pl">
<input type="hidden" name="id" value="<TMPL_VAR NAME="aid">">
<input type="submit" value="mp_input">==>返回
</form>
<hr>
aID==><TMPL_VAR NAME="aid"><br>
pID==><TMPL_VAR NAME="pid"><br>
GRID=><TMPL_VAR NAME="grid"><br>
sql=><TMPL_VAR NAME="sql"><br>
DO=><TMPL_VAR NAME="DO"><br>
<hr>
</body>
</html>
-------------------------------------------------------------------------------
HTML::Template使用时的出错
push(@{ $$ref->{NO} },$n);
push(@{ $$ref->{grname} },$t{grname});
C:\Inetpub\Scripts>perl mp_start.pl
HTML::Template->output() : fatal error in loop output : Can't call method "isa"
on unblessed reference at C:/Perl/site/lib/HTML/Template.pm line 2563.
at mp_start.pl line 70
push(@{ $$ref{NO} },$n);
push(@{ $$ref{grname} },$t{grname});
C:\Inetpub\Scripts>perl mp_start.pl
HTML::Template->output() : fatal error in loop output : HTML::Template::param()
: attempt to set parameter 'grloop' with a scalar - parameter is not a TMPL_VAR!
at C:/Perl/site/lib/HTML/Template.pm line 3068
at mp_start.pl line 70
-------------------------------------------------------------------------------
#!C:/perl/bin/perl
# mp_update1.pl Parts修改
use strict;
use DBI;
use CGI;
use HTML::Template;
my (%t,@loop,@rec,$n);
$t{q} = new CGI;
$t{id} = $t{q}->param("id");
$t{aid} = $t{q}->param("aid");
# 零件Table名
$t{ptable} = sprintf("%06d",$t{aid});
$t{ptable} = 'a' . $t{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{name},$t{code}) = $t{dbh}->selectrow_array("select name,code from $t{ptable} where id = $t{id}");
$t{dbh}->disconnect;
$t{template} = HTML::Template->new(filename => 'mp_update1.htm');
$t{template}->param(id => $t{id});
$t{template}->param(aid => $t{aid});
$t{template}->param(ptable => $t{ptable});
$t{template}->param(name => $t{name});
$t{template}->param(code => $t{code});
# HTMLファイル出力
print $t{template}->output;
1;
-------------------------------------------------------------------------------
<html>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
<head><title>パーツ修改画面(mp_update1)</title>
<head>
<body bgcolor="#fcf5ca">
<h2>パーツ修改画面(mp_update1)</h2>
<form method="POST" action="mp_start.pl">
<input type="hidden" name="id" value="<TMPL_VAR NAME="aid">">
<input type="submit" value="mp_input">==>返回
</form>
<hr>
aid=><TMPL_VAR NAME="aid"><br>
ptalbe=><TMPL_VAR NAME="ptable"><br>
id=><TMPL_VAR NAME="id"><br>
<form method="POST" action="mp_update2.pl">
<input type="text" size = 100 name="name" value="<TMPL_VAR NAME="name">"><br>
<input type="text" size = 100 name="code" value="<TMPL_VAR NAME="code">"><br>
<input type="hidden" name="aid" value="<TMPL_VAR NAME="aid">"><br>
<input type="hidden" name="id" value="<TMPL_VAR NAME="id">"><br>
<input type="hidden" name="ptable" value="<TMPL_VAR NAME="ptable">"><br>
<input type="submit" value="确定">
</form>
<hr>
</body>
</html>
-------------------------------------------------------------------------------
#!C:/perl/bin/perl
# mp_update2.pl 零件修改确定
use strict;
use CGI;
use DBI;
use HTML::Template;
my (%t,@loop,$ref,@rec,$n);
$t{q} = new CGI;
$t{aid} = $t{q}->param("aid");
$t{pid} = $t{q}->param("id");
$t{name} = $t{q}->param("name");
$t{code} = $t{q}->param("code");
# 零件表格名
$t{ptable} = sprintf("%06d",$t{aid});
$t{ptable} = 'a' . $t{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;
}
# 更新name和code
$t{sql} = 'UPDATE ' . $t{ptable} . ' set name = "';
$t{sql} .= $t{name} . '" where id = ' . $t{pid};
$t{DO} = $t{dbh}->do($t{sql});
$t{sql} = 'UPDATE ' . $t{ptable} . ' set code = "';
$t{sql} .= $t{code} . '" where id = ' . $t{pid};
$t{DO} = $t{dbh}->do($t{sql});
$t{dbh}->disconnect;
$t{template} = HTML::Template->new(filename => 'mp_update2.htm');
$t{template}->param(aid => $t{aid});
$t{template}->param(pid => $t{pid});
$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>mp_update2</title>
<head>
<body bgcolor="#fcf5ca">
<h2>零件修改确定(mp_update2)</h2>
<form method="POST" action="mp_start.pl">
<input type="hidden" name="id" value="<TMPL_VAR NAME="aid">">
<input type="submit" value="mp_input">==>返回
</form>
<hr>
aID==><TMPL_VAR NAME="aid"><br>
pID==><TMPL_VAR NAME="pid"><br>
DO=><TMPL_VAR NAME="DO"><br>
sql=><TMPL_VAR NAME="sql"><br>
<hr>
</body>
</html>
-------------------------------------------------------------------------------
<html>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
<head><title>mp_start</title>
<head>
<body bgcolor="#fcf5ca">
<h2>零件输入开始画面(mp_start)</h2>
<a href="http://localhost/scripts/ma_start.pl">http://localhost/scripts/ma_start.pl</a>
<hr>
aID==><TMPL_VAR NAME="id"><br>
ptable==><TMPL_VAR NAME="ptable"><br>
<hr>
主机TYPE=><TMPL_VAR NAME="name"><br>
主机TYPE的series=><TMPL_VAR NAME="series"><br>
GR=><TMPL_VAR NAME="GR"><br>
<hr>
<table>
<tr bgcolor=white>
<th>NO</th>
<th>name</th>
<th>code</th>
<th>选择GR</th>
<th>选择DWG</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="code"></td>
<td>
<TMPL_VAR NAME="group_id">
<form method="POST" action="mp_select.pl">
<input type="hidden" name="id" value="<TMPL_VAR NAME="id">">
<input type="hidden" name="aid" value="<TMPL_VAR NAME="aid">">
<input type="submit" value="选择GR">
</form>
</td>
<td>
</td>
<td>
<form method="POST" action="mp_update1.pl">
<input type="hidden" name="id" value="<TMPL_VAR NAME="id">">
<input type="hidden" name="aid" value="<TMPL_VAR NAME="aid">">
<input type="submit" value="修正">
</form>
</td>
</tr>
</TMPL_LOOP>
</table>
<hr>
<form method="POST" action="mp_input.pl">
<input type="hidden" name="id" value="<TMPL_VAR NAME="id">">
<input type="submit" value="パーツ複数項目入力">
</form>
<hr>
</body>
</html>
-------------------------------------------------------------------------------
]]>
戻る