perl dbi sqlite 操作集-FreeOA

perl dbi sqlite 操作集

2013-05-29 16:06:32

阿炯

使用 CPAN（Comprehensive Perl Archive Network）来安装 DBI 和 DBD::SQLite 模块，部分Linux系统已经有其官方源软件包，可直接通过apt或yum安装使用(比如Devuan4下的包分别对应为libdbi-perl、libdbd-sqlite3-perl)；windows的perl发行版本很可能已经自带了这两个模块。

DBI是一个优秀的Perl模块，是联系Perl与各类数据库的纽带。本站亦提供了相关的参考：
Perl DBI数据库访问使用入门

Perl DBI 使用详解

Perl DBI 不常见操作集锦

SQLite在比较数据的时候，只考虑被比较对象的类型，而不管被比较对象所在列的其它数据是什么类型。与Perl类似，SQLite只能识别字符型和数字型；两个数值总是以浮点类型进行比较，两个字符串直接比较。当不同类型的数据比较的时候，数字总是比字符小。只有一种情况SQLite才会关心你为某一列申明的数据类型（需要创建一个值自增加的列的时候）。可以把这列的类型指定为：“INTEGER PRIMARY KEY”。 CREATET ABLE people( id INTEGER PRIMARY KEY, name, age);

SQLite支持8位长的字符编码，但是不识别ASCII中的NULL符“\0”。唯一的变通方法就是在你存储数据之前自行编码，然后在取出数据之后再手工解码，就象URL编码或Base64编码方式一样。这甚至可以用在BLOB字段里面。

连接 SQLite 数据库

使用 DBI 模块，您可以轻松地连接到 SQLite 数据库。如果数据库文件不存在，SQLite 将创建一个新的数据库文件。

use DBI;

# 数据库文件名
my $db_file = 'mydatabase.db';

# 连接到 SQLite 数据库
my $dbh = DBI->connect("dbi:SQLite:dbname=$db_file", "", "", {
RaiseError => 1, AutoCommit => 1,
}) or die $DBI::errstr;

在上面的代码中，RaiseError 和 AutoCommit 选项分别用于自动抛出错误和自动提交事务。

执行 SQL 查询

连接到数据库后可以执行 SQL 查询来创建表、插入数据、查询数据等。

# 创建表
$dbh->do("CREATE TABLE IF NOT EXISTS users (id INTEGER PRIMARY KEY, name TEXT, age INTEGER)");

# 插入数据
$dbh->do("INSERT INTO users (name, age) VALUES ('Alice', 30)");

# 查询数据
my $sth = $dbh->prepare("SELECT * FROM users");
$sth->execute();

# 处理查询结果
while (my $row = $sth->fetchrow_hashref) {
print "ID: ", $row->{id}, ", Name: ", $row->{name}, ", Age: ", $row->{age}, "\n";
}

# 清理语句句柄
$sth->finish;

# 断开数据库连接
$dbh->disconnect();

错误处理

在使用 DBI 时可以通过设置 RaiseError 选项来自动捕获并处理错误，或者手动检查每个数据库操作的结果。

my $result = $dbh->do("INSERT INTO users (name, age) VALUES ('Bob', 25)");
if (!$result) {
print "Error: " . $dbh->errstr;
}

结束数据库连接

完成数据库操作后，应关闭数据库连接以释放资源。
$dbh->disconnect;

---------------
解决中文乱码
在连接到数据库时指定字符编码，以支持unicode(suport utf8)。
use DBI;
use utf8;
use Encode;
use Data::Dumper;
use feature qw(:5.10);
#将所有输出由utf-8的方式进行处理，解决中文问题
binmode(STDOUT,':encoding(utf8)');

my $dbfile='freeoa.s3db';
#$dbh->{sqlite_unicode} = 1;
my $dbh = DBI->connect("dbi:SQLite:dbname=$dbfile","","",{sqlite_unicode=>1});

my $rc=$dbh->selectall_arrayref(q{select * from myenu});

#print Dumper($rc);#dump时中文的编码是unicode，非乱码
say $_->[1] for(@$rc);#字段为中文，可以看到正常的文字

---------------
完整示例：

创建表

use v5.32;
use DBI;

