中华网络安全联盟    作者：佚名    来源：网络转载    时间：2006-3-21

use lib "."; # If NT,use lib "path-to-jtdb_directory";
use JTDB "1.01";
$main::split = ","; # Notice!, It's necessary! must be $main::split,
# Records split by ","
my $db = "<path-to>/dbname";
@main::recordNames = &db_connect($db); # Necessary! must be @main::recordNames,
# Get RecordNames from db-info file
my $sqlStr = "SELECT * FROM $db";
my @resoult = &executeStr($sqlStr);
my $line;
foreach $line (@resoult)
{
my $keys;
foreach $keys (keys %$line)
{
print $keys." : ".$line->{$keys}." ";
}
print "<br>\n";
}

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

用这样简单的方式操作文本数据，其实也不是难事儿，看看这个模块吧。。

http://ub4k91.chinaw3.com/download/jtdb.htm

JTDB v1.01

#-------------------------------------------------------------------
package JTDB;

# ----------------------------------------------------------------------
# 程序名称：平面文本SQL查询模块，JTDB V1.01
#
# 作者：阿恩 (Aren.Liu) / 成都金想网络技术有限公司
#
# 电话：028-4290153
#
# 传呼：96968-223046
#
# 一妹：boyaren@sina.com
#
# 主叶：http://www.justake.com http://jtbbs.nt.souying.com
#
# -----------------------------------------------------------------------
# 版权所有 成都金想网络技术有限公司 来趣山庄
# Copyright (C) 2000 Justake.com, JinXiang Co.,Ltd. All Rights Reserved
# -----------------------------------------------------------------------
# V 1.01 2000/12/27
# 实现 create_db功能
# V 1.00 2000/12/26
# 设想并实现平面文本数据库SQL查询最基本功能
# 可实现 select,insert,delete,update 基本功能
# ------------------------------------------- 请保留以上版权 ------------

require 5.002;

use strict;
use vars qw(@ISA @EXPORT $VERSION);
use Exporter;

$VERSION = '1.01';
$main::txt = ".txt";

@ISA = qw(Exporter);

