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 = "/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 "
\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(ÖÐÎÄ) 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(ÖÐÎÄ) 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=;

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 = "/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 "
\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("/".$dbname,$ids);

# Then,/jtdatabase.txt and /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 http://www.justake.com

=cut