my ($userid,$password) = ('','');
my ($driver,$database) = ("SQLite","test.db");
my $dsn = "DBI:$driver:dbname=$database";
my $dbh = DBI->connect($dsn, $userid, $password, { RaiseError => 1 }) or die $DBI::errstr;
print "Opened database successfully\n";

my $stmt = qq(CREATE TABLE COMPANY
      (ID INT PRIMARY KEY     NOT NULL,
       NAME   TEXT    NOT NULL,
       AGE   INT     NOT NULL,
       ADDRESS   CHAR(50),
       SALARY   REAL););
my $rv = $dbh->do($stmt);
if($rv < 0){
   print $DBI::errstr;
} else {
   print "Table created successfully\n";
}

$dbh->disconnect();

INSERT 操作

use v5.32;
use DBI;

my ($userid,$password) = ('','');
my ($driver,$database) = ("SQLite","test.db");
my $dsn = "DBI:$driver:dbname=$database";
my $dbh = DBI->connect($dsn, $userid, $password, { RaiseError => 1 }) or die $DBI::errstr;
print "Opened database successfully\n";

my $stmt = qq(INSERT INTO COMPANY (ID,NAME,AGE,ADDRESS,SALARY)
      VALUES (1, '炯帅', 32, 'California', 20000.00 ));
my $rv = $dbh->do($stmt) or die $DBI::errstr;

$stmt = qq(INSERT INTO COMPANY (ID,NAME,AGE,ADDRESS,SALARY)
      VALUES (2, '阿花', 25, 'Texas', 15000.00 ));
$rv = $dbh->do($stmt) or die $DBI::errstr;

$stmt = qq(INSERT INTO COMPANY (ID,NAME,AGE,ADDRESS,SALARY)
      VALUES (3, '托德', 23, 'Norway', 20000.00 ));
$rv = $dbh->do($stmt) or die $DBI::errstr;

$stmt = qq(INSERT INTO COMPANY (ID,NAME,AGE,ADDRESS,SALARY)
      VALUES (4, '马克', 25, 'Rich-Mond ', 65000.00 ););
$rv = $dbh->do($stmt) or die $DBI::errstr;

print "Records inserted successfully\n";
$dbh->disconnect();

UPDATE 操作

use v5.32;
use DBI;

my ($userid,$password) = ('','');
my ($driver,$database) = ("SQLite","test.db");
my $dsn = "DBI:$driver:dbname=$database";
my $dbh = DBI->connect($dsn, $userid, $password, { RaiseError => 1 })   or die $DBI::errstr;
print "Opened database successfully\n";

my $stmt = qq(UPDATE COMPANY set SALARY = 28000.00 where ID=1;);
my $rv = $dbh->do($stmt) or die $DBI::errstr;
if( $rv < 0 ){
   print $DBI::errstr;
}else{
   print "Total number of rows updated : $rv\n";
}
$stmt = qq(SELECT id, name, address, salary from COMPANY;);
my $sth = $dbh->prepare( $stmt );
$rv = $sth->execute() or die $DBI::errstr;
if($rv < 0){
   print $DBI::errstr;
}
while(my @row = $sth->fetchrow_array()) {
   print "ID = ". $row[0] . "\n";
   print "NAME = ". $row[1] ."\n";
   print "ADDRESS = ". $row[2] ."\n";
   print "SALARY = ". $row[3] ."\n";
   say '=' x 32;
}

print "Operation update successfully\n";
$dbh->disconnect();

DELETE 操作

use v5.32;
use DBI;

my ($userid,$password) = ('','');
my ($driver,$database) = ("SQLite","test.db");
my $dsn = "DBI:$driver:dbname=$database";
my $dbh = DBI->connect($dsn, $userid, $password, { RaiseError => 1 }) or die $DBI::errstr;
print "Opened database successfully\n";

my $stmt = qq(DELETE from COMPANY where ID=3;);
my $rv = $dbh->do($stmt) or die $DBI::errstr;
if( $rv < 0 ){
   print $DBI::errstr;
}else{
   print "Total number of rows deleted : $rv\n";
}
$stmt = qq(SELECT id, name, address, salary from COMPANY;);
my $sth = $dbh->prepare( $stmt );
$rv = $sth->execute() or die $DBI::errstr;
if($rv < 0){
   print $DBI::errstr;
}
while(my @row = $sth->fetchrow_array()) {
   print "ID = ". $row[0] . "\n";
   print "NAME = ". $row[1] ."\n";
   print "ADDRESS = ". $row[2] ."\n";
   print "SALARY = ". $row[3] ."\n";
   say '-' x 32;
}
print "Operation delete successfully\n";
$dbh->disconnect();

