perl 学习 perl 学习资料整理篇

NULL值的判断
$t{type1id} = $$pref{dbh}->selectrow_array("SELECT type1id FROM enq1 WHERE id =
3");
if ( $t{type1id} == 0 ) {
print "Type1id is NULL\n";
}
==>不是数值项的话,这个语句有问题。数值项专用。
if ( length($t{type1id}) == 0 ) {
print "Type1id is NULL\n";
}
==>如果Null的话,这个语句有问题
如果@rec含有NULL的话,下面的操作要出错误信息
$t{line1} = join(' ',@rec);

($t{old1},$t{new1p},$t{new1q}) = $self->dbh->selectrow_array("SELECT
type1id,partsid,QTY FROM enq1 WHERE id = $t{enq1_id}");
91==> if ( $t{old1} == 0 ) {
--------------------------------------------------
[error] [client 127.0.0.1] Use of uninitialized value in numeric eq (==) at
./pro/mscenq1.pl line 91, <CONFIG> line 11.,
--------------------------------------------------
如何判断一个项目的值是否是NULL(未解决)
解决!第一次INSERT时,放一个常数(比如"B")
起源==>
637==> $t{Nu1} = $self->dbh->selectrow_array("select parts_Unit from parts_nu
where id = $t{Nuid1}");
--------------------------------------------------
[Wed May 14 17:27:51 2008] [error] [client 127.0.0.1] DBD::mysql::db
selectrow_array failed: You have an error in your SQL syntax; check the manual
that corresponds to your MySQL server version for the right syntax to use near
'' at line 1 at ./pro/mscenq1.pl line 637, <CONFIG> line 11., referer:
--------------------------------------------------
要考虑$t{Nuid1}不存在的情况

考虑id=C的情况
591==>
@{ $t{p1} } = $self->dbh->selectrow_array("SELECT * FROM $t{ptable}
WHERE id = $t{pid1}");
--------------------------------------------------
[error] [client 127.0.0.1] DBD::mysql::db selectrow_array failed: Unknown
column 'C' in 'where clause' at ./pro/mscenq1.pl line 591, <CONFIG> line 11.,
referer:
--------------------------------------------------
要考虑$t{pid1}='C'的情况
if ( $#{ $t{pid_list} } == 0 && $t{pid_list}[0] eq 'C' ) {
next;
}
COPY一个项目的subroutine
use strict;
use DBI;
# 连接数据库
my(%t,$n,@fld,@rec,$pref);
print "This is test3.pl.\n";
# 连接数据库
$$pref{dsn} = "DBI:mysql:host=localhost;database=cookbook";
$$pref{dbh} = DBI->connect($$pref{dsn}, "cbuser", "cbpass") or die "Cannot
connect to server\n";
$$pref{dbh}->do("SET NAMES utf8");
if(!$$pref{dbh}){
print "SQL read ERROR!\n";
exit;
}
$$pref{table} = 'enq2';
$$pref{oldid} = 4;
($pref) = copy_one($pref);
# 关闭数据库
$$pref{dbh}->disconnect;
# COPY一个项目
sub copy_one {
my($pref) = @_;
my(%t,@rec,$n);

# 取出COLUMNS
$t{sth} = $$pref{dbh}->prepare("SHOW COLUMNS FROM $$pref{table}");
$t{sth}->execute;
while ( @rec = $t{sth}->fetchrow_array ) {
push(@{ $t{columns} },$rec[0]);
}
$t{sth}->finish;
# 取出数据(同时记住不是NULL的项目)
@{ $t{one} } = $$pref{dbh}->selectrow_array("SELECT * FROM $$pref{table}
WHERE id = $$pref{oldid}");

for $n ( 1 .. $#{ $t{one} } ) {
$t{name} = $t{columns}[$n];
$t{value} = $t{one}[$n];
if ( $t{value} ) {
$t{value} = '"' . $t{value} . '"';
push(@{ $t{names} },$t{name});
push(@{ $t{values} },$t{value});
}
}
$t{name1} = join(',',@{ $t{names} });
$t{value1} = join(',',@{ $t{values} });

# 插入新项目
$t{sql} = 'INSERT INTO ' . $$pref{table} . '(';
$t{sql} .= $t{name1} . ') VALUES(';
$t{sql} .= $t{value1} . ')';

$t{DO} = $$pref{dbh}->do($t{sql});

# print "DO=$t{DO}\n";
return($pref);
}
# 可能MySQL存在很简单的命令执行上面的操作。已经做过的程序就放在这儿了。

--------------------------------------------------------------------------------
MySQL操作程序二
返回
--------------------------------------------------------------------------------
不许OURREF重复的操作
$t{enq1_id} = $t{q}->param("enq1_id");
$t{our1_new} = $self->dbh->selectrow_array("SELECT ourref FROM enq1 WHERE id = $t{enq1_id}");
# 取得现有所有quo2的enq1id数据,如果有一样的不允许切换
# enq1和quo2必须是一对一关系
# 取出所有的OURREF
$t{sth} = $self->dbh->prepare("SELECT enq1id FROM quo2");
$t{sth}->execute;
while ( @rec = $t{sth}->fetchrow_array ) {
$t{our1} = $self->dbh->selectrow_array("SELECT ourref FROM enq1 WHERE id = $rec[0]");
push(@{ $t{our1s} },$t{our1});
}
$t{sth}->finish;
$t{our1_old} = join(' ',@{ $t{our1s} });
if ( $t{our1_old} !~ /$t{our1_new}/ ) {
$t{sql} = 'UPDATE quo2 SET enq1id ="';
$t{sql} .= $t{enq1_id} . '" WHERE id = "';
$t{sql} .= $t{quo2_id} . '"';
$t{DO} = $self->dbh->do("$t{sql}");
}
删除表格内容的一些操作
显示表格hull_no的第309行到362行的内容
mysql> SELECT * from hull_no WHERE id >= 309 AND id <= 362;
删除表格hull_no的第309行到362行的HULL_NO
mysql> UPDATE hull_no SET HULL_NO = "" WHERE id >= 309 AND id <= 362;
Query OK, 54 rows affected (0.16 sec)
Rows matched: 54 Changed: 54 Warnings: 0
删除表格hull_no的第309行到362行的name
mysql> UPDATE hull_no SET name = "" WHERE id >= 309 AND id <= 362;
Query OK, 54 rows affected (0.01 sec)
Rows matched: 54 Changed: 54 Warnings: 0
表格删除一行操作
mysql> show columns from quo2;
+-----------+---------+------+-----+---------+----------------+
| Field | Type | Null | Key | Default | Extra |
+-----------+---------+------+-----+---------+----------------+
| id | int(11) | NO | PRI | NULL | auto_increment |
| time | date | YES | | NULL | |
| enq1id | int(11) | YES | | NULL | |
| ORIGINid | int(11) | YES | | NULL | |
| PRICEid | int(11) | YES | | NULL | |
| PAYMENTid | int(11) | YES | | NULL | |
| DELIVERY | text | YES | | NULL | |
| percent0 | int(11) | YES | | NULL | |
| percent | text | YES | | NULL | |
| price | text | YES | | NULL | |
| total | int(11) | YES | | NULL | |
| memo | text | YES | | NULL | |
+-----------+---------+------+-----+---------+----------------+
12 rows in set (0.08 sec)
mysql> ALTER TABLE quo2 DROP enq1id;
Query OK, 6 rows affected (0.27 sec)
Records: 6 Duplicates: 0 Warnings: 0
mysql> show columns from quo2;
+-----------+---------+------+-----+---------+----------------+
| Field | Type | Null | Key | Default | Extra |
+-----------+---------+------+-----+---------+----------------+
| id | int(11) | NO | PRI | NULL | auto_increment |
| time | date | YES | | NULL | |
| ORIGINid | int(11) | YES | | NULL | |
| PRICEid | int(11) | YES | | NULL | |
| PAYMENTid | int(11) | YES | | NULL | |
| DELIVERY | text | YES | | NULL | |
| percent0 | int(11) | YES | | NULL | |
| percent | text | YES | | NULL | |
| price | text | YES | | NULL | |
| total | int(11) | YES | | NULL | |
| memo | text | YES | | NULL | |
+-----------+---------+------+-----+---------+----------------+
11 rows in set (0.02 sec)
mysql> show columns from order1;
+-----------+---------+------+-----+---------+----------------+
| Field | Type | Null | Key | Default | Extra |
+-----------+---------+------+-----+---------+----------------+
| id | int(11) | NO | PRI | NULL | auto_increment |
| time | date | YES | | NULL | |
| orderno | text | YES | | NULL | |
| ORIGINid | int(11) | YES | | NULL | |
| PRICEid | int(11) | YES | | NULL | |
| PAYMENTid | int(11) | YES | | NULL | |
| DELIVERY | text | YES | | NULL | |
| price | text | YES | | NULL | |
| total | text | YES | | NULL | |
| memo | text | YES | | NULL | |
+-----------+---------+------+-----+---------+----------------+
10 rows in set (0.02 sec)
mysql> ALTER TABLE order1 DROP price;
Query OK, 10 rows affected (0.24 sec)
Records: 10 Duplicates: 0 Warnings: 0
mysql> ALTER TABLE order1 DROP total;
Query OK, 10 rows affected (0.17 sec)
Records: 10 Duplicates: 0 Warnings: 0
mysql> show columns from order1;
+-----------+---------+------+-----+---------+----------------+
| Field | Type | Null | Key | Default | Extra |
+-----------+---------+------+-----+---------+----------------+
| id | int(11) | NO | PRI | NULL | auto_increment |
| time | date | YES | | NULL | |
| orderno | text | YES | | NULL | |
| ORIGINid | int(11) | YES | | NULL | |
| PRICEid | int(11) | YES | | NULL | |
| PAYMENTid | int(11) | YES | | NULL | |
| DELIVERY | text | YES | | NULL | |
| memo | text | YES | | NULL | |
+-----------+---------+------+-----+---------+----------------+
8 rows in set (0.01 sec)
表格增加一行操作
mysql> show columns from enq2;
+-----------+---------+------+-----+---------+----------------+
| Field | Type | Null | Key | Default | Extra |
+-----------+---------+------+-----+---------+----------------+
| id | int(11) | NO | PRI | NULL | auto_increment |
| time | date | YES | | NULL | |
| enq1id | int(11) | YES | | NULL | |
| ORIGINid | int(11) | YES | | NULL | |
| PRICEid | int(11) | YES | | NULL | |
| PAYMENTid | int(11) | YES | | NULL | |
| makerid | int(11) | YES | | NULL | |
| DELIVERY | text | YES | | NULL | |
| type1id | text | YES | | NULL | |
| partsid | text | YES | | NULL | |
| QTY | text | YES | | NULL | |
| memo | text | YES | | NULL | |
+-----------+---------+------+-----+---------+----------------+
12 rows in set (0.06 sec)
mysql> ALTER TABLE enq2 ADD LANGUAGEid INT AFTER enq1id;
Query OK, 1 row affected (0.45 sec)
Records: 1 Duplicates: 0 Warnings: 0
mysql> show columns from enq2;
+------------+---------+------+-----+---------+----------------+
| Field | Type | Null | Key | Default | Extra |
+------------+---------+------+-----+---------+----------------+
| id | int(11) | NO | PRI | NULL | auto_increment |
| time | date | YES | | NULL | |
| enq1id | int(11) | YES | | NULL | |
| LANGUAGEid | int(11) | YES | | NULL | |
| ORIGINid | int(11) | YES | | NULL | |
| PRICEid | int(11) | YES | | NULL | |
| PAYMENTid | int(11) | YES | | NULL | |
| makerid | int(11) | YES | | NULL | |
| DELIVERY | text | YES | | NULL | |
| type1id | text | YES | | NULL | |
| partsid | text | YES | | NULL | |
| QTY | text | YES | | NULL | |
| memo | text | YES | | NULL | |
+------------+---------+------+-----+---------+----------------+
13 rows in set (0.00 sec)
mysql> show columns from quo1;
+----------+---------+------+-----+---------+----------------+
| Field | Type | Null | Key | Default | Extra |
+----------+---------+------+-----+---------+----------------+
| id | int(11) | NO | PRI | NULL | auto_increment |
| time | date | YES | | NULL | |
| enq2id | int(11) | YES | | NULL | |
| makerref | text | YES | | NULL | |
| memo | text | YES | | NULL | |
+----------+---------+------+-----+---------+----------------+
5 rows in set (0.30 sec)
mysql> ALTER TABLE quo1 ADD price TEXT AFTER makerref;
Query OK, 2 rows affected (0.67 sec)
Records: 2 Duplicates: 0 Warnings: 0
mysql> show columns from quo1;
+----------+---------+------+-----+---------+----------------+
| Field | Type | Null | Key | Default | Extra |
+----------+---------+------+-----+---------+----------------+
| id | int(11) | NO | PRI | NULL | auto_increment |
| time | date | YES | | NULL | |
| enq2id | int(11) | YES | | NULL | |
| makerref | text | YES | | NULL | |
| price | text | YES | | NULL | |
| memo | text | YES | | NULL | |
+----------+---------+------+-----+---------+----------------+
6 rows in set (0.02 sec)
修改一个Column的操作(改名和改数据定义)
mysql> show columns from order1;
+-----------+---------+------+-----+---------+----------------+
| Field | Type | Null | Key | Default | Extra |
+-----------+---------+------+-----+---------+----------------+
| id | int(11) | NO | PRI | NULL | auto_increment |
| time | date | YES | | NULL | |
| quo2id | int(11) | YES | | NULL | |
| ORIGINid | int(11) | YES | | NULL | |
| PRICEid | int(11) | YES | | NULL | |
| PAYMENTid | int(11) | YES | | NULL | |
| DELIVERY | text | YES | | NULL | |
| price | text | YES | | NULL | |
| total | text | YES | | NULL | |
| memo | text | YES | | NULL | |
+-----------+---------+------+-----+---------+----------------+
10 rows in set (0.16 sec)
mysql> ALTER TABLE order1 CHANGE quo2id orderno TEXT;
Query OK, 6 rows affected (0.56 sec)
Records: 6 Duplicates: 0 Warnings: 0
mysql> show columns from order1;
+-----------+---------+------+-----+---------+----------------+
| Field | Type | Null | Key | Default | Extra |
+-----------+---------+------+-----+---------+----------------+
| id | int(11) | NO | PRI | NULL | auto_increment |
| time | date | YES | | NULL | |
| orderno | text | YES | | NULL | |
| ORIGINid | int(11) | YES | | NULL | |
| PRICEid | int(11) | YES | | NULL | |
| PAYMENTid | int(11) | YES | | NULL | |
| DELIVERY | text | YES | | NULL | |
| price | text | YES | | NULL | |
| total | text | YES | | NULL | |
| memo | text | YES | | NULL | |
+-----------+---------+------+-----+---------+----------------+
10 rows in set (0.02 sec) 


--------------------------------------------------------------------------------
# 把enq2的ID输入到enq1中
use strict;
use DBI;
my(%t,$n,@fld,@rec);
# 连接数据库
$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;
}
# 取得enq2和enq1的对应关系
$t{sth} = $t{dbh}->prepare ("SELECT id,enq1id FROM enq2");
$t{sth}->execute;
while ( @rec = $t{sth}->fetchrow_array )
{
$t{enq1}{$rec[0]} = $rec[1];
}
$t{sth}->finish;
for $n (keys %{ $t{enq1} } ) {
push(@{ $t{enq2}{$t{enq1}{$n}} },$n);
}
for $n ( keys %{ $t{enq2} } ) {
@{ $t{tmp} } = sort @{ $t{enq2}{$n} };
$t{enq2list} = join("=",@{ $t{tmp} });
$t{list}{$n} = $t{enq2list};
}
# 把数值代入enq1中
for $n ( keys %{ $t{list} } ) {
$t{value} = $t{list}{$n};
$t{sql} = 'UPDATE enq1 SET enq2s = "';
$t{sql} .= $t{value} . '" WHERE id = "' . $n . '";';
print "$t{sql}\n";
$t{dbh}->do($t{sql});
}
$t{dbh}->disconnect;
列出enq1 ID供选择(该部分已不用,保存下来做参考)
# 列出enq1 ID供选择
$t{sth} = $self->dbh->prepare("select id, ourref from enq1 ORDER BY id DESC");
$t{sth}->execute;
while (@rec = $t{sth}->fetchrow_array) {
$row_ref = (); # 这个初始化非常重要!
if ( $rec[0] == $t{enq1_id} ) {
$t{line1} = '<OPTION VALUE="' . $rec[0] . '" selected="selected">';
$t{line1} .= $rec[0] . '==>' . $rec[1] . '</OPTION>';
} else {
$t{line1} = '<OPTION VALUE="' . $rec[0] . '">';
$t{line1} .= $rec[0] . '==>' . $rec[1] . '</OPTION>';
}
$$row_ref{line1} = $t{line1};
push(@loop, $row_ref);
}
$t{sth}->finish;

$t{template}->param(LOOP => \@loop);
<tr bgcolor="lightcyan" align="center"><td>OURREF</td><td>
<TMPL_VAR NAME="enq1_id">==><TMPL_VAR NAME="ourref1">
<!-- 挑选enq1(OURREF) -->
<form action="" method="post">
<SELECT NAME="enq1_id">
<TMPL_LOOP NAME="LOOP">
<TMPL_VAR NAME="line1">
</TMPL_LOOP>
</SELECT>
<input type="submit" value="OURREF选择"><p>
<input type="hidden" name="id" value="<TMPL_VAR NAME="quo2_id">">
<input type="hidden" name="pat" value="select_enq1">
<input type="hidden" name="rm" value="modequo2">
</form>
<!-- 挑选enq1 -->
<form action="" method="post">
<input type=text name=word1 value="">
<input type="submit" value="OURREF検索"><p>
<input type="hidden" name="table" value="enq1">
<input type="hidden" name="table0" value="quo2">
<input type="hidden" name="item" value="enq1id">
<input type="hidden" name="id" value="<TMPL_VAR NAME="quo2_id">">
<input type="hidden" name="rm" value="modes_header">
</form>
</td></tr>

--------------------------------------------------------------------------------
返回
MySQL操作程序四
返回
--------------------------------------------------------------------------------
不要的程序最好马上清除掉!
$t{price1s}[2]为零,程序无法读下去
# price1的处理
sub get_price1 {
my($pref,$self) = @_;
my(%t,$n);

@{ $t{prices} } = split(/==/,$$pref{price10});
for $n ( 0 .. $#{ $t{prices} } ) {
$t{prices1} = $t{prices}[$n];
@{ $t{price1s} } = split(/=/,$t{prices1});
@{ $t{price1} } = @{ $t{price1s} }[0..1];
$t{money1} = $self->dbh->selectrow_array("SELECT English FROM money WHERE id = $t{price1s}[2]");
push(@{ $t{price1} },$t{money1});
push(@{ $t{price1} },$t{price1s}[3]);
$t{maker1} = $self->dbh->selectrow_array("SELECT company FROM makers WHERE id = $t{price1s}[4]");
push(@{ $t{price1} },$t{maker1});
$t{price11} = join('/',@{ $t{price1} });
$$pref{price1} .= '<OPTION VALUE="">' . $t{price11} . '</OPTION>';
}
return($pref,$self);
}
# price2的处理
sub get_price2 {
my($pref,$self) = @_;
my(%t,$n);

@{ $t{prices} } = split(/==/,$$pref{price20});
for $n ( 0 .. $#{ $t{prices} } ) {
$t{prices2} = $t{prices}[$n];
@{ $t{price2s} } = split(/=/,$t{prices2});
@{ $t{price2} } = @{ $t{price2s} }[0..1];
$t{money1} = $self->dbh->selectrow_array("SELECT English FROM money WHERE id = $t{price2s}[2]");
push(@{ $t{price2} },$t{money1});
push(@{ $t{price2} },$t{price2s}[3]);
$t{maker1} = $self->dbh->selectrow_array("SELECT company FROM makers WHERE id = $t{price2s}[4]");
push(@{ $t{price2} },$t{maker1});
$t{price21} = join('/',@{ $t{price2} });
$$pref{price2} .= '<OPTION VALUE="">' . $t{price21} . '</OPTION>';
}
return($pref,$self);
}

Putting Commas in Numbers
$a = 10000000.33;
print "a=$a\n";
$a = commify($a);
print "a=$a\n";
sub commify {
my $text = reverse $_[0];
$text =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;
return scalar reverse $text;
}
a=10000000.33
a=10,000,000.33
判断是否是正的整数
@{ $t{list} } = qw/3.3 -3 2 55.2/;
for $n ( 0 .. $#{ $t{list} } ) {
$val = $t{list}[$n];
$valid = is_positive_integer($val);
if ( $valid ) {
print "$val is valid\n";
} else {
print "$val is not valid\n";
}
}
sub is_positive_integer {
my $s = shift;
return ( $s =~ /^\+?\d+$/ && $s > 0 );
}
3.3 is not valid
-3 is not valid
2 is valid
55.2 is not valid
一些旧程序
if ( $t{discount} ne 'D' ) {
@{ $t{dd} } = split(/=/,$t{discount});
} else {
for $n ( 1 .. $t{pl2} ) {
push(@{ $t{dd} },100);
}
}
<th>
<form action="" method="post">
<input type="submit" value="Disc2"><br>
<input type=text size=3 name="discount0" value="<TMPL_VAR NAME="discount0">">
<input type="hidden" name="id" value=<TMPL_VAR NAME="quo2_id">>
<input type="hidden" name="pat" value="discount0">
<input type="hidden" name="rm" value="modequo2">
</form>
</th>
#---------输入全部一样的discount
} elsif ( $t{pat} eq 'discount0' ) {
$t{discount0} = $t{q}->param("discount0");
# 取得零件数量
$t{partsid} = $self->dbh->selectrow_array("SELECT partsid FROM enq1 WHERE id = $t{quo2_id}");
$t{pl2} = 0;
@{ $t{pl1} } = split(/=/,$t{partsid});
for $n ( 0 .. $#{ $t{pl1} } ) {
if ( $t{pl1}[$n] != 0 ) {
$t{pl2}++;
push(@{ $t{dd} },$t{discount0});
}
}
# 更新quo2的discount0和discount
$t{discount} = join('=',@{ $t{dd} });
$t{sql} = 'UPDATE quo2 set discount0 = "';
$t{sql} .= $t{discount0} . '" where id = ';
$t{sql} .= $t{quo2_id};
$t{DO} = $self->dbh->do($t{sql});
$t{sql} = 'UPDATE quo2 set discount = "';
$t{sql} .= $t{discount} . '" where id = ';
$t{sql} .= $t{quo2_id};
$t{DO} = $self->dbh->do($t{sql});
# 価格表を更新する
@{ $t{ppp} } = ();
$t{price0} = $self->dbh->selectrow_array("SELECT price0 FROM quo2 WHERE id = $t{quo2_id}");
$t{percent} = $self->dbh->selectrow_array("SELECT percent FROM quo2 WHERE id = $t{quo2_id}");
@{ $t{prices} } = split(/=/,$t{price0});
@{ $t{pe} } = split(/=/,$t{percent});
for $n ( 0 .. $#{ $t{prices} } ) {
$t{ppp1} = int($t{prices}[$n]*$t{dd}[$n]*$t{pe}[$n]/10000);
push(@{ $t{ppp} },$t{ppp1});
}
$t{price} = join('=',@{ $t{ppp} });
$t{sql} = 'UPDATE quo2 set price = "';
$t{sql} .= $t{price} . '" where id = ';
$t{sql} .= $t{quo2_id};
$t{DO} = $self->dbh->do($t{sql});
--------------------------------------------------------------------------------
if ( $t{disc} ne 'D0' ) {
@{ $t{ddd0} } = split(/=/,$t{disc});
} else {
for $n ( 1 .. $t{pl2} ) {
push(@{ $t{ddd0} },100);
}
}
#---------输入全部一样的disc0
} elsif ( $t{pat} eq 'disc0' ) {
$t{disc0} = $t{q}->param("disc0");
# 取得零件数量
$t{partsid} = $self->dbh->selectrow_array("SELECT partsid FROM enq1 WHERE id = $t{quo2_id}");
$t{pl2} = 0;
@{ $t{pl1} } = split(/=/,$t{partsid});
for $n ( 0 .. $#{ $t{pl1} } ) {
if ( $t{pl1}[$n] != 0 ) {
$t{pl2}++;
push(@{ $t{d0} },$t{disc0});
}
}
# 更新quo2的disc0和disc
$t{disc} = join('=',@{ $t{d0} });
$t{sql} = 'UPDATE quo2 set disc0 = "';
$t{sql} .= $t{disc0} . '" where id = ';
$t{sql} .= $t{quo2_id};
$t{DO} = $self->dbh->do($t{sql});
$t{sql} = 'UPDATE quo2 set disc = "';
$t{sql} .= $t{disc} . '" where id = ';
$t{sql} .= $t{quo2_id};
$t{DO} = $self->dbh->do($t{sql});
# 価格表を更新する
@{ $t{ppp} } = ();
$t{price0} = $self->dbh->selectrow_array("SELECT price0 FROM quo2 WHERE id = $t{quo2_id}");
$t{percent} = $self->dbh->selectrow_array("SELECT percent FROM quo2 WHERE id = $t{quo2_id}");
$t{discount} = $self->dbh->selectrow_array("SELECT discount FROM quo2 WHERE id = $t{quo2_id}");
@{ $t{prices} } = split(/=/,$t{price0});
@{ $t{pe} } = split(/=/,$t{percent});
@{ $t{dd} } = split(/=/,$t{discount});
for $n ( 0 .. $#{ $t{prices} } ) {
$t{ppp1} = int($t{prices}[$n]*$t{dd}[$n]*$t{pe}[$n]*$t{d0}[$n]/1000000);
push(@{ $t{ppp} },$t{ppp1});
}
$t{price} = join('=',@{ $t{ppp} });
$t{sql} = 'UPDATE quo2 set price = "';
$t{sql} .= $t{price} . '" where id = ';
$t{sql} .= $t{quo2_id};
$t{DO} = $self->dbh->do($t{sql});
<form action="" method="post">
<input type="submit" value="Disc1"><br>
<input type=text size=3 name="disc0" value="<TMPL_VAR NAME="disc0">">
<input type="hidden" name="id" value=<TMPL_VAR NAME="quo2_id">>
<input type="hidden" name="pat" value="disc0">
<input type="hidden" name="rm" value="modequo2">
</form>

--------------------------------------------------------------------------------
返回
MySQL操作程序五
返回
--------------------------------------------------------------------------------
指定数据写入enq1(insert_series2.pl)
use strict;
use DBI;
my(%t,$n,$n1,@fld,@rec,$pref);
# 连接数据库
$$pref{dsn} = "DBI:mysql:host=localhost;database=cookbook";
$$pref{dbh} = DBI->connect($$pref{dsn}, "cbuser", "cbpass") or die "Cannot connect to server\n";
$$pref{dbh}->do("SET NAMES utf8");
if(!$$pref{dbh}){
print "SQL read ERROR!\n";
exit;
}
$t{sth} = $$pref{dbh}->prepare("SELECT id,type1id FROM enq1");
$t{sth}->execute;
while ( @rec = $t{sth}->fetchrow_array ) {
if ( $rec[1] ne 'B' ) {
@{ $t{type1ids} } = split(/==/,$rec[1]);
@{ $t{sess} } = ();
for $n ( 0 .. $#{ $t{type1ids} } ) {
push(@{ $t{sess} },1);
}
$t{sess1} = join('=',@{ $t{sess} });
$t{sql} = 'UPDATE enq1 SET seriesid = "';
$t{sql} .= $t{sess1} . '" WHERE id = "' . $rec[0] . '"';
$t{DO} = $$pref{dbh}->do($t{sql});
print "$rec[0],$rec[1],$t{sess1},DO=$t{DO}\n";
}
}
$t{sth}->finish;
# 关闭数据库
$$pref{dbh}->disconnect;
指定数据写入main_type1(insert_series.pl)
use strict;
use DBI;
my(%t,$n,$n1,@fld,@rec,$pref);
# 连接数据库
$$pref{dsn} = "DBI:mysql:host=localhost;database=cookbook";
$$pref{dbh} = DBI->connect($$pref{dsn}, "cbuser", "cbpass") or die "Cannot connect to server\n";
$$pref{dbh}->do("SET NAMES utf8");
if(!$$pref{dbh}){
print "SQL read ERROR!\n";
exit;
}
# 取得main_type1的长度
$t{length1} = $$pref{dbh}->selectrow_array("SELECT COUNT(*) FROM main_type1");
for $n ( 1 .. $t{length1} ) {
$t{series} = $$pref{dbh}->selectrow_array("SELECT series FROM main_type1 WHERE id = $n and series is NOT NULL");
if ( $t{series} ) {
$t{series} = 'XXXSERIES=' . $t{series};
# print "$n==>$t{series}\n";
} else {
$t{series} = 'XXXSERIES';
}
$t{sql} = 'UPDATE main_type1 SET series = "';
$t{sql} .= $t{series} . '" WHERE id = "' . $n . '"';
$t{DO} = $$pref{dbh}->do($t{sql});
if ( $t{DO} == 0 ) {
print "$n==>$t{DO}\n";
print "sql==>$t{sql}\n";
exit;
}
}
# 关闭数据库
$$pref{dbh}->disconnect;

指定数据写入数据库(insert_tables.pl)
use strict;
use DBI;
my(%t,$n,$n1,@fld,@rec,$pref);
# 连接数据库
$$pref{dsn} = "DBI:mysql:host=localhost;database=cookbook";
$$pref{dbh} = DBI->connect($$pref{dsn}, "cbuser", "cbpass") or die "Cannot connect to server\n";
$$pref{dbh}->do("SET NAMES utf8");
if(!$$pref{dbh}){
print "SQL read ERROR!\n";
exit;
}
# 指定数据库名
print "Please input database table name=";
chop($t{table1}=<STDIN>);
# 清空指定数据库表格内容
$t{delete_table} = 'DELETE FROM ' . $t{table1};
$$pref{dbh}->do($t{delete_table});
# 读取指定表格的所有数据
$t{inputf} = 'kobe_' . $t{table1} . '.txt';
open(IN,"../txt/$t{inputf}") or die "Can't open the file $t{inputf}\n";
$t{NO} = -1;
while(<IN>){
if ( $. == 2 ) {
chop;
@fld = split(/===/,$_);
@{ $t{columns_list} } = @fld[1..$#fld];
} elsif ( $. > 2 ) {
chop;
@fld = split(/===/,$_);
$t{NO}++;
for $n ( 1 .. $#fld ) {
if ( $fld[$n] ) {
$t{data_list}[$t{NO}][$n-1] = '"' . $fld[$n] . '"';
} else {
$t{data_list}[$t{NO}][$n-1] = 'NULL';
}
}
# 这个操作的目的是保证两个array一样长
$t{start} = $#{ $t{data_list}[$t{NO}] };
$t{end} = $#{ $t{columns_list} };
if ($t{end} > $t{start}) {
$t{start} = $t{start} + 1;
for $n ( $t{start} .. $t{end} ) {
$t{data_list}[$t{NO}][$n] = 'NULL';
}
}
}
}
close(IN);
print "data_list=@{ $t{data_list}[0] }\n";
print "data_list=@{ $t{data_list}[1] }\n";
print "$#{ $t{columns_list} }\n";
print "$#{ $t{data_list}[0] }\n";
#exit;
# 插入数据
$t{leng1} = $#{ $t{columns_list} };
$t{leng2} = $#{ $t{columns_list} } - 1;
for $n ( 0 .. $#{ $t{data_list} } ) {
$t{sql} = 'INSERT INTO ' . $t{table1} . ' (';
for $n1 ( 0 .. $t{leng2} ) {
$t{sql} .= $t{columns_list}[$n1] . ',';
}
$t{sql} .= $t{columns_list}[$t{leng1}] . ')';
$t{sql} .= ' VALUES(';
for $n1 ( 0 .. $t{leng2} ) {
$t{data1} = $t{data_list}[$n][$n1];
$t{sql} .= $t{data1} . ',';
}
$t{sql} .= $t{data_list}[$n][$t{leng1}] . ')';
$$pref{dbh}->do($t{sql});
# print $t{sql},"\n";
# exit;
}
# 关闭数据库
$$pref{dbh}->disconnect;
抽出符合条件的main_type1的id(test080714.pl)
use strict;
use DBI;
my(%t,$n,@fld,$aref);
# 连接数据库
$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{word1} = '17A';
$t{type1_leng} = $t{dbh}->selectrow_array("SELECT count(*) FROM main_type1");
for $n ( 1 .. $t{type1_leng} ) {
$t{ptable1} = sprintf("%06d",$n);
$t{ptable1} = 'a' . $t{ptable1};
$t{count1} = $t{dbh}->selectrow_array("SELECT count(*) FROM $t{ptable1} WHERE code LIKE \'\%$t{word1}\%\'");
print "$n===>$t{count1}\n";
}
$t{dbh}->disconnect;

用SHOW CREATE TABLE复制表格
$t{table1} = 'enq1';
$t{table2} = $t{table1} . '_tmp';
$t{sth} = $$pref{dbh}->prepare("SHOW CREATE TABLE $t{table1}");
$t{sth}->execute;
while ( @rec = $t{sth}->fetchrow_array ) {
$t{create_table} = $rec[1];
print $t{create_table},"\n";
$t{create_table} =~ s/$t{table1}/$t{table2}/;
print $t{create_table},"\n";
}
$t{sth}->finish;
$$pref{dbh}->do($t{create_table});
执行结果
CREATE TABLE `enq1` (
`id` int(11) NOT NULL auto_increment,
`time` date default NULL,
`ourref` int(11) default NULL,
`owner` int(11) default NULL,
`ownerno` varchar(100) default NULL,
`hullnoid` int(11) default NULL,
`type1id` text,
`partsid` text,
`QTY` text,
`memo` text,
`enq2s` text,
PRIMARY KEY (`id`)
) ENGINE=InnoDB AUTO_INCREMENT=12 DEFAULT CHARSET=utf8
CREATE TABLE `enq1_tmp` (
`id` int(11) NOT NULL auto_increment,
`time` date default NULL,
`ourref` int(11) default NULL,
`owner` int(11) default NULL,
`ownerno` varchar(100) default NULL,
`hullnoid` int(11) default NULL,
`type1id` text,
`partsid` text,
`QTY` text,
`memo` text,
`enq2s` text,
PRIMARY KEY (`id`)
) ENGINE=InnoDB AUTO_INCREMENT=12 DEFAULT CHARSET=utf8

取出指定数据库数据并写入中间文件(obtain_tables.pl)
use strict;
use DBI;
my(%t,$n,@fld,@rec,$pref);
# 连接数据库
$$pref{dsn} = "DBI:mysql:host=localhost;database=cookbook";
$$pref{dbh} = DBI->connect($$pref{dsn}, "cbuser", "cbpass") or die "Cannot connect to server\n";
$$pref{dbh}->do("SET NAMES utf8");
if(!$$pref{dbh}){
print "SQL read ERROR!\n";
exit;
}
# 指定数据库名
print "Please input database table name=";
chop($t{table1}=<STDIN>);
$t{outputf} = $t{table1} . '.txt';
# 取出COLUMNS
$t{sth} = $$pref{dbh}->prepare("SHOW COLUMNS FROM $t{table1}");
$t{sth}->execute;
$t{column_list} = '';
while ( @rec = $t{sth}->fetchrow_array ) {
push(@{ $t{columns_list} },$rec[0]);
}
$t{sth}->finish;
# 取出所有数据并写入中间文件
open(OUT,">../txt/$t{outputf}");
print OUT "filename=$t{outputf}\n";
$t{line1} = join('===',@{ $t{columns_list} });
print OUT $t{table1};
print OUT '===';
print OUT $t{line1};
print OUT "\n";
$t{sth} = $$pref{dbh}->prepare("SELECT * FROM $t{table1}");
$t{sth}->execute;
while ( @rec = $t{sth}->fetchrow_array ) {
$t{line1} = join('===',@rec);
print OUT $t{table1};
print OUT '===';
print OUT $t{line1};
print OUT "\n";
}
$t{sth}->finish;
close(OUT);
# 关闭数据库
$$pref{dbh}->disconnect;
print "The output file is ../txt/$t{outputf}\n";
生成一个表格(make_table1.pl)
use strict;
use DBI;
my(%t,$n,@fld,@rec);
# 文件表名
$t{table1} = 'enq1list';
# 连接数据库
$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{table1} . ';';
$t{dbh}->do($t{sql});
# 创建一个零件表
$t{sql} = 'CREATE TABLE ' . $t{table1};
$t{sql} .= ' (';
$t{sql} .= 'id INT AUTO_INCREMENT,';
$t{sql} .= 'enq1s1 TEXT,';
$t{sql} .= 'enq1s2 TEXT,';
$t{sql} .= 'enq1s3 TEXT,';
$t{sql} .= 'PRIMARY KEY (id));';
$t{dbh}->do($t{sql});
$t{dbh}->disconnect;
__END__;
perl检索测试程序
结果正确
---------------------------------------------------------------------------
$t{orig1} = '17==28';
$t{word1} = '28';
@{ $t{name1s} } = split(/==/,$t{orig1});
$t{SEARCH_OK} = 0;
for $n ( 0 .. $#{ $t{name1s} } ) {
if ( $t{name1s}[$n] == $t{word1} ) {
$t{SEARCH_OK} = 1;
}
}
print "SEARCH_OK=$t{SEARCH_OK}\n";
SEARCH_OK=1
---------------------------------------------------------------------------
结果有错
---------------------------------------------------------------------------
$t{orig1} = '17==28';
$t{word1} = '7';
@{ $t{name1s} } = split(/==/,$t{orig1});
$t{name1} = join(' ',@{ $t{name1s} });
if ( $t{name1} =~ /$t{word1}/ ) {
print "word1=$t{word1}\n";
print "name1=$t{name1}\n";
}
word1=7
name1=17 28
---------------------------------------------------------------------------
读取一个表格的所有ID的语句
$aref = $t{dbh}->selectcol_arrayref("SELECT id FROM enq1");
print "enq1list=@$aref\n";
enq1list=1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29

--------------------------------------------------------------------------------
返回
MySQL操作程序六
返回
--------------------------------------------------------------------------------
更新所有零件表的price1和price2(update_ptables.pl)
use strict;
use DBI;
my(%t,$n,@fld,@rec,$pref);
# 连接数据库
$$pref{dsn} = "DBI:mysql:host=localhost;database=cookbook";
$$pref{dbh} = DBI->connect($$pref{dsn}, "cbuser", "cbpass") or die "Cannot connect to server\n";
$$pref{dbh}->do("SET NAMES utf8");
if(!$$pref{dbh}){
print "SQL read ERROR!\n";
exit;
}
# 取出main_type1的编号,同时生成零件表名
@{ $t{ptables} } = ();
$t{sth} = $$pref{dbh}->prepare("SELECT id FROM main_type1");
$t{sth}->execute;
while ( @rec = $t{sth}->fetchrow_array ) {
$t{ptable1} = sprintf("%06d",$rec[0]);
$t{ptable1} = 'a' . $t{ptable1};
push(@{ $t{ptables} },$t{ptable1});
}
$t{sth}->finish;
# 插入price1和price2
for $n ( 0 .. $#{ $t{ptables} } ) {
$$pref{ptable1} = $t{ptables}[$n];
($pref) = input_ptable1($pref);
}
# 关闭数据库
$$pref{dbh}->disconnect;
print "Finished.\n";
sub input_ptable1 {
my($pref) = @_;
my(%t,$n);

# price1赋值
$t{sql} = 'update ' . $$pref{ptable1};
$t{sql} .= ' set price1 = ';
$t{sql} .= '"0=100=1=0000-00-00=1"';
$$pref{dbh}->do($t{sql});
# price2赋值
$t{sql} = 'update ' . $$pref{ptable1};
$t{sql} .= ' set price2 = ';
$t{sql} .= '"0=100=1=0000-00-00=1=1"';
$$pref{dbh}->do($t{sql});
return($pref);
}
__END__;

更新一个零件表的price1和price2(update_ptable1.pl)
use strict;
use DBI;
my(%t,$n,@fld,@rec);
# 输入主机序号,形成零件表名
print "Please input parts table name(Enginee.NO)=";
chop($t{input}=<STDIN>);
$t{inputf} = sprintf("%06d",$t{input});
$t{table1} = 'a' . $t{inputf};
# 连接数据库
$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;
}
# price1赋值
$t{sql} = 'update ' . $t{table1};
$t{sql} .= ' set price1 = ';
$t{sql} .= '"0=100=1=0000-00-00=1"';
$t{dbh}->do($t{sql});
# price2赋值
$t{sql} = 'update ' . $t{table1};
$t{sql} .= ' set price2 = ';
$t{sql} .= '"0=100=1=0000-00-00=1=1"';
$t{dbh}->do($t{sql});
$t{dbh}->disconnect;
取出一个零件表数据并写入中间文件(obtain_ptable1.pl)
## 需注意price1和price2的内容
use strict;
use DBI;
my(%t,$n,@fld,@rec,$pref);
# 连接数据库
$$pref{dsn} = "DBI:mysql:host=localhost;database=cookbook";
$$pref{dbh} = DBI->connect($$pref{dsn}, "cbuser", "cbpass") or die "Cannot connect to server\n";
$$pref{dbh}->do("SET NAMES utf8");
if(!$$pref{dbh}){
print "SQL read ERROR!\n";
exit;
}
# 输入文件名
print "Please input number=";
chop($t{number1}=<STDIN>);
$t{number1} = sprintf("%06d",$t{number1});
$t{ptable1} = 'a' . $t{number1};
@{ $t{ptables} } = ($t{ptable1});
$$pref{ptable1} = $t{ptable1};
($pref) = read_ptable($pref);
$t{outputf} = $t{ptable1} . '.txt';
# 关闭数据库
$$pref{dbh}->disconnect;
# 写入中间文件(../txt/ptables.txt)
open(OUT,">../txt/$t{outputf}");
print OUT 'filename=ptables.txt',"\n";
print OUT 'C===file===id===name===code===dwg_id===Nuid===weight===price1===price2===memo',"\n";
for $n ( 0 .. $#{ $t{ptables} } ) {
$$pref{ptable1} = $t{ptables}[$n];
($pref) = write_ptable($pref);
}
close(OUT);
sub write_ptable {
my($pref) = @_;
my (%t,$n);

for $n ( 0 .. $#{ $$pref{id}{$$pref{ptable1}} } ) {
$t{id} = $$pref{id}{$$pref{ptable1}}[$n];
$t{name} = $$pref{name}{$$pref{ptable1}}[$n];
# $t{name} =~ s/\x0D\x0A//g;
# $t{name} =~ s/\x0D$//; # 改行符号去掉(如果有的话)
$t[code] = $$pref[code]{$$pref{ptable1}}[$n];
# $t[code] =~ s/\x0D$//; # 改行符号去掉(如果有的话)
$t{dwg_id} = $$pref{dwg_id}{$$pref{ptable1}}[$n];
$t{Nuid} = $$pref{Nuid}{$$pref{ptable1}}[$n];
print OUT 'PT===',$$pref{ptable1};
print OUT '===',$t{id};
print OUT '===',$t{name};
print OUT '===',$t[code];
print OUT '===',$t{dwg_id};
print OUT '===',$t{Nuid};
print OUT "\n";
}
return($pref);
}
sub read_ptable {
my($pref) = @_;
my (%t,@rec);
# 读零件表
$t{sth} = $$pref{dbh}->prepare("SELECT id,name,code,dwg_id,Nuid FROM $$pref{ptable1}");
$t{sth}->execute;
while ( @rec = $t{sth}->fetchrow_array ) {
push(@{ $$pref{id}{$$pref{ptable1}} },$rec[0]);
push(@{ $$pref{name}{$$pref{ptable1}} },$rec[1]);
push(@{ $$pref[code]{$$pref{ptable1}} },$rec[2]);
push(@{ $$pref{dwg_id}{$$pref{ptable1}} },$rec[3]);
push(@{ $$pref{Nuid}{$$pref{ptable1}} },$rec[4]);
}
$t{sth}->finish;
return($pref);
}

取出数据表一列数据并写入中间文件(obtain_table1.pl)
use strict;
use DBI;
my(%t,$n,@fld,@rec,$pref);
# 连接数据库
$$pref{dsn} = "DBI:mysql:host=localhost;database=cookbook";
$$pref{dbh} = DBI->connect($$pref{dsn}, "cbuser", "cbpass") or die "Cannot connect to server\n";
$$pref{dbh}->do("SET NAMES utf8");
if(!$$pref{dbh}){
print "SQL read ERROR!\n";
exit;
}
# 指定数据库名
print "Please input database table name=";
chop($t{table1}=<STDIN>);
print "Please input number=";
chop($t{number1}=<STDIN>);
$t{outputf} = $t{table1} . '_' . $t{number1} . '.txt';
# 取出COLUMNS
$t{sth} = $$pref{dbh}->prepare("SHOW COLUMNS FROM $t{table1}");
$t{sth}->execute;
$t{column_list} = '';
while ( @rec = $t{sth}->fetchrow_array ) {
push(@{ $t{columns_list} },$rec[0]);
}
$t{sth}->finish;
# 取出所有数据并写入中间文件
open(OUT,">../txt/$t{outputf}");
print OUT "filename=$t{outputf}\n";
$t{line1} = join('===',@{ $t{columns_list} });
print OUT $t{table1};
print OUT '===';
print OUT $t{line1};
print OUT "\n";
$t{sth} = $$pref{dbh}->prepare("SELECT * FROM $t{table1}");
$t{sth}->execute;
while ( @rec = $t{sth}->fetchrow_array ) {
if ( $rec[0] == $t{number1} ) {
$t{line1} = join('===',@rec);
print OUT $t{table1};
print OUT '===';
print OUT $t{line1};
print OUT "\n";
}
}
$t{sth}->finish;
close(OUT);
# 关闭数据库
$$pref{dbh}->disconnect;
生成部分数据库零件表(make_lost_ptables.pl)
use strict;
use DBI;
my(%t,$n,@fld,$pref,@rec);
# 连接数据库
$$pref{dsn} = "DBI:mysql:host=localhost;database=cookbook";
$$pref{dbh} = DBI->connect($$pref{dsn}, "cbuser", "cbpass") or die "Cannot connect to server\n";
$$pref{dbh}->do("SET NAMES utf8");
if(!$$pref{dbh}){
print "SQL read ERROR!\n";
exit;
}
# 取出数据
open(IN,"../txt/check_ptables.txt") or die "Can't open the file check_ptables.txt.\n";
$t{NO} = 0;
while(<IN>){
if (/^PTABLE/) {
chop;
@fld = split(/===>/);
if ( $fld[1] == 0 ) {
$t{NO}++;
push(@{ $t{ptables} },$fld[2]);
}
}
}
close(IN);
print "NO=$t{NO},$#{ $t{ptables} }\n";
print "ptables=@{ $t{ptables} }\n";
# 生成零件表
for $n ( 0 .. $#{ $t{ptables} } ) {
$$pref{ptable1} = $t{ptables}[$n];
($pref) = ptable1($pref);
}
# 关闭数据库
$$pref{dbh}->disconnect;
print "Finished.\n";
sub ptable1 {
my($pref) = @_;
my(%t);

$t{sql} = 'DROP TABLE IF EXISTS ' . $$pref{ptable1} . ';';
$$pref{dbh}->do($t{sql});
$t{sql} = 'CREATE TABLE ' . $$pref{ptable1};
$t{sql} .= ' (';
$t{sql} .= 'id INT AUTO_INCREMENT,';
$t{sql} .= 'name TEXT,';
$t{sql} .= 'code TEXT,';
$t{sql} .= 'dwg_id INT,';
$t{sql} .= 'Nuid INT,';
$t{sql} .= 'weight INT,';
$t{sql} .= 'price1 TEXT,';
$t{sql} .= 'price2 TEXT,';
$t{sql} .= 'memo TEXT,';
$t{sql} .= 'PRIMARY KEY (id));';
$$pref{dbh}->do($t{sql});

return($pref);
}
__END__;

检查Ptables(check_ptables.pl)
use strict;
use DBI;
my(%t,$n,@fld,@rec,$pref);
# 连接数据库
$$pref{dsn} = "DBI:mysql:host=localhost;database=cookbook";
$$pref{dbh} = DBI->connect($$pref{dsn}, "cbuser", "cbpass") or die "Cannot connect to server\n";
$$pref{dbh}->do("SET NAMES utf8");
if(!$$pref{dbh}){
print "SQL read ERROR!\n";
exit;
}
# 取出main_type1的最大id数量
$t{main_type1id_max} = $$pref{dbh}->selectrow_array("SELECT max(id) FROM main_type1");
# 对象文件(../txt/ptables.txt)
open(IN,"../txt/ptables.txt");
while(<IN>){
if (/^PT/){
@fld = split(/===/);
$t{plist}{$fld[1]} = $fld[1];
}
}
close(IN);
@{ $t{ptables} } = sort keys %{ $t{plist} };
$t{ptable_list} = join(' ',@{ $t{ptables} });
# 关闭数据库
$$pref{dbh}->disconnect;
open(OUT,">../txt/check_ptables.txt");
for $n ( 1 .. $t{main_type1id_max} ) {
$t{ptable1} = sprintf("%06d",$n);
$t{ptable1} = 'a' . $t{ptable1};
if ( $t{ptable_list} =~ /$t{ptable1}/) {
print OUT "PTABLE===>1===>$t{ptable1}\n";
} else {
print OUT "PTABLE===>0===>$t{ptable1}\n";
}
}
检查TYPE(check_types.pl)
use strict;
use DBI;
my(%t,$n,@fld,$pref,@rec);
# 连接数据库
$$pref{dsn} = "DBI:mysql:host=localhost;database=cookbook";
$$pref{dbh} = DBI->connect($$pref{dsn}, "cbuser", "cbpass") or die "Cannot connect to server\n";
$$pref{dbh}->do("SET NAMES utf8");
if(!$$pref{dbh}){
print "SQL read ERROR!\n";
exit;
}
# 取出main_type1的数据
$t{sth} = $$pref{dbh}->prepare("SELECT id,name FROM main_type1");
$t{sth}->execute;
while ( @rec = $t{sth}->fetchrow_array ) {
push(@{ $t{id_list} },$rec[0]);
push(@{ $t{name_list} },$rec[1]);
}
$t{sth}->finish;
# 关闭数据库
$$pref{dbh}->disconnect;
open(OUT,">../txt/check_types.txt");
for $n ( 0 .. $#{ $t{id_list} } ) {
$t{id1} = $t{id_list}[$n];
$t{name1} = $t{name_list}[$n];
if ( $t{names}{$t{name1}} ) {
printf OUT ("%04d==>1==>%04d==>%s\n",$t{id1},$t{names}{$t{name1}},$t{name1});
} else {
printf OUT ("%04d==>0==>0000==>%s\n",$t{id1},$t{name1});
}
$t{NO} = $n + 1;
$t{names}{$t{name1}} = $t{NO};
}
close(OUT);

--------------------------------------------------------------------------------
返回
MySQL操作程序七
返回
--------------------------------------------------------------------------------
检查enq1和enq2的关系(check_enq1_enq2.pl)
use strict;
use DBI;
my(%t,$n,@fld,@rec,$pref);
# 连接数据库
$$pref{dsn} = "DBI:mysql:host=localhost;database=cookbook";
$$pref{dbh} = DBI->connect($$pref{dsn}, "cbuser", "cbpass") or die "Cannot connect to server\n";
$$pref{dbh}->do("SET NAMES utf8");
if(!$$pref{dbh}){
print "SQL read ERROR!\n";
exit;
}
# 取出所有enq1的enq2s
$t{sth} = $$pref{dbh}->prepare("SELECT id,enq2s FROM enq1");
$t{sth}->execute;
while ( @rec = $t{sth}->fetchrow_array ) {
@{ $t{enq2} } = split(/=/,$rec[1]);
for $n ( 0 .. $#{ $t{enq2} } ) {
if ( $t{list}{$t{enq2}[$n]} ) {
print "NO,enq1=$rec[0],enq2=$t{enq2}[$n]\n";
} else {
$t{list}{$t{enq2}[$n]} = $rec[0];
}
}
}
$t{sth}->finish;
# 检查取出的enq2的enq1id
for $n ( sort {$a<=>$b} keys %{ $t{list} } ) {
$t{enq1} = $$pref{dbh}->selectrow_array("SELECT enq1id FROM enq2 WHERE id = $n");
if ($t{enq1} == $t{list}{$n} ) {
# print "$n==>$t{list}{$n}=>$t{enq1},OK!\n";
} else {
print "$n==>$t{list}{$n}=>$t{enq1},NOT OK!\n";
}
}
# 关闭数据库
$$pref{dbh}->disconnect;

--------------------------------------------------------------------------------
返回
读零件数据处理程序
返回
--------------------------------------------------------------------------------
# 输入零件程序(mscenq1.pl中)
# 待完善的项目
# 如何输入GROUP名(和零件一起)?
# 显示输入数据中的重复code
# 显示与DB中已有数据的重复code
#---------输入parts
} elsif ( $t{pat} eq 'parts' ) {
$t{NE1} = $t{q}->param("NE1");
$t{main_type1id} = $t{q}->param("main_type1id");
$t{name1} = $t{q}->param("name1");
$t{partsname} = $t{q}->param("partsname");
$t{partscode} = $t{q}->param("partscode");
$t{partsqty} = $t{q}->param("partsqty");
$t{DWG0} = $t{q}->param("DWG0");
$t{DWG0_id} = $t{q}->param("DWG0_id");
# 读人机界面的数据
@{ $t{names} } = split(/\r\n/,$t{partsname});
@{ $t{codes} } = split(/\r\n/,$t{partscode});
@{ $t{qtys} } = split(/\r\n/,$t{partsqty});
$t{length1} = $#{ $t{names} };
# units的存档
@{ $t{units} } = ();
for $n ( 0 .. $t{length1} ) {
$t{id} = $n + 1;
$t{unit1} = 'unit1_' . $t{id};
$t{unit1} = $t{q}->param("$t{unit1}");
push(@{ $t{units} },$t{unit1});
}

# enq1的输入数据进行配对(和DB同步时会打乱顺序)
my @b = ();
for $n ( 0 .. $t{length1} ) {
$t{n1} = $t{names}[$n];
$t{c1} = $t{codes}[$n];
$t{u1} = $t{units}[$n];
$t{c1} = $t{c1} . '===' . $t{DWG0_id};
$t{enq1_names}{$t{c1}} = $t{n1};
$t{enq1_units}{$t{c1}} = $t{u1};
push @b, $t{c1};
}
# 零件表的名称
$t{ptable} = sprintf("%06d",$t{main_type1id});
$t{ptable} = 'a' . $t{ptable};
# 先判断是否是empty table.
$t{count1} = $self->dbh->selectrow_array("SELECT count(*) FROM $t{ptable}");

# 取出DB的Parts的codes
%count = %count2 = ();
@union = @isect = @diff = ();
if ( $t{count1} != 0 ) { # 只有在不是空表格时才进行操作
@{ $t{dbcodes} } = ();
$t{sth} = $self->dbh->prepare("SELECT id,name,code,dwg_id,Nuid FROM $t{ptable}");
$t{sth}->execute;
while ( @rec = $t{sth}->fetchrow_array ) {
# 要考虑DWG不同,但是code相同的情况
$t{dbcode1} = $rec[2] . '===' . $rec[3]; # 这个操作合并code和DWG
push @{ $t{dbcodes} }, $t{dbcode1};
$t{dbids}{$t{dbcode1}} = $rec[0];
$t{dbnames}{$t{dbcode1}} = $rec[1];
$t{dbunits}{$t{dbcode1}} = $rec[4];
$t{idmax} = $rec[0];
}
$t{sth}->finish;
# 同步作业
@a = @{ $t{dbcodes} };
foreach $e (@a,@b) { $count{$e}++ };
@union = sort keys %count;
foreach $e ( keys %count ) {
# if ($count{$e} == 2 ) {
if ($count{$e} >= 2 ) {
$count2{$e}++;
}
}
for $n ( 0 .. $#b ) {
next if $count2{$b[$n]}; # 如果重复的话就放弃
$t{idmax}++;
push @diff, $b[$n];
$t{enq1_ids}{$b[$n]} = $t{idmax};
}
# @diff = sort {$a<=>$b} @diff;
# @diff = sort @diff;
} else { # 空表格的情况
@union = @diff = @b;
$t{idmax} = 0;
for $n ( 0 .. $#b ) {
$t{idmax}++;
$t{enq1_ids}{$b[$n]} = $t{idmax};
}
}
# 把新增加的零件插入DB中
if ( $#diff >= 0 ) {
for $n ( 0 .. $#diff ) {
$t{c1} = $diff[$n];
$t{n1} = $t{enq1_names}{$t{c1}};
$t{u1} = $t{enq1_units}{$t{c1}};
($t{c1},$t{ctmp}) = split(/===/,$t{c1}); # 这个操作把code和DWG分开
$t{sql} = "INSERT INTO $t{ptable} (name,code,dwg_id,Nuid,weight,price1,price2) ";
$t{sql} .= 'VALUES("' . $t{n1} . '","';
$t{sql} .= $t{c1} . '","';
$t{sql} .= $t{DWG0_id} . '","';
$t{sql} .= $t{u1} . '","1","0=100=1=0000-00-00=1","0=100=1=0000-00-00=1=1")';
$t{DO} = $self->dbh->do("$t{sql}");
}
}
# 把enq1的QTY等输入到对应的位置上(注意多主机的处理)
# 从零件表中抽出id放入enq1中
$t{cs} = '';
for $n ( 0 .. $t{length1} ) {
$t{c1} = $t{codes}[$n];
$t{cs} .= '_' . $t{c1};
}
$t{sth} = $self->dbh->prepare("SELECT id,code,dwg_id FROM $t{ptable}");
$t{sth}->execute;
while ( @rec = $t{sth}->fetchrow_array ) {
# 注意!除了code以外,DWG图纸号也要一致!
# if ( $t{cs} =~ /$rec[1]/ && $rec[2] == $t{DWG0_id} ) {
if ( $rec[2] == $t{DWG0_id} ) {
for $n ( 0 .. $t{length1} ) {
$t{c1} = $t{codes}[$n];
$t{q1} = $t{qtys}[$n];
if ( $t{c1} eq $rec[1] && !($t{oldlist}{$rec[1]}) ) {
$t{oldlist}{$rec[1]} = $rec[0];
$t{db_psid}{$rec[1]} = $rec[0];
}
}
}
}
$t{sth}->finish;
# 08/05/30: $t{pids}的顺序时取DB的ID时的顺序,必须恢复原来的顺序!
@{ $t{pids} } = ();
@{ $t{qs} } = ();
for $n ( 0 .. $t{length1} ) {
$t{c1} = $t{codes}[$n];
$t{id} = $t{db_psid}{$t{c1}},
$t{q1} = $t{qtys}[$n];
push(@{ $t{pids} },$t{id});
push(@{ $t{qs} },$t{q1});
}
$t{partsid1} = join("=",@{ $t{pids} });
$t{QTY1} = join("=",@{ $t{qs} });
# 取出现有的partsid/QTY
($t{partsid},$t{QTY}) = $self->dbh->selectrow_array("SELECT partsid,QTY FROM enq1 WHERE id = $t{enq1_id}");
@{ $t{partsids} } = split(/==/,$t{partsid});
@{ $t{partsidnews} } = ();
@{ $t{QTYs} } = split(/==/,$t{QTY});
@{ $t{QTYnews} } = ();
for $n ( 0 .. $#{ $t{partsids} } ) {
$t{NO} = $n + 1;
if ( $t{NO} == $t{NE1} ) { # 相同主机的情况
# 注意把老的也留下,C代表还没有输入一个零件
if ( $t{partsids}[$n] ne 'C' ) {
$t{partsid1} = $t{partsids}[$n] . '=' . $t{partsid1};
$t{QTY1} = $t{QTYs}[$n] . '=' . $t{QTY1};
# 相同项合并
@{ $t{ps} } = split(/=/,$t{partsid1});
@{ $t{qs} } = split(/=/,$t{QTY1});
%seen = ();
@{ $t{pss} } = ();
@{ $t{qss} } = ();
foreach $n1 ( 0 .. $#{ $t{ps} }) {
$t{ps1} = $t{ps}[$n1];
$t{qs1} = $t{qs}[$n1];
unless ( $seen{$t{ps1}} ) {
$seen{$t{ps1}} = 1;
push(@{ $t{pss} },$t{ps1});
push(@{ $t{qss} },$t{qs1});
}
}
$t{partsid1} = join("=",@{ $t{pss} });
$t{QTY1} = join("=",@{ $t{qss} });
}
push(@{ $t{partsidnews} }, $t{partsid1});
push(@{ $t{QTYnews} }, $t{QTY1});
} else { # 不同主机的情况
push(@{ $t{partsidnews} }, $t{partsids}[$n]);
push(@{ $t{QTYnews} }, $t{QTYs}[$n]);
}
}
$t{partsid1} = join("==",@{ $t{partsidnews} });
$t{sql} = 'UPDATE enq1 SET partsid = "';
$t{sql} .= $t{partsid1} . '" WHERE id = ' . $t{enq1_id};
$t{DO} = $self->dbh->do($t{sql});
$t{QTY1} = join("==",@{ $t{QTYnews} });
$t{sql} = 'UPDATE enq1 SET QTY = "';
$t{sql} .= $t{QTY1} . '" WHERE id = ' . $t{enq1_id};
$t{DO} = $self->dbh->do($t{sql});

--------------------------------------------------------------------------------
返回
修改部分设定参数程序
返回
--------------------------------------------------------------------------------
# 复制软件时,修改部分设定参数的程序
use strict;
use File::Copy;
my($aref);
# 处理mscenq2.pl
$$aref{inputfile} = 'mscenq2.pl';
($aref) = change_words($aref);
# 处理mscquo2.pl
$$aref{inputfile} = 'mscquo2.pl';
($aref) = change_words($aref);
# 处理order1.pl
$$aref{inputfile} = 'mscorder1.pl';
($aref) = change_words($aref);
# 处理order2.pl
$$aref{inputfile} = 'mscorder2.pl';
($aref) = change_words($aref);
# 处理packing.pl
$$aref{inputfile} = 'mscpacking.pl';
($aref) = change_words($aref);
# 处理inv1.pl
$$aref{inputfile} = 'mscinv1.pl';
($aref) = change_words($aref);
# 处理inv2.pl
$$aref{inputfile} = 'mscinv2.pl';
($aref) = change_words($aref);
sub change_words {
my($aref) = @_;
my(%t);
print "inputfile==>$$aref{inputfile}\n";
$t{oldfile} = $$aref{inputfile} . '.tmp.pl';
copy("./pro/$$aref{inputfile}","./pro/$t{oldfile}") or die "Copy failed:$!";
open(IN,"./pro/$t{oldfile}") or die "Can't open the file $t{oldfile}.\n";
open(OUT,">./pro/$$aref{inputfile}");
while(<IN>){
if ( $_ =~ /Open\(\"C/ ) {
$_ =~ s/Open\(\"C/Open\(\"E/;
print $_;
print OUT $_;
} elsif ( $_ =~ /SaveAs\(\"C/ ) {
$_ =~ s/SaveAs\(\"C/SaveAs\(\"E/;
print $_;
print OUT $_;
} else {
print OUT $_;
}
}
close(IN);
close(OUT);
return($aref);
}
# 处理msc.pm
copy("msc.pm","msc1.pm") or die "Copy failed:$!";
open(IN,"msc1.pm") or die "Can't open the file msc1.pm.\n";
open(OUT,">msc.pm");
while(<IN>){
if ( $_ =~ /localhost/ ) {
$_ =~ s/localhost/SERVER\.msc\.local/;
$_ =~ s/cookbook/msc/;
$_ =~ s/cbuser/cb2user/;
$_ =~ s/cbpass/cb2pass/;
print OUT $_;
} else {
print OUT $_;
}
}
close(IN);
close(OUT);

--------------------------------------------------------------------------------
返回
操作数据库一个零件表的程序
返回
--------------------------------------------------------------------------------
make_ptable1.pl
use strict;
use DBI;
my(%t,$n,@fld,@rec);
# 输入主机序号,形成零件表名
print "Please input parts table name(Enginee.NO)=";
chop($t{input}=<STDIN>);
$t{inputf} = sprintf("%06d",$t{input});
$t{table1} = 'a' . $t{inputf};
# 连接数据库
$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{table1} . ';';
$t{dbh}->do($t{sql});
# 创建一个零件表
$t{sql} = 'CREATE TABLE ' . $t{table1};
$t{sql} .= ' (';
$t{sql} .= 'id INT AUTO_INCREMENT,';
$t{sql} .= 'name TEXT,';
$t{sql} .= 'code TEXT,';
$t{sql} .= 'dwg_id INT,';
$t{sql} .= 'Nuid INT,';
$t{sql} .= 'weight INT,';
$t{sql} .= 'price1 TEXT,';
$t{sql} .= 'price2 TEXT,';
$t{sql} .= 'memo TEXT,';
$t{sql} .= 'PRIMARY KEY (id));';
$t{dbh}->do($t{sql});
$t{sth} = $t{dbh}->prepare ("SHOW columns FROM $t{table1}");
$t{sth}->execute;
while ( @rec = $t{sth}->fetchrow_array )
{
print "@rec\n";
}
$t{sth}->finish;
# 输入enq1序号
print "Please input ID of enq1=";
chop($t{enqid}=<STDIN>);
$t{sql} = 'UPDATE enq1 SET partsid = "C" WHERE id = "';
$t{sql} .= $t{enqid} . '"';
$t{dbh}->do($t{sql});
$t{sql} = 'UPDATE enq1 SET QTY = "C" WHERE id = "';
$t{sql} .= $t{enqid} . '"';
$t{dbh}->do($t{sql});
$t{dbh}->disconnect;
__END__;

--------------------------------------------------------------------------------
返回
操作数据库零件表的四个程序
返回
--------------------------------------------------------------------------------
修改所有零件表的部分数据(change_ptables.pl)
use strict;
use DBI;
my(%t,$n,@fld,$pref,@rec);
# 连接数据库
$$pref{dsn} = "DBI:mysql:host=localhost;database=cookbook";
$$pref{dbh} = DBI->connect($$pref{dsn}, "cbuser", "cbpass") or die "Cannot connect to server\n";
$$pref{dbh}->do("SET NAMES utf8");
if(!$$pref{dbh}){
print "SQL read ERROR!\n";
exit;
}
# 取出main_type1的编号,同时生成零件表名
@{ $t{ptables} } = ();
$t{sth} = $$pref{dbh}->prepare("SELECT id FROM main_type1");
$t{sth}->execute;
while ( @rec = $t{sth}->fetchrow_array ) {
$t{ptable1} = sprintf("%06d",$rec[0]);
$t{ptable1} = 'a' . $t{ptable1};
push(@{ $t{ptables} },$t{ptable1});
}
$t{sth}->finish;
# 修改数据
for $n ( 0 .. $#{ $t{ptables} } ) {
$t{ptable1} = $t{ptables}[$n];
$t{sql} = 'UPDATE ' . $t{ptable1};
$t{sql} .= ' SET price1 = "NULL"';
print "sql=$t{sql}\n";
$$pref{dbh}->do($t{sql});
$t{sql} = 'UPDATE ' . $t{ptable1};
$t{sql} .= ' SET price2 = "NULL"';
print "sql=$t{sql}\n";
$$pref{dbh}->do($t{sql});
}
# 关闭数据库
$$pref{dbh}->disconnect;
取出已有的数据库零件表数据并写入中间文件(obtain_ptables.pl)
use strict;
use DBI;
my(%t,$n,@fld,@rec,$pref);
# 连接数据库
$$pref{dsn} = "DBI:mysql:host=localhost;database=cookbook";
$$pref{dbh} = DBI->connect($$pref{dsn}, "cbuser", "cbpass") or die "Cannot connect to server\n";
$$pref{dbh}->do("SET NAMES utf8");
if(!$$pref{dbh}){
print "SQL read ERROR!\n";
exit;
}
# 取出所有表格名
@{ $t{tables} } = $$pref{dbh}->tables;
$t{all_tables} = join(' ',@{ $t{tables} });
# 取出main_type1的编号,同时生成零件表名
@{ $t{ptables} } = ();
$t{sth} = $$pref{dbh}->prepare("SELECT id FROM main_type1");
$t{sth}->execute;
while ( @rec = $t{sth}->fetchrow_array ) {
$t{ptable1} = sprintf("%06d",$rec[0]);
$t{ptable1} = 'a' . $t{ptable1};
next unless $t{all_tables} =~ /$t{ptable1}/;
push(@{ $t{ptables} },$t{ptable1});
}
$t{sth}->finish;
# 取出所有现有零件表的数据
for $n ( 0 .. $#{ $t{ptables} } ) {
$$pref{ptable1} = $t{ptables}[$n];
($pref) = read_ptable($pref);
}
# 关闭数据库
$$pref{dbh}->disconnect;
# 写入中间文件(../txt/ptables.txt)
open(OUT,">../txt/ptables.txt");
print OUT 'filename=ptables.txt',"\n";
print OUT 'C===file===id===name===code===dwg_id===Nuid===weight===price1===price2===memo',"\n";
for $n ( 0 .. $#{ $t{ptables} } ) {
$$pref{ptable1} = $t{ptables}[$n];
($pref) = write_ptable($pref);
}
close(OUT);
print "Finished.\n";
sub write_ptable {
my($pref) = @_;
my (%t,$n);

for $n ( 0 .. $#{ $$pref{id}{$$pref{ptable1}} } ) {
$t{id} = $$pref{id}{$$pref{ptable1}}[$n];
$t{name} = $$pref{name}{$$pref{ptable1}}[$n];
# $t{name} =~ s/\x0D\x0A//g;
# $t{name} =~ s/\x0D$//; # 改行符号去掉(如果有的话)
$t[code] = $$pref[code]{$$pref{ptable1}}[$n];
# $t[code] =~ s/\x0D$//; # 改行符号去掉(如果有的话)
$t{dwg_id} = $$pref{dwg_id}{$$pref{ptable1}}[$n];
$t{Nuid} = $$pref{Nuid}{$$pref{ptable1}}[$n];
print OUT 'PT===',$$pref{ptable1};
print OUT '===',$t{id};
print OUT '===',$t{name};
print OUT '===',$t[code];
print OUT '===',$t{dwg_id};
print OUT '===',$t{Nuid};
print OUT "\n";
}
return($pref);
}
sub read_ptable {
my($pref) = @_;
my (%t,@rec);
# 读零件表
$t{sth} = $$pref{dbh}->prepare("SELECT id,name,code,dwg_id,Nuid FROM $$pref{ptable1}");
$t{sth}->execute;
while ( @rec = $t{sth}->fetchrow_array ) {
push(@{ $$pref{id}{$$pref{ptable1}} },$rec[0]);
push(@{ $$pref{name}{$$pref{ptable1}} },$rec[1]);
push(@{ $$pref[code]{$$pref{ptable1}} },$rec[2]);
push(@{ $$pref{dwg_id}{$$pref{ptable1}} },$rec[3]);
push(@{ $$pref{Nuid}{$$pref{ptable1}} },$rec[4]);
}
$t{sth}->finish;
return($pref);
}
__END__;
# 这个操作把不含Nuid的零件表删除(作业中程序,保存下来)
$t{sth} = $$pref{dbh}->prepare("SHOW COLUMNS FROM $$pref{ptable1}");
$t{sth}->execute;
$t{column_list} = '';
while ( @rec = $t{sth}->fetchrow_array ) {
$t{column_list} .= ' ' . $rec[0];
}
$t{sth}->finish;
if ( $t{column_list} !~ /Nuid/ ) {
$t{sql} = 'DROP TABLE IF EXISTS ' . $$pref{ptable1} . ';';
$$pref{dbh}->do($t{sql});
}
生成数据库零件表(make_ptables.pl)
use strict;
use DBI;
my(%t,$n,@fld,$pref,@rec);
# 连接数据库
$$pref{dsn} = "DBI:mysql:host=localhost;database=cookbook";
$$pref{dbh} = DBI->connect($$pref{dsn}, "cbuser", "cbpass") or die "Cannot connect to server\n";
$$pref{dbh}->do("SET NAMES utf8");
if(!$$pref{dbh}){
print "SQL read ERROR!\n";
exit;
}
# 取出main_type1的编号,同时生成零件表名
@{ $t{ptables} } = ();
$t{sth} = $$pref{dbh}->prepare("SELECT id FROM main_type1");
$t{sth}->execute;
while ( @rec = $t{sth}->fetchrow_array ) {
$t{ptable1} = sprintf("%06d",$rec[0]);
$t{ptable1} = 'a' . $t{ptable1};
push(@{ $t{ptables} },$t{ptable1});
}
$t{sth}->finish;
# 生成零件表
for $n ( 0 .. $#{ $t{ptables} } ) {
$$pref{ptable1} = $t{ptables}[$n];
($pref) = ptable1($pref);
}
# 关闭数据库
$$pref{dbh}->disconnect;
print "Finished.\n";
sub ptable1 {
my($pref) = @_;
my(%t);

$t{sql} = 'DROP TABLE IF EXISTS ' . $$pref{ptable1} . ';';
$$pref{dbh}->do($t{sql});
$t{sql} = 'CREATE TABLE ' . $$pref{ptable1};
$t{sql} .= ' (';
$t{sql} .= 'id INT AUTO_INCREMENT,';
$t{sql} .= 'name TEXT,';
$t{sql} .= 'code TEXT,';
$t{sql} .= 'dwg_id INT,';
$t{sql} .= 'Nuid INT,';
$t{sql} .= 'weight INT,';
$t{sql} .= 'price1 TEXT,';
$t{sql} .= 'price2 TEXT,';
$t{sql} .= 'memo TEXT,';
$t{sql} .= 'PRIMARY KEY (id));';
$$pref{dbh}->do($t{sql});

return($pref);
}
__END__;
零件表插入已有的数据(input_ptables.pl)
use strict;
use DBI;
my(%t,$n,@fld,$pref,@rec);
print "This is input_ptables.pl.\n";
# 连接数据库
$$pref{dsn} = "DBI:mysql:host=localhost;database=cookbook";
$$pref{dbh} = DBI->connect($$pref{dsn}, "cbuser", "cbpass") or die "Cannot connect to server\n";
$$pref{dbh}->do("SET NAMES utf8");
if(!$$pref{dbh}){
print "SQL read ERROR!\n";
exit;
}
# 取出main_type1的编号,同时生成零件表名
@{ $t{ptables} } = ();
$t{sth} = $$pref{dbh}->prepare("SELECT id FROM main_type1");
$t{sth}->execute;
while ( @rec = $t{sth}->fetchrow_array ) {
$t{ptable1} = sprintf("%06d",$rec[0]);
$t{ptable1} = 'a' . $t{ptable1};
push(@{ $t{ptables} },$t{ptable1});
}
$t{sth}->finish;
# 从../txt/ptables.txt读取原有零件表数据
open(IN,"../txt/ptables.txt") or die "Can't open the file ptables.txt\n";
while(<IN>){
if (/^PT/){
chop;
@fld = split(/===/);
push(@{ $$pref{id}{$fld[1]} },$fld[2]);
push(@{ $$pref{name}{$fld[1]} },$fld[3]);
push(@{ $$pref[code]{$fld[1]} },$fld[4]);
push(@{ $$pref{dwg_id}{$fld[1]} },$fld[5]);
push(@{ $$pref{Nuid}{$fld[1]} },$fld[6]);
}
}
close(IN);
# 插入数据
for $n ( 0 .. $#{ $t{ptables} } ) {
$$pref{ptable1} = $t{ptables}[$n];
($pref) = input_ptable1($pref);
}
# 关闭数据库
$$pref{dbh}->disconnect;
print "Finished.\n";
sub input_ptable1 {
my($pref) = @_;
my(%t,$n);

if ( $$pref{id}{$$pref{ptable1}}[0] == 0 ) {
return($pref);
}
for $n ( 0 .. $#{ $$pref{id}{$$pref{ptable1}} } ) {
$t{id} = $n + 1;
$t{name} = $$pref{name}{$$pref{ptable1}}[$n];
$t[code] = $$pref[code]{$$pref{ptable1}}[$n];
$t{dwg_id} = $$pref{dwg_id}{$$pref{ptable1}}[$n];
$t{Nuid} = $$pref{Nuid}{$$pref{ptable1}}[$n];
$t{sql} = 'INSERT INTO ' . $$pref{ptable1};
$t{sql} .= ' (name,code,dwg_id,Nuid,weight,price1,price2) ';
# if ( $t{dwg_id} == 0 ) {
# $t{dwg_id} = 1;
# }
# if ( $t{Nuid} == 0 ) {
# $t{Nuid} = 1;
# }
$t{sql} .= 'VALUES("';
$t{sql} .= $t{name} . '","';
$t{sql} .= $t[code] . '","';
$t{sql} .= $t{dwg_id} . '","';
$t{sql} .= $t{Nuid} . '",1,"0=100=1=0000-00-00=1","0=100=1=0000-00-00=1=1");';
$$pref{dbh}->do($t{sql});
}

return($pref);
}
__END__;
零件表的columns的变动
mysql> show columns from a000001;
+----------+---------+------+-----+---------+----------------+
| Field | Type | Null | Key | Default | Extra |
+----------+---------+------+-----+---------+----------------+
| id | int(11) | NO | PRI | NULL | auto_increment |
| name | text | YES | | NULL | |
| code | text | YES | | NULL | |
| dwg_id | int(11) | YES | | NULL | |
| Nuid | int(11) | YES | | NULL | |
| weight | int(11) | YES | | NULL | |
| price1 | int(11) | YES | | NULL | |
| time1 | date | YES | | NULL | |
| money1 | int(11) | YES | | NULL | |
| makerid | int(11) | YES | | NULL | |
| price2 | text | YES | | NULL | |
| time2 | text | YES | | NULL | |
| money2 | text | YES | | NULL | |
| makerid2 | text | YES | | NULL | |
| memo | text | YES | | NULL | |
+----------+---------+------+-----+---------+----------------+
15 rows in set (0.28 sec)
mysql> show columns from a000001;
+--------+---------+------+-----+---------+----------------+
| Field | Type | Null | Key | Default | Extra |
+--------+---------+------+-----+---------+----------------+
| id | int(11) | NO | PRI | NULL | auto_increment |
| name | text | YES | | NULL | |
| code | text | YES | | NULL | |
| dwg_id | int(11) | YES | | NULL | |
| Nuid | int(11) | YES | | NULL | |
| weight | int(11) | YES | | NULL | |
| price1 | text | YES | | NULL | |
| price2 | text | YES | | NULL | |
| memo | text | YES | | NULL | |
+--------+---------+------+-----+---------+----------------+
9 rows in set (0.03 sec)
*************************** 10. row ***************************
id: 10
name: p1name
code: p1code
dwg_id: 1
Nuid: 1
weight: 1
price1: 0=100=1=0000-00-00=1
price2: 0=100=1=0000-00-00=1=1
memo: NULL
price1的定义:
0==>价格
100==>Discount
1==>货币单位
0000-00-00=>日期
1==>商社
price2的定义:
0==>价格
100==>Discount
1==>货币单位
0000-00-00=>日期
1==>船东
1==>对应的商社价格(从后面数)

--------------------------------------------------------------------------------
返回
Perl的散列(hash)
返回
--------------------------------------------------------------------------------
修改零件的数量
use strict;
my(%t,$n,$n1,$n2);
$t{type1id} = '245==332';
$t{partsid} = '3=2=4==2=8';
$t{QTY} = '30=20=40==20=80';
$t{type1id2} = '245==332';
$t{partsid2} = '4==2=8';
$t{QTY2} = '40==20=80';
@{ $t{QTYnew} } = qw/300 200 400 200 800/;
@{ $t{ttt1} } = split(/==/,$t{type1id});
@{ $t{ppp1} } = split(/==/,$t{partsid});

$t{NO}=0;
@{ $t{qqq3} } = ();
for $n ( 0 .. $#{ $t{ttt1} } ) {
$t{ttt2} = $t{ttt1}[$n];
$t{ppp2} = $t{ppp1}[$n];
@{ $t{ppp3} } = split(/=/,$t{ppp2});
@{ $t{qqq1} } = ();
for $n1 ( 0 .. $#{ $t{ppp3} } ) {
$t{NO}++;
$t{ppp4} = $t{ppp3}[$n1];
$t{tp_qty}{$t{ttt2}}{$t{ppp4}} = $t{QTYnew}[$t{NO}-1];
push(@{ $t{qqq1} },$t{QTYnew}[$t{NO}-1]);
}
$t{qqq2} = join('=',@{ $t{qqq1} });
push(@{ $t{qqq3} },$t{qqq2});
}
$t{qqq4} = join('==',@{ $t{qqq3} });
print "enq1 result:\n";
print "old==>$t{QTY}\n";
print "new==>$t{qqq4}\n\n";
@{ $t{ttt1} } = split(/==/,$t{type1id2});
@{ $t{ppp1} } = split(/==/,$t{partsid2});

$t{NO}=0;
@{ $t{qqq3} } = ();
for $n ( 0 .. $#{ $t{ttt1} } ) {
$t{ttt2} = $t{ttt1}[$n];
$t{ppp2} = $t{ppp1}[$n];
@{ $t{ppp3} } = split(/=/,$t{ppp2});
@{ $t{qqq1} } = ();
for $n1 ( 0 .. $#{ $t{ppp3} } ) {
$t{NO}++;
$t{ppp4} = $t{ppp3}[$n1];
push(@{ $t{qqq1} },$t{tp_qty}{$t{ttt2}}{$t{ppp4}});
}
$t{qqq2} = join('=',@{ $t{qqq1} });
push(@{ $t{qqq3} },$t{qqq2});
}
$t{qqq4} = join('==',@{ $t{qqq3} });
print "enq2 result:\n";
print "old==>$t{QTY2}\n";
print "new==>$t{qqq4}\n\n";
enq1 result:
old==>30=20=40==20=80
new==>300=200=400==200=800
enq2 result:
old==>40==20=80
new==>400==200=800
# 必须置零,因为下一台主机的DWG极有可能同名!
@{ $t{plist}{id}{$t{dwg1}} } = ();
@{ $t{plist}{name}{$t{dwg1}} } = ();
@{ $t{plist}[code]{$t{dwg1}} } = ();
@{ $t{plist}{QTY}{$t{dwg1}} } = ();
@{ $t{plist}{Nuid}{$t{dwg1}} } = ();
把复数的enq2价格归并到一个enq1
$t{enq2s} = $self->dbh->selectrow_array("SELECT enq2s FROM enq1 WHERE id = $t{quo2_id}");
@{ $t{enq2_ids} } = split(/=/,$t{enq2s});
for $n ( 0 .. $#{ $t{enq2_ids} } ) {
$t{enq2_id} = $t{enq2_ids}[$n];
($t{type1id},$t{partsid},$t{price}) = $self->dbh->selectrow_array("SELECT type1id,partsid,price FROM enq2 WHERE id = $t{enq2_id}");
@{ $t{tts} } = split(/==/,$t{type1id});
@{ $t{pps} } = split(/==/,$t{partsid});
@{ $t{pps2} } = split(/=/,$t{price});
$t{NO} = 0;
for $n1 ( 0 .. $#{ $t{tts} } ) {
$t{tts1} = $t{tts}[$n1];
$t{pps1} = $t{pps}[$n1];
@{ $t{pps1s} } = split(/=/,$t{pps1});
for $n2 ( 0 .. $#{ $t{pps1s} } ) {
$t{NO}++;
$t{pps1s1} = $t{pps1s}[$n2];
$t{list}{$t{tts1}}{$t{pps1s1}} = $t{pps2}[$t{NO}-1];
}
}
}
# enq1
@{ $t{prices} } = ();
($t{type1id},$t{partsid}) = $self->dbh->selectrow_array("SELECT type1id,partsid FROM enq1 WHERE id = $t{quo2_id}");
@{ $t{tts} } = split(/==/,$t{type1id});
@{ $t{pps} } = split(/==/,$t{partsid});
for $n1 ( 0 .. $#{ $t{tts} } ) {
$t{tts1} = $t{tts}[$n1];
$t{pps1} = $t{pps}[$n1];
@{ $t{pps1s} } = split(/=/,$t{pps1});
for $n2 ( 0 .. $#{ $t{pps1s} } ) {
$t{pps1s1} = $t{pps1s}[$n2];
push(@{ $t{prices} },$t{list}{$t{tts1}}{$t{pps1s1}});
}
}
$t{price0} = join("=",@{ $t{prices} });
#$t{price0} = $t{list}{"154"}{"2"};
$t{sql} = 'UPDATE quo2 set price0 = "';
$t{sql} .= $t{price0} . '" where id = ';
$t{sql} .= $t{quo2_id};
$t{DO} = $self->dbh->do($t{sql});
通过enq2->quo1找出原价
$t{sth} = $self->dbh->prepare("select id, enq1id from enq2");
$t{sth}->execute;
while (@rec = $t{sth}->fetchrow_array) {
if ( $rec[1] == $$pref{id} ) {
$t{NO} = 0;
$t{enq2_id} = $rec[0];
# 取出价格
$t{pri} = $self->dbh->selectrow_array("SELECT price FROM quo1 WHERE id = $t{enq2_id}");
@{ $t{pris} } = split(/=/,$t{pri});
($t{tt1},$t{pp1}) = $self->dbh->selectrow_array("SELECT type1id,partsid FROM enq2 WHERE id = $t{enq2_id}");
@{ $t{tt2} } = split(/==/,$t{tt1});
@{ $t{pp2} } = split(/==/,$t{pp1});
for $n ( 0 .. $#{ $t{tt2} } ) {
$t{tt3} = $t{tt2}[$n];
$t{pp3} = $t{pp2}[$n];
@{ $t{pp4} } = split(/=/,$t{pp3});
for $n1 (0 .. $#{ $t{pp4} } ) {
$t{NO}++;
$t{list}{$t{tt3}}{$t{pp4}[$n1]} = $t{pris}[$t{NO}-1];
}
}
}
}
$t{sth}->finish;
＞＝误写成＝＝的BUG(弄了一天才发现)
foreach $e (@a,@b) { $count{$e}++ };
#@union = sort {$a<=>$b} keys %count;
@union = sort keys %count;
foreach $e ( keys %count ) {
# if ($count{$e} == 2 ) { # 正好两个的情况(不对),这个==不对
if ($count{$e} >= 2 ) { # 应该是>=
$count2{$e}++;
}
}
for $n ( 0 .. $#b ) {
next if $count2{$b[$n]};
$t{idmax}++;
push @diff, $b[$n];
$t{enq1_ids}{$b[$n]} = $t{idmax};
}
删除重复的项目并排序
use strict;
my(%t,$n,@fld);
# 读取main_maker1_order2.txt文件
open(IN,"main_maker1_order2.txt") or die "Can't open the file main_maker1_order2.txt.\n";
while(<IN>){
next if $. == 1;
chop;
@fld = split(/==>/);
$t{list}{$fld[1]}++;
}
close(IN);
# 读取makers_tmp2.txt文件
open(IN,"makers_tmp2.txt") or die "Can't open the file makers_tmp2.txt.\n";
while(<IN>){
chop;
$t{list}{$_}++;
}
close(IN);
# 排序操作
@{ $t{orders} } = sort keys %{ $t{list} };
open(OUT,">makers.txt");
print OUT 'Filename=makers.txt',"\n";
$t{NO} = 0;
for $n ( 0 .. $#{ $t{orders} } ) {
$t{NO}++;
$t{N1} = sprintf("%05d",$t{NO});
$t{line} = $t{N1} . '==>' . $t{orders}[$n];
print OUT $t{line},"\n";
}
close(OUT);
__END__
###################################################################
# 把所有的小写字母改成大写字母并排序
open(IN,"makers_tmp.txt") or die "Can't open the file makers_tmp.txt.\n";
while(<IN>){
chop;
$t{line} = uc($_);
$t{list}{$t{line}}++; # 删除相同的项目
}
close(IN);
# 排序操作
@{ $t{orders} } = sort keys %{ $t{list} };
open(OUT,">makers_tmp2.txt");
for $n ( 0 .. $#{ $t{orders} } ) {
print OUT $t{orders}[$n],"\n";
}
close(OUT);
###################################################################
数据库操作的一个程序,不用了。留作存档
# 从enq1取出主机编号(type1id),零件号码(partsid),数量(QTY)
($t{type1id},$t{partsid},$t{QTY}) = $self->dbh->selectrow_array("SELECT type1id,partsid,QTY FROM enq1 WHERE id = $t{enq1_id}");
@loop1 = ();
$t{NO} = 0;
@{ $t{type1id_list} } = split(/==/,$t{type1id});
@{ $t{partsid_list} } = split(/==/,$t{partsid});
@{ $t{QTY_list} } = split(/==/,$t{QTY});
# Table的一行是一个项目
for $n ( 0 .. $#{ $t{type1id_list} } ) {
$t{type1id1} = $t{type1id_list}[$n];
$t{partsid1} = $t{partsid_list}[$n];
$t{QTY1} = $t{QTY_list}[$n];
# 从main_type1中取出主机名和DWG图号
($t{id1},$t{type1},$t{DWG}) = $self->dbh->selectrow_array("select id, name,DWG from main_type1 where id = $t{type1id1}");
# 从零件名表中取出零件编号和图纸号
@{ $t{pid_list} } = split(/=/,$t{partsid1});
@{ $t{Q_list} } = split(/=/,$t{QTY1});
@{ $t{DWGs} } = split(/=/,$t{DWG});
# 生成零件表名,根据enq1的零件编号从数据库取出零件信息和所属图纸号
$t{ptable} = sprintf("%06d",$t{type1id1});
$t{ptable} = 'a' . $t{ptable};
@{ $t{dwgs1} } = ();
for $n1 ( 0 .. $#{ $t{pid_list} } ) {
$t{pid1} = $t{pid_list}[$n1];
$t{Q1} = $t{Q_list}[$n1];
@{ $t{p1} } = $self->dbh->selectrow_array("select * from $t{ptable} where id = $t{pid1}");
$t{dwg1} = $t{p1}[4];
push(@{ $t{plist}{id}{$t{dwg1}} },$t{p1}[0]);
push(@{ $t{plist}{name}{$t{dwg1}} },$t{p1}[1]);
push(@{ $t{plist}[code]{$t{dwg1}} },$t{p1}[2]);
push(@{ $t{dwgs1} },$t{dwg1});
}
# 合并重复的图纸号==>这个操作充分利用了Perl散列的特性
%seen = ();
@{ $t{dwgs2} } = ();
foreach $item (@{ $t{dwgs1} }) {
unless ( $seen{$item} ) {
$seen{$item} = 1;
push(@{ $t{dwgs2} },$item);
}
}
# 第一层:主机名
# 第二层:图纸号(XXXDWG设定为不知道图纸号)
# 第三层:零件名
# 把数据放入HTML的TABLE的TR
for $n1 ( 0 .. $#{ $t{dwgs2} } ) {
$t{dwg1} = $t{dwgs2}[$n1];
$t{DWG1} = $t{DWGs}[$t{dwg1}-1];
# 取出图纸号
$t{line1} = '<tr bgcolor="#FFF000" align="center"><td colspan=7>';
$t{line1} .= $t{id1} . '==>' . $t{DWG1};
$t{line1} .= '</td></tr>';
my %row = (
line1 => $t{line1}
);
push(@loop1, \%row);
# 处理零件
for $n2 ( 0 .. $#{ $t{plist}{id}{$t{dwg1}} } ) {
$t{NO}++; # enq1的所有Parts的编号
$t{pid1} = $t{plist}{id}{$t{dwg1}}[$n2];
$t{name1} = $t{plist}{name}{$t{dwg1}}[$n2];
$t{code1} = $t{plist}[code]{$t{dwg1}}[$n2];
$t{line1} = '<tr bgcolor="#F0FFF0" align="center"><td>';
$t{line1} .= $t{NO} . '</td><td>';
$t{line1} .= $t{name1} . '</td><td>';
$t{line1} .= $t{code1} . '</td><td>';
$t{line1} .= $t{code1} . '</td><td>';
$t{line1} .= $t{code1} . '</td><td>';
$t{line1} .= $t{code1} . '</td><td>';
$t{line1} .= $t{code1};
$t{line1} .= '</td></tr>';
my %row = (
line1 => $t{line1}
);
push(@loop1, \%row);
}

# 必须置零,因为下一台主机的DWG极有可能同名!
$t{plist}{id}{$t{dwg1}} = ();
$t{plist}{name}{$t{dwg1}} = ();
$t{plist}[code]{$t{dwg1}} = ();
}
}

--------------------------------------------------------------------------------
返回
Perl的数组(array)
返回
--------------------------------------------------------------------------------
文件改名
use strict;
my(%t,@fld,$n);
open(IN,"tmp1.txt") or die "Can't open the file tmp1.txt";
while(<IN>){
if (/^site/) {
@fld = split;
push(@{ $t{list} },$fld[0]);
}
}
close(IN);
for $n ( 0 .. $#{ $t{list} } ) {
$t{NO} = $n + 1;
$t{NO} = sprintf("%02d",$t{NO});
$t{filem} = 'sitem' . $t{NO} . '.htm';
$t{filenew} = 'site' . $t{NO} . '.htm';
system("rename $t{filem} $t{filenew}");
print "$t{filem}==>$t{filenew}\n";
}
exit;
for $n ( 0 .. $#{ $t{list} } ) {
$t{file1} = $t{list}[$n];
$t{NO} = $n + 1;
$t{NO} = sprintf("%02d",$t{NO});
$t{filem} = 'sitem' . $t{NO} . '.htm';
$t{filenew} = 'site' . $t{NO} . '.htm';
print "$t{file1}==>$t{filem}\n";
system("rename $t{file1} $t{filem}");
}
print "\n";

把一个目录下的所有jpg文件改名
my(%t,@list,$n);
@list = glob("*.jpg");
for $n ( 0 .. $#list ) {
$t{old_file} = $list[$n];
$t{e1} = sprintf("%02d",$n);
$t{new_file} = 'e' . $t{e1} . '.jpg';
system("rename $t{old_file} $t{new_file}");
print "$t{new_file}<==$t{old_file}\n";
}

把一个数组中的相同项目合并
use strict;
my(@list,%seen,@uniq,$item);
@list = (3,3,3,2,2,4,4,4,4);
%seen = ();
@uniq = ();
print"list=@list\n";
foreach $item (@list) {
unless ( $seen{$item} ) {
$seen{$item} = 1;
push(@uniq,$item);
}
}
print"uniq=@uniq\n";
# 程序执行结果
# list=3 3 3 2 2 4 4 4 4
# uniq=3 2 4
把一行中的第一个项目放到最后
use strict;
my(%t,$n,@fld);
open(IN,"tmp3.txt") or die "Can't open the file tmp3.txt\n";
open(OUT,">tmp4.txt");
while(<IN>) {
@fld = split;
$t{e1} = '';
for $n ( 1 .. $#fld ) {
$t{e1} .= $fld[$n] . ' ';
}
print OUT $t{e1},$fld[0],"\n";
}
close(IN);
close(OUT);
分解一个二层数组(用于数据库处理)
$t{QTY} = '50=30=80=70==80';
print "QTY==>$t{QTY}\n";
@{ $t{QTY1} } = split(/==/,$t{QTY});
for $n ( 0 .. $#{ $t{QTY1} } ) {
$t{QTY2} = $t{QTY1}[$n];
print ' ',"QTY2==>$t{QTY2}\n";

@{ $t{QTY3} } = split(/=/,$t{QTY2});
for $n1 ( 0 .. $#{ $t{QTY3} } ) {
$t{QTY4} = $t{QTY3}[$n1];
print ' ',"QTY4==>$t{QTY4}\n";
}
}
__END__
输出执行结果
QTY==>50=30=80=70==80
QTY2==>50=30=80=70
QTY4==>50
QTY4==>30
QTY4==>80
QTY4==>70
QTY2==>80
QTY4==>80
数一个单子的零件数量(用于数据库处理)
$$ref{A} = '3=4==5=6==7';
print "A=>$$ref{A}\n";
($ref) = get_length($ref);
print "length=>$$ref{NO}\n";
sub get_length {
my ($ref) = @_;
my (%t,$n);
@{ $t{As} } = split(/=/,$$ref{A});
$$ref{NO} = 0;
for $n ( 0 .. $#{ $t{As} } ) {
$t{A1} = $t{As}[$n];
if ( $t{A1} != 0 ) {
$$ref{NO}++;
}
}
return ($ref);
}
结果:
A=>3=4==5=6==7
length=>5

--------------------------------------------------------------------------------
返回
利用HTML::Template模块
戻る
--------------------------------------------------------------------------------
生成互相链接的复数个HTML文件
# 通过这个程序,把几百行的数据生成HMLT表格
# multi.pl
use strict;
use HTML::Template;
my(%t,@fld,$n,$template,@loop);
print "Please input filename=";
chop($t{root}=<STDIN>);
$t{tmpl} = 'index.html';
$t{inputf} = $t{root} . '.txt';
open(IN,"names.txt") or die "Can't open the file names.txt.\n";
while(<IN>){
if ( /^NAME\s/ ) {
@fld = split;
$t{list}{$fld[1]} = $fld[2];
}
}
close(IN);
$template = HTML::Template->new(filename => $t{tmpl});
@loop = ();
$t{htmfile} = $t{root} . '.htm';
$t{flag} = 1;
open(IN,"$t{inputf}") or die "Can't open the file $t{inputf}";
while(<IN>){
next if $. == 1; # 跳过第一行
next if length($_) < 2; # 最后的空行也跳过
if ( $t{flag} == 1 ) { # 第一组数据
$t{flag} = 2;
push(@{ $t{N1s} },$_);
$t{N11} = $_;
} elsif ($t{flag} == 2) { # 第二组数据
$t{clist}{$t{N11}} = $_;
$t{flag} = 3;
} elsif ($t{flag} == 3) { # 第三组数据
$t{elist}{$t{N11}} = $_;
$t{flag} = 1;
}
}
close(IN);
# 按第一组数据排序
@{ $t{NN} } = sort {lc($a) cmp lc($b)} @{ $t{N1s} };
# 为了检查输入数据的错误,第一次运行是最好不排序
#@{ $t{NN} } = @{ $t{N1s} };
for $n ( 0 .. $#{ $t{NN} } ) {
$t{N1} = $t{NN}[$n];
$t{c1} = $t{clist}{$t{N1}};
$t{e1} = $t{elist}{$t{N1}};
$t{count}{$t{N1}}++;
if ( $t{count}{$t{N1}} > 1 ) { # 这个操作是为了防止重复
next;
}
my %row = (
N1 => $t{N1},
C1 => $t{c1},
E1 => $t{e1}
);
push(@loop, \%row);
}
$t{etitle} = uc($t{root});
$template->param(std_loop => \@loop);
$template->param(ename => $t{etitle});
$template->param(cname => $t{list}{$t{etitle}});
open(OUT,">$t{htmfile}");
print OUT $template->output;
close(OUT);
print "The output file is $t{htmfile}\n";
__END__;
filename:names.txt
NAME ANSI 美国
NAME BS 英国
NAME DIN 德国
NAME EN 欧洲
NAME GB 中国
NAME ISO ISO
NAME JIS 日本
NAME NF 法国
<table width=75% align="center" border=1 cellpadding=5>
<tr bgcolor="#3399FF" align="center"><th width=20%>编号</th><th width=40%>中文名称</th><th width=40%>英文名称</th></tr>
<TMPL_LOOP NAME="std_loop">
<tr bgcolor="lightcyan" align="left"><td><TMPL_VAR NAME="N1"></td><td><TMPL_VAR NAME="C1"></td><td><TMPL_VAR NAME="E1"></td></tr>
</TMPL_LOOP>
</table>

一气生成数百个HTML文件
# make_html.pl
use strict;
use HTML::Template;
my(%t,@fld,$n,$template,@loop,$h_ref);
print "Please input the directory name=";
chop($t{root}=<STDIN>);
$$h_ref{dir} = 'vF' . $t{root};
$t{inputf} = $t{root} . '_vF.csv';
open(IN,"./$$h_ref{dir}/$t{inputf}") or die "Can't open the file /$$h_ref{dir}/$t{inputf}.\n";
while(<IN>){
next if ( $. == 1 );
chop;
@fld = split(/,/);
next unless $fld[1];
$t{T1} = sprintf("%10.6f",$fld[0]);
push(@{ $$h_ref{Time} },$t{T1});
push(@{ $$h_ref{k_files} },$fld[1]);
push(@{ $$h_ref{Start} },$fld[2]);
}
close(IN);
$t{tmpl} = 'output0.htm';
$t{htmfile} = 'index.html';
$template = HTML::Template->new(filename => $t{tmpl});
opendir(DIR,"$$h_ref{dir}") or die "Can't opendir $$h_ref{dir}: $!";
@loop = ();
$t{N1} = 0;
for $n ( 0 .. $#{ $$h_ref{Time} } ) {
$t{N1}++;
$t{Time1} = $$h_ref{Time}[$n];
$t{file1} = $$h_ref{k_files}[$n];
$t{Start1} = $$h_ref{Start}[$n];
$t{csv1} = '<a href="' . $t{file1} . '">' . $t{file1} . '</a>';
$t{file1} =~ s/csv/xls/;
$t{xls1} = '<a href="' . $t{file1} . '">' . $t{file1} . '</a>';
$t{file1} =~ s/xls/htm/;
$t{gif1} = '<a href="' . $t{file1} . '">' . $t{file1} . '</a>';
my %row = (
N1 => $t{N1},
Time => $t{Time1},
csv => $t{csv1},
xls => $t{xls1},
gif => $t{gif1},
Start => $t{Start1}
);
push(@loop, \%row);
}
$template->param(loop => \@loop);
$template->param(dir => $$h_ref{dir});
open(OUT,">./$$h_ref{dir}/$t{htmfile}");
print OUT $template->output;
close(OUT);
# 这个循环可一气生成指定数目的HTML文件
for $n ( 0 .. $#{ $$h_ref{Time} } ) {
$$h_ref{file1} = $$h_ref{k_files}[$n];
($h_ref) = make_vhtm($h_ref);
}
close(IN1);
print "Finished.\n";
sub make_vhtm {
my($h_ref) = @_;
my(%t,$n,$template1,@loop);
$$h_ref{file1} =~ s/csv/htm/;
$t{htmfile} = $$h_ref{file1};
$template1 = HTML::Template->new(filename => "v000000.htm");
$template1->param(htm => $t{htmfile});
$$h_ref{file1} =~ s/htm/gif/;
$template1->param(gif => $$h_ref{file1});
open(OUT1,">./$$h_ref{dir}/$t{htmfile}");
print OUT1 $template1->output;
close(OUT1);
return($h_ref);
}
1;
__END__;

错误信息
$template = HTML::Template->new(filename => $$h_ref{tmpl},option => "$$h_ref{NO}");
-------------------------------------
Please input the directory name=1_2_1
The output file is ./vF1_2_1/index.html
HTML::Template->new() called with odd number of option parameters - should be of
the form option => value at make_html.pl line 78

--------------------------------------------------------------------------------
戻る
opendir
戻る
--------------------------------------------------------------------------------
input.pl(该程序的要点是使用opendir)
# input.pl
use strict;
use HTML::Template;
my(%t,@fld,$n,$template,@loop);
$t{tmpl} = 'input0.htm';
$t{htmfile} = 'index.html';
$template = HTML::Template->new(filename => $t{tmpl});
print "Please input the directory name=";
chop($t{dir}=<STDIN>);
opendir(DIR,"$t{dir}") or die "Can't opendir $t{dir}: $!";
while ( defined($t{file}=readdir(DIR)) ) {
next if $t{file} =~ /^\.\.?$/; # skip . and ..
if ( substr($t{file},-3) eq 'csv' ) {
$t{NO1} = $t{file};
substr($t{NO1},-4) = '';
substr($t{NO1},0,9) = '';
$t{list}{$t{NO1}} = $t{file};
}
}
close(DIR);
@loop = ();
$t{N1} = 0;
for $n ( sort {$a<=>$b} keys %{ $t{list} } ) {
$t{N1}++;
$t{file} = $t{list}{$n};
$t{N3} = '<a href="' . $t{file} . '">' . $t{file} . '</a>';
my %row = (
N1 => $t{N1},
N2 => $n,
file => $t{N3}
);
push(@loop, \%row);
}
$template->param(loop => \@loop);
$template->param(dir => $t{dir});
open(OUT,">./$t{dir}/$t{htmfile}");
print OUT $template->output;
close(OUT);
print "The output file is ./$t{dir}/$t{htmfile}\n";
__END__;

--------------------------------------------------------------------------------
戻る
# color_index.pl
use strict;
use HTML::Template;
my(%t,@fld,$n,$template,@loop);
print "Please input filename=";
chop($t{root}=<STDIN>);
$t{tmpl} = $t{root} . '0.htm';
$t{inputf} = $t{root} . '.txt';
$template = HTML::Template->new(filename => $t{tmpl});
@loop = ();
$t{htmfile} = $t{root} . '1.htm';
$t{flag} = 1;
open(IN,"$t{inputf}") or die "Can't open the file $t{inputf}";
while(<IN>){
next if $. == 1;
next if length($_) < 2;
chop;
if ( $t{flag} == 1 ) {
$t{flag} = 2;
push(@{ $t{N1s} },$_);
$t{N11} = $_;
} elsif ($t{flag} == 2) {
$t{clist}{$t{N11}} = $_;
$t{flag} = 3;
} elsif ($t{flag} == 3) {
$t{elist}{$t{N11}} = $_;
$t{flag} = 1;
}
}
close(IN);
#@{ $t{NN} } = sort @{ $t{N1s} };
@{ $t{NN} } = @{ $t{N1s} };
for $n ( 0 .. $#{ $t{NN} } ) {

$t{N1} = $t{NN}[$n];
$t{c1} = $t{clist}{$t{N1}};
$t{e1} = $t{elist}{$t{N1}};
$t{content} = $t{N1} . '<br>' . $t{c1} . '<br>' . $t{e1};
$t{c11} = substr($t{c1},2,2);
$t{c12} = substr($t{c1},4,2);
$t{c13} = substr($t{c1},6,2);
$t{c14} = substr($t{c1},8,2);
$t{c1} = '#' . $t{c14} . $t{c13} . $t{c12} . $t{c11};
$t{color1} = '<td bgcolor="' . $t{c1} . '"> </td>';
$t{content1} = '<td>' . $t{content} . '</td>';
push(@{ $t{colors} },$t{color1});
push(@{ $t{contents} },$t{content1});
}
$t{C1} = 8;
$t{C4} = 1;
$t{line1} = $t{line2} = 0;
for $n ( 0 .. $#{ $t{colors} } ) {

$t{color1} = $t{colors}[$n];
$t{content1} = $t{contents}[$n];
$t{C2} = int($n/$t{C1});
$t{C3} = abs($n/$t{C1}-int($n/$t{C1}));
if ( $t{C2} > $t{C4} ) {
$t{C4}++;
}
if ( $t{C3} < 0.0000001 ) {
if ( !($t{line1}) ) {
$t{line1} = '<tr>' . $t{color1};
} else {
$t{line1} .= '</tr>';
push(@{ $t{lines} },$t{line1});
$t{line1} = '<tr>' . $t{color1};
}
} elsif ( $n == 55 ) {
$t{line1} .= $t{color1} . '</tr>';
push(@{ $t{lines} },$t{line1});
} else {
$t{line1} .= $t{color1};
}
if ( $t{C3} < 0.0000001 ) {
if ( !($t{line2}) ) {
$t{line2} = '<tr>' . $t{content1};
} else {
$t{line2} .= '</tr>';
push(@{ $t{lines} },$t{line2});
$t{line2} = '<tr>' . $t{content1};
}
} elsif ( $n == 55 ) {
$t{line2} .= $t{content1} . '</tr>';
push(@{ $t{lines} },$t{line2});
} else {
$t{line2} .= $t{content1};
}
}
for $n ( 0 .. $#{ $t{lines} } ) {
$t{line1} = $t{lines}[$n];
my %row = (
line1 => $t{line1}
);
push(@loop, \%row);
}
$template->param(loop => \@loop);
open(OUT,">$t{htmfile}");
print OUT $template->output;
close(OUT);
---------------------------------------------------
ColorIndex
1
&H000000
RGB(0,0,0)
53
&H003399
RGB(153,51,0)
52
&H003333
RGB(51,51,0)
51
&H003300
RGB(0,51,0)
49
&H663300
RGB(0,51,102)
11
&H800000
RGB(0,0,128)
55
&H993333
RGB(51,51,153)
56
&H333333
RGB(51,51,51)
9
&H000080
RGB(128,0,0)
46
&H0066FF
RGB(255,102,0)
12
&H008080
RGB(128,128,0)
10
&H008000
RGB(0,128,0)
14
&H808000
RGB(0,128,128)
5
&HFF0000
RGB(0,0,255)
47
&H996666
RGB(102,102,153)
16
&H808080
RGB(128,128,128)
3
&H0000FF
RGB(255,0,0)
45
&H0099FF
RGB(255,153,0)
43
&H00CC99
RGB(153,204,0)
50
&H669933
RGB(51,153,102)
42
&HCCCC33
RGB(51,204,204)
41
&HFF6633
RGB(51,102,255)
13
&H800080
RGB(128,0,128)
48
&H969696
RGB(150,150,150)
7
&HFF00FF
RGB(255,0,255)
44
&H00CCFF
RGB(255,204,0)
6
&H00FFFF
RGB(255,255,0)
4
&H00FF00
RGB(0,255,0)
8
&HFFFF00
RGB(0,255,255)
33
&HFFCC00
RGB(0,204,255)
54
&H663399
RGB(153,51,102)
15
&HC0C0C0
RGB(192,192,192)
38
&HCC99FF
RGB(255,153,204)
40
&H99CCFF
RGB(255,204,153)
36
&H99FFFF
RGB(255,255,153)
35
&HCCFFCC
RGB(204,255,204)
34
&HFFFFCC
RGB(204,255,255)
37
&HFFCC99
RGB(153,204,255)
39
&HFF99CC
RGB(204,153,255)
2
&HFFFFFF
RGB(255,255,255)
17
&HFF9999
RGB(153,153,255)
18
&H663399
RGB(153,51,102)
19
&HCCFFFF
RGB(255,255,204)
20
&HFFFFCC
RGB(204,255,255)
21
&H660066
RGB(102,0,102)
22
&H8080FF
RGB(255,128,128)
23
&HCC6600
RGB(0,102,204)
24
&HFFCCCC
RGB(204,204,255)
25
&H800000
RGB(0,0,128)
26
&HFF00FF
RGB(255,0,255)
27
&H00FFFF
RGB(255,255,0)
28
&HFFFF00
RGB(0,255,255)
29
&H800080
RGB(128,0,128)
30
&H000080
RGB(128,0,0)
31
&H808000
RGB(0,128,128)
32
&HFF0000
RGB(0,0,255)