perl 学习

     MySQL操作程序一
返回

--------------------------------------------------------------------------------

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, 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, 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, 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)

--------------------------------------------------------------------------------
返回
     MySQL操作程序三
返回

--------------------------------------------------------------------------------

# 把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} = '';
   $t{line1} .= $rec[0] . '==>' . $rec[1] . '';
  } else {
   $t{line1} = '';
   $t{line1} .= $rec[0] . '==>' . $rec[1] . '';
  }
     $$row_ref{line1} = $t{line1};
     push(@loop, $row_ref);
 }
 $t{sth}->finish;
 
 $t{template}->param(LOOP => \@loop);

OURREF
==>

">

">

--------------------------------------------------------------------------------
返回
     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} .= '' . $t{price11} . '';

 }
 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} .= '' . $t{price21} . '';

 }
 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);
  }
 }

">
>

#---------输入全部一样的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});

">
>

--------------------------------------------------------------------------------
返回
     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}=);

# 清空指定数据库表格内容
$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(){
 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}=);

$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=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}=);
$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}=);
$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}=);
print "Please input number=";
chop($t{number1}=);

$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(){
 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(){
 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(){
  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(){
 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}=);
$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}=);

$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(){
 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}++ };
= 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(){
    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(){
 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(){
 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} = '';
   $t{line1} .= $t{id1} . '==>' . $t{DWG1};
   $t{line1} .= '';
      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} = '';
    $t{line1} .= $t{NO} . '';
    $t{line1} .= $t{name1} . '';
    $t{line1} .= $t{code1} . '';
    $t{line1} .= $t{code1} . '';
    $t{line1} .= $t{code1} . '';
    $t{line1} .= $t{code1} . '';
    $t{line1} .= $t{code1};
    $t{line1} .= '';
       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(){
 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"";
foreach $item (@list) {
 unless ( $seen{$item} ) {
  $seen{$item} = 1;
  push(@uniq,$item);
 }
}
print"";
# 程序执行结果
# 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() {
 @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}=);
$t{tmpl} = 'index.html';
$t{inputf} = $t{root} . '.txt';

open(IN,"names.txt") or die "Can't open the file names.txt.\n";
while(){
 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(){
    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   法国

编号中文名称英文名称

一气生成数百个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}=);
$$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(){
 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} = '' . $t{file1} . '';
 $t{file1} =~ s/csv/xls/;
 $t{xls1} = '' . $t{file1} . '';
 $t{file1} =~ s/xls/htm/;
 $t{gif1} = '' . $t{file1} . '';
    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}=);

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} = '' . $t{file} . '';
    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}=);
$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(){
    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} . '
' . $t{c1} . '
' . $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} = ' ';
 $t{content1} = '' . $t{content} . '';

 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} = '' . $t{color1};
  } else {
   $t{line1} .= '';
   push(@{ $t{lines} },$t{line1});
   $t{line1} = '' . $t{color1};
  }
 } elsif ( $n == 55 ) {
  $t{line1} .= $t{color1} . '';
  push(@{ $t{lines} },$t{line1});
 } else {
  $t{line1} .= $t{color1};
 }

 if ( $t{C3} < 0.0000001 ) {
  if ( !($t{line2}) ) {
   $t{line2} = '' . $t{content1};
  } else {
   $t{line2} .= '';
   push(@{ $t{lines} },$t{line2});
   $t{line2} = '' . $t{content1};
  }
 } elsif ( $n == 55 ) {
  $t{line2} .= $t{content1} . '';
  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)
--------------------------------------------------------------------------------------------------------