SELECT 操作之输出至终端

use v5.32;
use DBI;

my ($userid,$password) = ('','');
my ($driver,$database) = ("SQLite","test.db");
my $dsn = "DBI:$driver:dbname=$database";
my $dbh = DBI->connect($dsn, $userid, $password, { RaiseError => 1 }) or die $DBI::errstr;
print "Opened database successfully\n";

my $stmt = qq(SELECT id, name, address, salary from COMPANY;);
my $sth = $dbh->prepare( $stmt );
my $rv = $sth->execute() or die $DBI::errstr;
if($rv < 0){
   print $DBI::errstr;
}
while(my @row = $sth->fetchrow_array()) {
      print "ID = ". $row[0] . "\n";
      print "NAME = ". $row[1] ."\n";
      print "ADDRESS = ". $row[2] ."\n";
      print "SALARY = ". $row[3] ."\n";
   say '-' x 32;
}
print "Operation done successfully\n";
$dbh->disconnect();

全utf8支持（部分操作系统对多字节编码字符的处理可能有问题）

use v5.32;
use DBI;
use utf8;
use Encode;

binmode(STDIN, ":encoding(utf8)");
binmode(STDERR, ':encoding(utf8)');
binmode(STDOUT, ":encoding(utf8)");

my ($userid,$password) = ('','');
my ($driver,$database) = ("SQLite","test.db");
my $dsn = "DBI:$driver:dbname=$database";
my $dbh = DBI->connect($dsn, $userid, $password, {RaiseError=>1, sqlite_unicode=>1}) or die $DBI::errstr;
print "Opened database successfully\n";

my $stmt = qq(SELECT id, name, address, salary from COMPANY;);
my $sth = $dbh->prepare( $stmt );
my $rv = $sth->execute() or die $DBI::errstr;
if($rv < 0){
   print $DBI::errstr;
}
while(my @row = $sth->fetchrow_array()) {
      print "ID = ". $row[0] . "\n";
      print "NAME = ". $row[1] ."\n";
      print "ADDRESS = ". $row[2] ."\n";
      print "SALARY = ". $row[3] ."\n";
   say '-' x 32;
}
print "Operation done successfully\n";
$dbh->disconnect();

SELECT 操作之GUI-IUP

use v5.32;
#use utf8;
use DBI;
#use Encode;
use IUP ':all';

#binmode(STDIN, ":encoding(utf8)");
#binmode(STDERR, ':encoding(utf8)');
#binmode(STDOUT, ":encoding(utf8)");

#构建的GUI上的消息展示
my $mtv=IUP::Text->new(MULTILINE=>"YES", EXPAND=>"YES", WORDWRAP=>"YES", SIZE=>"299x139");

#构建的GUI上的一些构件,ops_:认证相关
my $ops_butoncls=IUP::Button->new(TITLE=>"清空", ACTION=>\&cls_text);
my $ops_buton=IUP::Button->new(TITLE=>"查找", ACTION=>\&getby_qs);

#main函数
my $maindialog=init_dialog();
$ops_butoncls->VISIBLE("NO");#设定该组件的显示属性为隐藏
$maindialog->ShowXY(IUP_CENTER,IUP_TOP);#设定窗口初始显示的位置

#构建初始函数
sub init_dialog{
   my $frm1=IUP::Frame->new(TITLE=>"相关记录", SIZE=>"69x", ALIGNMENT=>"ARIGHT", child=>IUP::Hbox->new(child=>[$ops_buton,$ops_butoncls])
);
   my $frm2=IUP::Frame->new(TITLE=>"消息框",child=>IUP::Vbox->new(child=>[$mtv]));

   my $vbox1=IUP::Vbox->new(child=>[$frm1,$frm2], ALIGNMENT=>"ALEFT");

   return IUP::Dialog->new(TITLE=>"Sqlite & IUP中文示例", child=>$vbox1,SIZE=>"499x199");#,CURSOR=>$imgcon);
}

IUP->MainLoop();

