use jtdb "1.01";
$main::split = ","; # notice!, its 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!, its 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 its
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
文章整理：西部数码--专业提供域名注册、虚拟主机服务
http://www.west263.com
以上信息与文章正文是不可分割的一部分,如果您要转载本文章,请保留以上信息，谢谢!