@EXPORT = qw
(
&db_connect
&create_db
&executeStr
&readtxtfile
&writetxtfile
);
#------------------------------------------------
sub create_db
{
my ($jtdb,$recordNames) = @_;

my $jtdb_info = $jtdb."_info".$main::txt;
my $dbname = $jtdb.$main::txt;

?ify("数据库已经存在，请选择其他数据库，数据库创建失败！",1) if (-e $dbname);

open (JTDB,">$dbname");
close(JTDB);

open (JTDBINFO,">$jtdb_info");
print JTDBINFO $recordNames."\n";
close(JTDBINFO);

return (1);
}
#------------------------------------------------
sub db_connect
{
#my $dbname = substr($_[0],0,length($_[0])-4);
my $dbname = $_[0];
?ify("不能找到数据库信息文件,数据库连接失败！",1) if (!(-e $dbname."_info".$main::txt));
my @jtdb_info = &readtxtfile($dbname."_info".$main::txt);
chomp(@jtdb_info);
?ify("数据库信息文件已经损坏或丢失，连接数据库失败！",1) if ($jtdb_info[0] eq "");

my @keys = split(/$main::split/,$jtdb_info[0]);
my $key;
foreach $key (@keys)
{
$key =~ s/^\s+//g;
$key =~ s/\s+$//g;
}
return @keys;
}
#------------------------------------------------
sub db_save
{
my ($jtdb,@toSave) = @_;

my $dbname = $jtdb.$main::txt;
my $just = $jtdb.".lock";

while(-f $just)
{select(undef,undef,undef,0.1);} #锁文件
open(LOCKFILE,">$just");

open (FD,">$dbname");
my $line;
foreach $line (@toSave)
{
foreach (@main::recordNames)
{
print FD $line->{$_}.$main::split;
}
print FD "\n";
}
close(FD);

close(LOCKFILE);
unlink($just);
return (1);
}
#------------------------------------------------
sub executeStr
{
my @sqlcmds;
my $sqlcmd;

grep{/\s*(\S+)\s+(.*)/ and $sqlcmd = lc($1);} @_;

if ($sqlcmd eq "select")
{
grep{/\s*(SELECT)\s+(\S+\s*(\s*\,+?\s*\S+)*)\s+FROM\s+(\S+)((\s+WHERE\s+(.*)\s*)*)/i and $sqlcmd = lc($1);@sqlcmds = ($2,$4,$7);} @_;
&sql_select(@sqlcmds);
}
elsif ($sqlcmd eq "insert")
{
grep{/\s*(INSERT)\s+INTO\s+(\S+)((\s+\((\s*\S+\s*(\s*\,+?\s*\S+)*\s*)+?\))*?)\s+VALUES\s*\((.*)\)\s*/i and $sqlcmd = lc($1);@sqlcmds = ($2,$5,$7);} @_;
&sql_insert(@sqlcmds);
}
elsif ($sqlcmd eq "delete")
{
grep{/\s*(DELETE)\s+FROM\s+(\S+)\s+WHERE\s+(.*)\s*/i and $sqlcmd = lc($1);@sqlcmds = ($2,$3);} @_;
&sql_delete(@sqlcmds);
}
elsif ($sqlcmd eq "update")
{
grep{/\s*(UPDATE)\s+(\S+)\s+SET\s+(.*)\s+WHERE\s+(.*)\s*/i and $sqlcmd = lc($1);@sqlcmds = ($2,$3,$4);} @_;
&sql_update(@sqlcmds);
}
else
{?ify("你输入的数据库操作语句不正确，或目前的版本尚未支持，请检查！");}
}
#------------------------------------------------
sub sql_update
{
my ($jtdb,$set,$where) = @_;

my @resoult = &executeStr("SELECT * FROM $jtdb");

if ($where ne "")
{
my $key = '';
foreach $key (@main::recordNames)
{
$where =~ s/$key/\$_->{'$key'}/ig;
}
}else {?ify("你没有提供修改条件，请用 WHERE 语句提供！");}

if ($set ne "")
{
my $key = '';
foreach $key (@main::recordNames)
{
$set =~ s/$key\s*\=\s*(\'+?|\"+?)(.*)(\'+?|\"+?)\s*(\,*?)/\$_->{'$key'}\=$1$2$3\;/ig;
}
}else {?ify("你没有提供修改项目，请用 SET 语句提供！");}

foreach (@resoult)
{
if (eval($where))
{
eval($set);
}
}

&db_save($jtdb,@resoult);

return (1);
}
#------------------------------------------------
sub sql_delete
{
my ($jtdb,$where) = @_;

my @resoult = &executeStr("SELECT * FROM $jtdb");

if ($where ne "")
{
my $key = '';
foreach $key (@main::recordNames)
{
$where =~ s/$key/\$_->{'$key'}/ig;
}
}else {?ify("你没有提供删除条件，请用 WHERE 语句提供！");}

my @return = grep(eval($where)==0,@resoult);

&db_save($jtdb,@return);

#my $just = $jtdb.".lock";

#while(-f $just)
#{select(undef,undef,undef,0.1);} #锁文件
#open(LOCKFILE,">$just");

#open (FD,">$jtdb");
#my $line;
#foreach $line (@return)
#{
# foreach (@main::recordNames)
# {
# print FD $line->{$_}.$main::split;
# }
# print FD "\n";
#}
#close(FD);

#close(LOCKFILE);
#unlink($just);

return (1);
}
#------------------------------------------------
sub sql_insert
{
my ($jtdb,$keys,$values) = @_;

?ify("找不到要操作的数据库，操作失败！") if (!(-e $jtdb));

my @values = split(/\,/,$values);
my $addLine;
if ($keys ne "")
{
#my @main::recordNames = split(/$main::split/,$main::recordNames);
my @keys = split(/\,/,$keys);
my $i;
my @addLine;
for ($i=0;$i<@main::recordNames ;$i++)
{
my $n;
for ($n=0;$n<@keys;$n++)
{
if ($keys[$n] eq $main::recordNames[$i])
{
$addLine[$i] = $values[$n];
last;
}
}
}
$addLine = join($main::split,@addLine);
}
else
{
?ify("你输入的语句有错误！如果不指定插入字段，VALUES 值必须和数据库字段相对应，并且数量相等。") if(@values != @main::recordNames);
$addLine = join($main::split,@values);
}
&writetxtfile($jtdb,$addLine.$main::split."\n");
return (1);
}
#------------------------------------------------
sub sql_select
{
my ($select,$from,$where) = @_;

if ($where ne "")
{
#my @keys = split(/$main::split/,$main::recordNames);
my $key = '';
foreach $key (@main::recordNames)
{
#$key =~ s/^\s+//g;
#$key =~ s/\s+$//g;
$where =~ s/$key/\$record->{'$key'}/ig;
}
}else {$where = 1}

my $dbinfo = &dbHoH($from);

my ($key,$record,$recordName,$return)=('','','',[]);
foreach $key (keys %$dbinfo)
{
my $record = $dbinfo->{$key};
my @select = split(/\,/,$select);
@select = @main::recordNames if ($select =~ /\s*\*\s*/);

my $lineHash = {};
foreach $recordName (@select)
{
$recordName =~ s/^\s+//g;
$recordName =~ s/\s+$//g;

$lineHash->{$recordName} = $record->{$recordName} if (eval($where));
}
push(@$return, $lineHash);
}
return @$return; #返回查询结果，存储在 $return 中，Array of Array
}
#------------------------------------------------
sub dbHoH #得到数据结构 Hash of Hash
{
my $jtdb = $_[0].$main::txt;
my @database = &readtxtfile($jtdb);
chomp(@database);
#my $main::recordNames = shift(@database); #get @col_names at the first line of txt_db,shift it
#my $keys = &getKeys($main::recordNames);
my $keys = &getKeys(@main::recordNames);
my ($line,$return) = ('',{});
foreach $line (@database)
{
my $keysHash = &getRef($line,$keys);
$return->{$keysHash->{id}} = $keysHash;
}
return $return;
}
#------------------------------------------------
sub getKeys #得到关键字，BOOK<Perl 5 Complete>(中文) page(226)
{
#my $line = $_[0];
#my @keys = split(/$main::split/,$line);
my @keys = @_;
my ($key,$return,$i) = ('',{},0);
foreach $key (@keys)
{
#$key =~ s/^\s+//g;
#$key =~ s/\s+$//g;
$return->{$i++} = $key;
}
return $return;
}
#------------------------------------------------
sub getRef #得到关键字对应元素，BOOK<Perl 5 Complete>(中文) page(227)
{
my ($line,$keys) = @_;
my ($element,@elements) = @_;
my $return = {};
my $i;
@elements = split(/$main::split/,$line);
for ($i=0;$i<@elements ;$i++)
{
$element = $elements[$i];
$element =~ s/^\s+//g;
$element =~ s/\s+$//g;
$return->{$keys->{$i}}=$element;
}
return $return;
}
#------------------------------------------------
sub readtxtfile
{
my $just = $_[0].".lock";

while(-f $just)
{select(undef,undef,undef,0.1);}
open(LOCKFILE,">$just");

open(READTXTFILE,"$_[0]");
my @readtxtfile=<READTXTFILE>;
close(READTXTFILE);

close(LOCKFILE);
unlink($just);

return @readtxtfile;
}
#------------------------------------------------
sub writetxtfile
{
my $just = $_[0].".lock";

while(-f $just)
{select(undef,undef,undef,0.1);}
open(LOCKFILE,">$just");

if ($_[2] == 1)
{open (WRITETXTFILE,">$_[0]");}
else{open (WRITETXTFILE,">>$_[0]");}
print WRITETXTFILE $_[1];
close(WRITETXTFILE);

close(LOCKFILE);
unlink($just);

return(1);
}
#------------------------------------------------
sub notify
{
use CGI;
my $query = new CGI;
print $query->header() if ($_[1] == 1);
print $_[0];
exit;
}
#------------------------------------------------

1;

__END__

=head1 NAME

JTDB -- A modules of control a txt-database width SQL-words

=head1 SYNOPSIS

use lib "."; # If NT,use lib "path-to-jtdb_directory";
use JTDB "1.01";

$main::split = ","; # Notice!, It's necessary! must be $main::split,
# Records split by ","

my $db = "<path-to>/dbname";

@main::recordNames = &db_connect($db); # Necessary! must be @main::recordNames,
# Get RecordNames from db-info file

my $sqlStr = "SELECT * FROM $db";
my @resoult = &executeStr($sqlStr);

my $line;
foreach $line (@resoult)
{
my $keys;
foreach $keys (keys %$line)
{
print $keys." : ".$line->{$keys}." ";
}
print "<br>\n";
}

=head1 DESCRIPTION

This modules, JTDB.pm, is a tool of control txt-database width SQL-words.
For now,only SELECT,INSERT,DELETE,UPDATE can be used in this script,and It's
very simple.

It is only opening-words, and I think some one will make it fullness and
mightiness one day! So,you can modify it at will! and I hope you tell us
the headway of this modules and share it width everybody. at last, I hope
you do not remove my copyright,if u will...

Enjoy it!

=item db_connect

open dbname_info.txt and get @recordNames

=item executeStr

Execute sql-script,and return a Array of Array

my @resoult = &executeStr($sqlStr);

my $line;
foreach $line (@resoult)
{
print $line->{'id'}."\n";
print $line->{'name'}."\n";
}

=item create_db

usage:

my $ids = "id,name,pass,lover"; # Now,$main::split = ","

# If $ids = "id||name||pass||lover" then $main::split = "||"
my $dbname = "jtdatabase";
create_db("<path-to>/".$dbname,$ids);

# Then,<path-to>/jtdatabase.txt and <path-to>/jtdatabase_info.txt has been
# created !

=head2 SQL-String

select id,name from $db where id>6
select * from from $db where name=~ m"Aren"i and email ne ""

notices: at the block of WHERE ,u can use a-short-perl-code !!
--------------------------------------------------------------

INSERT INTO $db (id,name) values(2009,Aren)
insert into $db values ( 2009,Aren,12345,mylover)

notices: do not use ' or " at values-list

insert into $db values ( '2009','Aren','12345','mylover')
will set id="'2009'" and name="'Aren'" and ...
--------------------------------------------------------------

DELETE FROM $db WHERE id =~ /J/
--------------------------------------------------------------

update $db set name='jack',pass=\"123\",lover='jack\"lover' where id = 3

=head1 BUGS

Author Aren <boyaren@sina.com> http://www.justake.com

=cut