sub getby_qs{
my $driver = "SQLite";
my $database = "test.db";
my $dsn = "DBI:$driver:dbname=$database";
my $userid = "";
my $password = "";
my $dbh = DBI->connect($dsn, $userid, $password, {RaiseError=>1, sqlite_unicode=>1}) or die $DBI::errstr;
#print "Opened database successfully\n";

my $stmt = qq(SELECT id, name, address, salary from COMPANY;);
my $sth = $dbh->prepare( $stmt );
my $rv = $sth->execute() or die $DBI::errstr;
if($rv < 0){
   print $DBI::errstr;
}
while(my @row = $sth->fetchrow_array()) {
my $hmesg.="ID = $row[0], NAME = $row[1]";
   $hmesg.=", ADDRESS = $row[2], SALARY = $row[3]\n";
   $hmesg.='-' x 64;
   $mtv->APPEND($hmesg);
   $maindialog->BRINGFRONT("YES");
}
$ops_butoncls->VISIBLE("YES");
#print "Operation done successfully\n";
$dbh->disconnect();
}

sub cls_text{
   $mtv->VALUE('');
   $ops_butoncls->VISIBLE("NO");
}

SELECT 操作之GUI-Tk

use v5.32;
use utf8;
use Tk;
use DBI;
use Tk::ROText;

#$Tk::strictMotif = 1;
#binmode(STDIN, ":encoding(utf8)");
#binmode(STDOUT, ":encoding(utf8)");

my $mw = MainWindow->new;
$mw->geometry("599x399");
$mw->minsize(400,199);
$mw->title("Sqlite & TK中文示例");

my $main_frame = $mw->Frame()->pack(-side => "top", -fill => "x");

my $leftop_frame = $main_frame->Frame(-background => "#730f73")->pack(-side => "top",-fill => "y");

my $copy_button = $leftop_frame->Button(-text => "点立得",-command => \&copy_entry)->pack(-side => "left");
my $clear_button = $leftop_frame->Button(-text => "清空文本",-command => \&clear_entry)->pack(-side => "top");

my $f2 = $mw->Frame(-height =>39);
my $vert2 = $f2->Scrollbar(-orient => 'vertical',);
my $text2 = $f2->ROText(-height => 19, -wrap => 'none', -yscrollcommand => [set => $vert2]);

$text2->configure(-font => [-family => 'Noto Sans CJK SC',-size => 8]);
$text2->pack(-side => 'left');

$vert2->configure(-command => [yview => $text2]);
$vert2->pack(-side => 'right', -fill => 'y', -expand => 'yes', );

$f2->pack;

sub clear_entry {
$text2->delete('0.0', 'end');
}

MainLoop;

sub copy_entry{
my ($userid,$password) = ('','');
my ($driver,$database) = ("SQLite","test.db");
my $dsn = "DBI:$driver:dbname=$database";

my $dbh = DBI->connect($dsn, $userid, $password, {RaiseError=>1, sqlite_unicode=>1}) or die $DBI::errstr;
#print "Opened database successfully\n";

my $stmt = qq(SELECT id, name, address, salary from COMPANY;);
my $sth = $dbh->prepare( $stmt );
my $rv = $sth->execute() or die $DBI::errstr;
if($rv < 0){
   print $DBI::errstr;
}
while(my @row = $sth->fetchrow_array()) {
my $hmesg.="ID = $row[0], NAME = $row[1]";
   $hmesg.=", ADDRESS = $row[2], SALARY = $row[3], ";
   $hmesg.='Time:'.time()."\n";
   $hmesg.=('-' x 64)."\n";
   $text2->insert('end',$hmesg);
   #$text2->focus;
my ($top, $bottom) = $text2->yview();
   $text2->yviewMoveto($bottom);
}
#print "Operation done successfully\n";
$dbh->disconnect();
}

2025年说对中文支持情况：在x64架构下，代码与生成的sqlite库表文件均可在windows-1x与linux-devuan4下运行，iup的窗口在linux下不能随内容而下卷。在windows-11下的命令终端(CMD与PowerShell)均无法正常显示中文，即便将其终端编码由chcp指令改为65001也是如此；在GUI下无此问题（Tk下还是要显示使用'use utf8;'，否则连界面都是乱码）。

该文章最后由阿炯于 2025-05-13 16:57:56 更新，目前是第 2 版。