当前位置: 首页 > 图文教程 > 脚本技术 > Perl > perl 学习资料整理篇

Perl
perl后门,正向和反向!实例代码
Perl模块编写说明
用perl写的单位电脑信息采集程序
冒充su ,perl写的su.pl盗取root密码
perl中5个常见错误
perl 中文处理技巧
只有一行的Perl程序
关于Perl里面正则表达式规范
Perl 获取shell命令的执行结果
Perl ASCII 字符判断
Perl Mysql数据库操作实现代码
PERL 正则表达式详细说明
python 获取命令行参数 函数
Perl5 OOP学习笔记
FTP自动上传文件的脚本以及配置文件
写了个perl的删除程序
perl常问题集合之一
perl常见问题集合之二
不错的mod_perl编程的简单应用实例介绍
[Perl]文字/代码批量替换工具

No. « 1 2 »

技术文章搜索

关键字

Perl 中的 perl 学习资料整理篇

出处:互联网   整理: 软晨网（RuanChen.com）   发布: 2009-10-12   浏览: 369 ::
收藏到网摘: n/a

比较多也乱了点，大家先看看吧 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)