Blame
Date:
Sun Dec 27 01:56:09 2020 UTC
Message:
Updated p5-Class-DBI-SQLite-0.11p2
001
2020-10-11
jrmu
#!/usr/bin/perl
002
2020-10-11
jrmu
003
2020-10-11
jrmu
package SQLite;
004
2020-10-11
jrmu
005
2020-10-11
jrmu
use strict;
006
2020-10-11
jrmu
use warnings;
007
2020-10-11
jrmu
use OpenBSD::Pledge;
008
2020-10-11
jrmu
use OpenBSD::Unveil;
009
2020-11-15
jrmu
use Data::Dumper;
010
2020-10-11
jrmu
use DBI;
011
2020-10-11
jrmu
use DBD::SQLite;
012
2020-10-11
jrmu
013
2020-10-20
jrmu
use constant {
014
2020-10-20
jrmu
NONE => 0,
015
2020-10-20
jrmu
ERRORS => 1,
016
2020-10-20
jrmu
WARNINGS => 2,
017
2020-10-20
jrmu
ALL => 3,
018
2020-10-20
jrmu
};
019
2020-11-15
jrmu
my %conf = %main::conf;
020
2020-11-15
jrmu
my $staff = $conf{staff};
021
2020-10-11
jrmu
my $dbh;
022
2020-11-15
jrmu
my $verbose = $conf{verbose};
023
2020-10-11
jrmu
my $dbpath = "/var/www/botnow/botnow.db";
024
2020-10-11
jrmu
my $database = "/var/www/botnow/"; # database path
025
2020-11-15
jrmu
main::cbind("msg", "-", "get", \&mget);
026
2020-11-15
jrmu
main::cbind("msg", "-", "set", \&mset);
027
2020-11-15
jrmu
main::cbind("msg", "-", "connectdb", \&mconnectdb);
028
2020-11-15
jrmu
main::cbind("msg", "-", "insert", \&minsert);
029
2020-11-15
jrmu
main::cbind("msg", "-", "update", \&mupdate);
030
2020-11-15
jrmu
main::cbind("msg", "-", "delete", \&mdelete);
031
2020-11-15
jrmu
main::cbind("msg", "-", "select", \&mselect);
032
2020-10-11
jrmu
033
2020-10-11
jrmu
sub init {
034
2020-10-11
jrmu
unveil("$dbpath", "rwc") or die "Unable to unveil $!";
035
2020-10-11
jrmu
unveil("$dbpath-journal", "rwc") or die "Unable to unveil $!";
036
2020-10-11
jrmu
unveil("$database", "rwxc") or die "Unable to unveil $!";
037
2020-10-11
jrmu
}
038
2020-10-11
jrmu
039
2020-10-15
jrmu
# !connectdb
040
2020-10-11
jrmu
sub mconnectdb {
041
2020-10-11
jrmu
my ($bot, $nick, $host, $hand, $text) = @_;
042
2020-10-11
jrmu
if ($staff !~ /$nick/) { return; }
043
2020-10-11
jrmu
if (connectdb()) {
044
2020-10-11
jrmu
main::putserv($bot, "PRIVMSG $nick :connectdb succeeded");
045
2020-10-11
jrmu
} else {
046
2020-10-11
jrmu
main::putserv($bot, "PRIVMSG $nick :ERROR: connectdb failed");
047
2020-10-11
jrmu
}
048
2020-10-11
jrmu
}
049
2020-10-11
jrmu
050
2020-10-15
jrmu
# !insert <table> <keys> <vals>
051
2020-10-20
jrmu
# Insert comma-separated keys and vals into table
052
2020-10-11
jrmu
sub minsert {
053
2020-10-11
jrmu
my ($bot, $nick, $host, $hand, $text) = @_;
054
2020-10-11
jrmu
if ($staff !~ /$nick/) { return; }
055
2020-10-15
jrmu
if ($text =~ /^([-_~@!,\.[:alnum:]]+)\s+([-_~@!,\.[:alnum:]]+)\s+([[:ascii:]]+)/) {
056
2020-10-15
jrmu
my ($table, $keys, $vals) = ($1, $2, $3);
057
2020-10-11
jrmu
# strings in the values must be quoted
058
2020-10-11
jrmu
if ($vals =~ s{,}{","}g) { $vals = '"'.$vals.'"'; }
059
2020-10-15
jrmu
if (insertrow($table, $keys, $vals)) {
060
2020-10-15
jrmu
main::putserv($bot, "PRIVMSG $nick :$table ($keys) => ($vals)");
061
2020-10-11
jrmu
} else {
062
2020-10-15
jrmu
main::putserv($bot, "PRIVMSG $nick :$table insert failed");
063
2020-10-11
jrmu
}
064
2020-10-11
jrmu
} else {
065
2020-10-11
jrmu
main::putserv($bot, "PRIVMSG $nick :invalid insert");
066
2020-10-11
jrmu
}
067
2020-10-11
jrmu
}
068
2020-10-20
jrmu
069
2020-10-20
jrmu
# Set key = val where idkey = idval in table
070
2020-10-20
jrmu
# !update <table> <idkey> <idval> <key> <val>
071
2020-10-11
jrmu
sub mupdate {
072
2020-10-11
jrmu
my ($bot, $nick, $host, $hand, $text) = @_;
073
2020-10-11
jrmu
if ($staff !~ /$nick/) { return; }
074
2020-10-20
jrmu
if ($text =~ /^([-_~@!,\.[:alnum:]]+)\s+([-_~@!,\.[:alnum:]]+)\s+(\S+)\s+([-_[:alnum:]]+)\s+(\S+)/) {
075
2020-10-20
jrmu
my ($table, $idkey, $idval, $key, $val) = ($1, $2, $3, $4, $5);
076
2020-10-20
jrmu
if (updaterow($table, $idkey, $idval, $key, $val)) {
077
2020-10-20
jrmu
main::putserv($bot, "PRIVMSG $nick :$table $key => $val where $idkey = $idval");
078
2020-10-11
jrmu
} else {
079
2020-10-20
jrmu
main::putserv($bot, "PRIVMSG $nick :update failed");
080
2020-10-11
jrmu
}
081
2020-10-11
jrmu
} else {
082
2020-10-11
jrmu
main::putserv($bot, "PRIVMSG $nick :invalid update");
083
2020-10-11
jrmu
}
084
2020-10-11
jrmu
}
085
2020-10-11
jrmu
086
2020-10-20
jrmu
# Delete rows where key = val in table
087
2020-10-15
jrmu
# !delete <table> <key> <val>
088
2020-10-11
jrmu
sub mdelete {
089
2020-10-11
jrmu
my ($bot, $nick, $host, $hand, $text) = @_;
090
2020-10-11
jrmu
if ($staff !~ /$nick/) { return; }
091
2020-10-15
jrmu
if ($text =~ /^([-_~@!,\.[:alnum:]]+)\s+([-_[:alnum:]]+)\s+(\S+)/) {
092
2020-10-15
jrmu
my ($table, $key, $val) = ($1, $2, $3);
093
2020-10-20
jrmu
if (deleterows($table, $key, $val)) {
094
2020-10-20
jrmu
main::putserv($bot, "PRIVMSG $nick :$table $key = $val deleted");
095
2020-10-11
jrmu
} else {
096
2020-10-20
jrmu
main::putserv($bot, "PRIVMSG $nick :delete failed");
097
2020-10-11
jrmu
}
098
2020-10-11
jrmu
} else {
099
2020-10-11
jrmu
main::putserv($bot, "PRIVMSG $nick :invalid delete");
100
2020-10-11
jrmu
}
101
2020-10-11
jrmu
}
102
2020-10-11
jrmu
103
2020-10-20
jrmu
# Output rows where key = val in table
104
2020-10-15
jrmu
# !select <table> <key> <val>
105
2020-10-11
jrmu
sub mselect {
106
2020-10-11
jrmu
my ($bot, $nick, $host, $hand, $text) = @_;
107
2020-10-11
jrmu
if ($staff !~ /$nick/) { return; }
108
2020-10-15
jrmu
if ($text =~ /^([-_~@!,\.[:alnum:]]+)\s+([-_[:alnum:]]+)\s+(\S+)/) {
109
2020-10-15
jrmu
my ($table, $key, $val) = ($1, $2, $3);
110
2020-10-20
jrmu
my @rows = selectrows($table, $key, $val);
111
2020-10-11
jrmu
if (@rows) {
112
2020-10-11
jrmu
foreach my $row (@rows) {
113
2020-10-20
jrmu
my @pairs;
114
2020-10-11
jrmu
foreach $key (keys %$row) {
115
2020-10-11
jrmu
my $val = $row->{$key} || "";
116
2020-10-20
jrmu
push(@pairs, "$key => $val");
117
2020-10-11
jrmu
}
118
2020-10-20
jrmu
main::putserv($bot, "PRIVMSG $nick :$table ".join(',', @pairs));
119
2020-10-11
jrmu
}
120
2020-10-11
jrmu
} else {
121
2020-10-20
jrmu
main::putserv($bot, "PRIVMSG $nick :no results");
122
2020-10-11
jrmu
}
123
2020-10-11
jrmu
} else {
124
2020-10-11
jrmu
main::putserv($bot, "PRIVMSG $nick :select invalid");
125
2020-10-11
jrmu
}
126
2020-10-11
jrmu
}
127
2020-10-11
jrmu
128
2020-10-20
jrmu
# Get value of key where idkey = idval in table
129
2020-10-20
jrmu
# !get <table> <idkey> <idval> <key>
130
2020-10-20
jrmu
sub mget {
131
2020-10-11
jrmu
my ($bot, $nick, $host, $hand, $text) = @_;
132
2020-10-11
jrmu
if ($staff !~ /$nick/) { return; }
133
2020-10-20
jrmu
if ($text =~ /^([-_~@!,\.[:alnum:]]+)\s+([-_~@!,\.[:alnum:]]+)\s+(\S+)\s+([-_[:alnum:]]+)/) {
134
2020-10-20
jrmu
my ($table, $idkey, $idval, $key) = ($1, $2, $3, $4);
135
2020-10-20
jrmu
my $val = get($table, $idkey, $idval, $key);
136
2020-10-11
jrmu
if (defined($val)) {
137
2020-10-20
jrmu
main::putserv($bot, "PRIVMSG $nick :$table $key => $val where $idkey = $idval");
138
2020-10-11
jrmu
} else {
139
2020-10-20
jrmu
main::putserv($bot, "PRIVMSG $nick :undefined");
140
2020-10-11
jrmu
}
141
2020-10-11
jrmu
} else {
142
2020-10-20
jrmu
main::putserv($bot, "PRIVMSG $nick :invalid get");
143
2020-10-11
jrmu
}
144
2020-10-11
jrmu
}
145
2020-10-20
jrmu
# !set <table> <idkey> <idval> <key> <val>
146
2020-10-20
jrmu
sub mset {
147
2020-10-11
jrmu
my ($bot, $nick, $host, $hand, $text) = @_;
148
2020-10-11
jrmu
if ($staff !~ /$nick/) { return; }
149
2020-10-20
jrmu
if ($text =~ /^([-_~@!,\.[:alnum:]]+)\s+([-_~@!,\.[:alnum:]]+)\s+(\S+)\s+([-_[:alnum:]]+)\s+(\S+)/) {
150
2020-10-20
jrmu
my ($table, $idkey, $idval, $key, $val) = ($1, $2, $3, $4, $5);
151
2020-10-20
jrmu
if (set($table, $idkey, $idval, $key, $val)) {
152
2020-10-20
jrmu
main::putserv($bot, "PRIVMSG $nick :$table $key => $val where $idkey = $idval");
153
2020-10-11
jrmu
} else {
154
2020-10-20
jrmu
main::putserv($bot, "PRIVMSG $nick :failed set");
155
2020-10-11
jrmu
}
156
2020-10-11
jrmu
} else {
157
2020-10-20
jrmu
main::putserv($bot, "PRIVMSG $nick :invalid set");
158
2020-10-11
jrmu
}
159
2020-10-11
jrmu
}
160
2020-10-11
jrmu
161
2020-10-11
jrmu
# Connect to database, creating table if necessary
162
2020-10-11
jrmu
# Returns true on success, false on failure
163
2020-10-11
jrmu
sub connectdb {
164
2020-10-11
jrmu
my $dsn = "dbi:SQLite:dbname=$dbpath";
165
2020-10-11
jrmu
my $user = "";
166
2020-10-11
jrmu
my $password = "";
167
2020-10-11
jrmu
$dbh = DBI->connect($dsn, $user, $password, {
168
2020-10-12
jrmu
PrintError => 1,
169
2020-10-11
jrmu
RaiseError => 1,
170
2020-10-11
jrmu
AutoCommit => 1,
171
2020-10-11
jrmu
FetchHashKeyName => 'NAME_lc',
172
2020-10-12
jrmu
}) or die "Couldn't connect to database: " . $DBI::errstr;
173
2020-10-11
jrmu
if (!(-s "$dbpath")) {
174
2020-10-11
jrmu
my $sql = main::readstr('table.sql');
175
2020-10-11
jrmu
my @sql = split /;/m, $sql;
176
2020-10-11
jrmu
foreach my $s (@sql) {
177
2020-10-11
jrmu
$dbh->do($s);
178
2020-10-11
jrmu
}
179
2020-10-11
jrmu
}
180
2020-10-20
jrmu
main::debug(ALL, "connected to $dbpath");
181
2020-10-11
jrmu
return defined($dbh);
182
2020-10-11
jrmu
}
183
2020-10-11
jrmu
184
2020-10-20
jrmu
# Inserts comma-separated keys and vals into table
185
2020-10-20
jrmu
# Returns number of rows successfully inserted
186
2020-10-11
jrmu
sub insertrow {
187
2020-10-15
jrmu
my ($table, $keys, $vals) = @_;
188
2020-10-11
jrmu
if (!defined($dbh)) { connectdb(); }
189
2020-10-15
jrmu
my $rows = $dbh->do("INSERT INTO $table ($keys) values ($vals)");
190
2020-10-20
jrmu
if ($rows) {
191
2020-10-20
jrmu
main::debug(ALL, "INSERT INTO $table ($keys) values ($vals)");
192
2020-10-20
jrmu
} else {
193
2020-10-20
jrmu
main::debug(ERRORS, "ERRORS: Failed INSERT INTO $table ($keys) values ($vals)");
194
2020-10-20
jrmu
}
195
2020-10-11
jrmu
return $rows;
196
2020-10-11
jrmu
}
197
2020-10-11
jrmu
198
2020-10-20
jrmu
# Update key, value pair for record where idkey equals idval in table
199
2020-10-11
jrmu
# Returns number of rows successfully updated
200
2020-10-11
jrmu
sub updaterow {
201
2020-10-20
jrmu
my ($table, $idkey, $idval, $key, $val) = @_;
202
2020-10-11
jrmu
if (!defined($dbh)) { connectdb(); }
203
2020-10-20
jrmu
my $rows = $dbh->do("UPDATE $table SET $key = ? where $idkey = ?", undef, $val, $idval);
204
2020-10-20
jrmu
if ($rows) {
205
2020-10-20
jrmu
main::debug(ALL, "UPDATE $table SET $key = $val where $idkey = $idval");
206
2020-10-20
jrmu
} else {
207
2020-10-20
jrmu
main::debug(ERRORS, "ERRORS: Failed UPDATE $table SET $key = $val where $idkey = $idval");
208
2020-10-20
jrmu
}
209
2020-10-11
jrmu
return $rows;
210
2020-10-11
jrmu
}
211
2020-10-11
jrmu
212
2020-10-15
jrmu
# Delete records from $table where $key = $val
213
2020-10-11
jrmu
# Returns number of rows deleted
214
2020-10-20
jrmu
sub deleterows {
215
2020-10-15
jrmu
my ($table, $key, $val) = @_;
216
2020-10-11
jrmu
if (!defined($dbh)) { connectdb(); }
217
2020-10-15
jrmu
my $rows = $dbh->do("DELETE FROM $table WHERE $key = ?", undef, $val);
218
2020-10-20
jrmu
if ($rows) {
219
2020-10-20
jrmu
main::debug(ALL, "DELETE FROM $table WHERE $key = $val");
220
2020-10-20
jrmu
} else {
221
2020-10-20
jrmu
main::debug(ERRORS, "ERRORS: Failed DELETE FROM $table WHERE $key = $val");
222
2020-10-20
jrmu
}
223
2020-10-11
jrmu
return $rows;
224
2020-10-11
jrmu
}
225
2020-10-11
jrmu
226
2020-10-11
jrmu
# Returns all records in the database
227
2020-10-11
jrmu
sub selectall {
228
2020-10-15
jrmu
my ($table) = @_;
229
2020-10-11
jrmu
if (!defined($dbh)) { connectdb(); }
230
2020-10-15
jrmu
my $sth = $dbh->prepare("SELECT * FROM $table");
231
2020-10-11
jrmu
$sth->execute();
232
2020-10-11
jrmu
my @results;
233
2020-10-11
jrmu
while (my $row = $sth->fetchrow_hashref) {
234
2020-10-11
jrmu
push(@results, $row);
235
2020-10-11
jrmu
}
236
2020-10-11
jrmu
return @results;
237
2020-10-11
jrmu
}
238
2020-10-11
jrmu
239
2020-10-15
jrmu
# Returns all records from table where key equals value
240
2020-10-20
jrmu
sub selectrows {
241
2020-10-15
jrmu
my ($table, $key, $val) = @_;
242
2020-10-11
jrmu
if (!defined($dbh)) { connectdb(); }
243
2020-10-15
jrmu
my $sth = $dbh->prepare("SELECT * FROM $table WHERE $key = ?");
244
2020-10-11
jrmu
$sth->execute($val);
245
2020-10-11
jrmu
my @results;
246
2020-10-11
jrmu
while (my $row = $sth->fetchrow_hashref) {
247
2020-10-11
jrmu
push(@results, $row);
248
2020-10-11
jrmu
}
249
2020-10-11
jrmu
return @results;
250
2020-10-11
jrmu
}
251
2020-10-11
jrmu
252
2020-10-15
jrmu
# Returns list of tables
253
2020-10-15
jrmu
sub tables {
254
2020-10-15
jrmu
# if (!defined($dbh)) { connectdb(); }
255
2020-10-15
jrmu
# my $sth = $dbh->prepare(".tables");
256
2020-10-15
jrmu
# $sth->execute($val);
257
2020-10-15
jrmu
# my @results;
258
2020-10-15
jrmu
# while (my $row = $sth->fetchrow_hashref) {
259
2020-10-15
jrmu
# push(@results, $row);
260
2020-10-15
jrmu
# }
261
2020-10-15
jrmu
# return @results;
262
2020-10-15
jrmu
return qw(bnc shell www irc smtp);
263
2020-10-11
jrmu
}
264
2020-10-11
jrmu
265
2020-10-20
jrmu
# Returns value of key in record in table where idkey = idval
266
2020-10-20
jrmu
sub get {
267
2020-10-20
jrmu
my ($table, $idkey, $idval, $key) = @_;
268
2020-10-20
jrmu
if (!defined($dbh)) { connectdb(); }
269
2020-10-20
jrmu
my $sth = $dbh->prepare("SELECT * FROM $table WHERE $idkey = ?");
270
2020-10-20
jrmu
$sth->execute($idval);
271
2020-10-20
jrmu
if (my $row = $sth->fetchrow_hashref) {
272
2020-10-20
jrmu
my $val = $row->{$key};
273
2020-10-20
jrmu
if (!defined($val)) { $val = "undefined"; }
274
2020-10-20
jrmu
main::debug(ALL, "get: $table $key => $val where $idkey = $idval");
275
2020-10-20
jrmu
return $row->{$key};
276
2020-10-20
jrmu
} else {
277
2020-10-20
jrmu
main::debug(ERRORS, "ERRORS: $table $key undefined where $idkey = $idval");
278
2020-10-20
jrmu
return;
279
2020-10-15
jrmu
}
280
2020-10-11
jrmu
}
281
2020-10-15
jrmu
282
2020-10-20
jrmu
# Sets value of key in the record in table where idkey = idval
283
2020-10-20
jrmu
# Returns true on success; false on failure
284
2020-10-20
jrmu
sub set {
285
2020-10-20
jrmu
my ($table, $idkey, $idval, $key, $val) = @_;
286
2020-10-20
jrmu
if (defined(get($table, $idkey, $idval, $idkey))) {
287
2020-10-20
jrmu
main::debug(ALL, "set: update");
288
2020-10-20
jrmu
return updaterow($table, $idkey, $idval, $key, $val) > 0;
289
2020-10-11
jrmu
} else {
290
2020-10-20
jrmu
main::debug(ALL, "set: insert");
291
2020-10-20
jrmu
return insertrow($table, "$idkey,$key", "\"$idval\",\"$val\"") > 0;
292
2020-10-11
jrmu
}
293
2020-10-11
jrmu
}
294
2020-10-11
jrmu
295
2020-11-05
jrmu
# given a key, val pair in table, return the id that falls within expires seconds
296
2020-10-20
jrmu
sub id {
297
2020-11-05
jrmu
my ($table, $key, $val, $expires) = @_;
298
2020-10-20
jrmu
my @rows = selectrows($table, $key, $val);
299
2020-11-15
jrmu
if (scalar(@rows) == 0) {
300
2020-11-15
jrmu
print "table => $table, key => $key, val => $val\n\n";
301
2020-11-15
jrmu
}
302
2020-10-20
jrmu
my $maxrow;
303
2020-10-20
jrmu
foreach my $row (@rows) {
304
2020-10-20
jrmu
if (!defined($maxrow)) { $maxrow = $row; }
305
2020-10-20
jrmu
if ($row->{localtime} > $maxrow->{localtime}) {
306
2020-10-20
jrmu
$maxrow = $row;
307
2020-10-11
jrmu
}
308
2020-10-11
jrmu
}
309
2020-11-05
jrmu
if (abs(time() - $maxrow->{localtime}) <= $expires) {
310
2020-11-05
jrmu
main::debug(ALL, "id: $maxrow->{id} where $key = $val at $expires");
311
2020-10-20
jrmu
return $maxrow->{id};
312
2020-10-20
jrmu
} else {
313
2020-10-20
jrmu
main::debug(ERRORS, "no id found");
314
2020-10-20
jrmu
return;
315
2020-10-20
jrmu
}
316
2020-10-11
jrmu
}
317
2020-10-11
jrmu
318
2020-10-11
jrmu
1; # MUST BE LAST STATEMENT IN FILE