Annotation of botnow/SQLite.pm, Revision 1.1
1.1 ! bountyht 1: #!/usr/bin/perl
! 2:
! 3: package SQLite;
! 4:
! 5: use strict;
! 6: use warnings;
! 7: use OpenBSD::Pledge;
! 8: use OpenBSD::Unveil;
! 9: use Data::Dumper;
! 10: use DBI;
! 11: use DBD::SQLite;
! 12:
! 13: use constant {
! 14: NONE => 0,
! 15: ERRORS => 1,
! 16: WARNINGS => 2,
! 17: ALL => 3,
! 18: };
! 19: my %conf = %main::conf;
! 20: my $staff = $conf{staff};
! 21: my $dbh;
! 22: my $verbose = $conf{verbose};
! 23: my $dbpath = "/var/www/botnow/botnow.db";
! 24: my $database = "/var/www/botnow/"; # database path
! 25: main::cbind("msg", "-", "get", \&mget);
! 26: main::cbind("msg", "-", "set", \&mset);
! 27: main::cbind("msg", "-", "connectdb", \&mconnectdb);
! 28: main::cbind("msg", "-", "insert", \&minsert);
! 29: main::cbind("msg", "-", "update", \&mupdate);
! 30: main::cbind("msg", "-", "delete", \&mdelete);
! 31: main::cbind("msg", "-", "select", \&mselect);
! 32:
! 33: sub init {
! 34: unveil("$dbpath", "rwc") or die "Unable to unveil $!";
! 35: unveil("$dbpath-journal", "rwc") or die "Unable to unveil $!";
! 36: unveil("$database", "rwxc") or die "Unable to unveil $!";
! 37: }
! 38:
! 39: # !connectdb
! 40: sub mconnectdb {
! 41: my ($bot, $nick, $host, $hand, $text) = @_;
! 42: if (! (main::isstaff($bot, $nick))) { return; }
! 43: if (connectdb()) {
! 44: main::putserv($bot, "PRIVMSG $nick :connectdb succeeded");
! 45: } else {
! 46: main::putserv($bot, "PRIVMSG $nick :ERROR: connectdb failed");
! 47: }
! 48: }
! 49:
! 50: # !insert <table> <keys> <vals>
! 51: # Insert comma-separated keys and vals into table
! 52: sub minsert {
! 53: my ($bot, $nick, $host, $hand, $text) = @_;
! 54: if (! (main::isstaff($bot, $nick))) { return; }
! 55: if ($text =~ /^([-_~@!,\.[:alnum:]]+)\s+([-_~@!,\.[:alnum:]]+)\s+([[:ascii:]]+)/) {
! 56: my ($table, $keys, $vals) = ($1, $2, $3);
! 57: # strings in the values must be quoted
! 58: if ($vals =~ s{,}{","}g) { $vals = '"'.$vals.'"'; }
! 59: if (insertrow($table, $keys, $vals)) {
! 60: main::putserv($bot, "PRIVMSG $nick :$table ($keys) => ($vals)");
! 61: } else {
! 62: main::putserv($bot, "PRIVMSG $nick :$table insert failed");
! 63: }
! 64: } else {
! 65: main::putserv($bot, "PRIVMSG $nick :invalid insert");
! 66: }
! 67: }
! 68:
! 69: # Set key = val where idkey = idval in table
! 70: # !update <table> <idkey> <idval> <key> <val>
! 71: sub mupdate {
! 72: my ($bot, $nick, $host, $hand, $text) = @_;
! 73: if (! (main::isstaff($bot, $nick))) { return; }
! 74: if ($text =~ /^([-_~@!,\.[:alnum:]]+)\s+([-_~@!,\.[:alnum:]]+)\s+(\S+)\s+([-_[:alnum:]]+)\s+(\S+)/) {
! 75: my ($table, $idkey, $idval, $key, $val) = ($1, $2, $3, $4, $5);
! 76: if (updaterow($table, $idkey, $idval, $key, $val)) {
! 77: main::putserv($bot, "PRIVMSG $nick :$table $key => $val where $idkey = $idval");
! 78: } else {
! 79: main::putserv($bot, "PRIVMSG $nick :update failed");
! 80: }
! 81: } else {
! 82: main::putserv($bot, "PRIVMSG $nick :invalid update");
! 83: }
! 84: }
! 85:
! 86: # Delete rows where key = val in table
! 87: # !delete <table> <key> <val>
! 88: sub mdelete {
! 89: my ($bot, $nick, $host, $hand, $text) = @_;
! 90: if (! (main::isstaff($bot, $nick))) { return; }
! 91: if ($text =~ /^([-_~@!,\.[:alnum:]]+)\s+([-_[:alnum:]]+)\s+(\S+)/) {
! 92: my ($table, $key, $val) = ($1, $2, $3);
! 93: if (deleterows($table, $key, $val)) {
! 94: main::putserv($bot, "PRIVMSG $nick :$table $key = $val deleted");
! 95: } else {
! 96: main::putserv($bot, "PRIVMSG $nick :delete failed");
! 97: }
! 98: } else {
! 99: main::putserv($bot, "PRIVMSG $nick :invalid delete");
! 100: }
! 101: }
! 102:
! 103: # Output rows where key = val in table
! 104: # !select <table> <key> <val>
! 105: sub mselect {
! 106: my ($bot, $nick, $host, $hand, $text) = @_;
! 107: if (! (main::isstaff($bot, $nick))) { return; }
! 108: if ($text =~ /^([-_~@!,\.[:alnum:]]+)\s+([-_[:alnum:]]+)\s+(\S+)/) {
! 109: my ($table, $key, $val) = ($1, $2, $3);
! 110: my @rows = selectrows($table, $key, $val);
! 111: if (@rows) {
! 112: foreach my $row (@rows) {
! 113: my @pairs;
! 114: foreach $key (keys %$row) {
! 115: my $val = $row->{$key} || "";
! 116: push(@pairs, "$key => $val");
! 117: }
! 118: main::putserv($bot, "PRIVMSG $nick :$table ".join(',', @pairs));
! 119: }
! 120: } else {
! 121: main::putserv($bot, "PRIVMSG $nick :no results");
! 122: }
! 123: } else {
! 124: main::putserv($bot, "PRIVMSG $nick :select invalid");
! 125: }
! 126: }
! 127:
! 128: # Get value of key where idkey = idval in table
! 129: # !get <table> <idkey> <idval> <key>
! 130: sub mget {
! 131: my ($bot, $nick, $host, $hand, $text) = @_;
! 132: if (! (main::isstaff($bot, $nick))) { return; }
! 133: if ($text =~ /^([-_~@!,\.[:alnum:]]+)\s+([-_~@!,\.[:alnum:]]+)\s+(\S+)\s+([-_[:alnum:]]+)/) {
! 134: my ($table, $idkey, $idval, $key) = ($1, $2, $3, $4);
! 135: my $val = get($table, $idkey, $idval, $key);
! 136: if (defined($val)) {
! 137: main::putserv($bot, "PRIVMSG $nick :$table $key => $val where $idkey = $idval");
! 138: } else {
! 139: main::putserv($bot, "PRIVMSG $nick :undefined");
! 140: }
! 141: } else {
! 142: main::putserv($bot, "PRIVMSG $nick :invalid get");
! 143: }
! 144: }
! 145: # !set <table> <idkey> <idval> <key> <val>
! 146: sub mset {
! 147: my ($bot, $nick, $host, $hand, $text) = @_;
! 148: if (! (main::isstaff($bot, $nick))) { return; }
! 149: if ($text =~ /^([-_~@!,\.[:alnum:]]+)\s+([-_~@!,\.[:alnum:]]+)\s+(\S+)\s+([-_[:alnum:]]+)\s+(\S+)/) {
! 150: my ($table, $idkey, $idval, $key, $val) = ($1, $2, $3, $4, $5);
! 151: if (set($table, $idkey, $idval, $key, $val)) {
! 152: main::putserv($bot, "PRIVMSG $nick :$table $key => $val where $idkey = $idval");
! 153: } else {
! 154: main::putserv($bot, "PRIVMSG $nick :failed set");
! 155: }
! 156: } else {
! 157: main::putserv($bot, "PRIVMSG $nick :invalid set");
! 158: }
! 159: }
! 160:
! 161: # Connect to database, creating table if necessary
! 162: # Returns true on success, false on failure
! 163: sub connectdb {
! 164: my $dsn = "dbi:SQLite:dbname=$dbpath";
! 165: my $user = "";
! 166: my $password = "";
! 167: $dbh = DBI->connect($dsn, $user, $password, {
! 168: PrintError => 1,
! 169: RaiseError => 1,
! 170: AutoCommit => 1,
! 171: FetchHashKeyName => 'NAME_lc',
! 172: }) or die "Couldn't connect to database: " . $DBI::errstr;
! 173: if (!(-s "$dbpath")) {
! 174: my $sql = main::readstr('table.sql');
! 175: my @sql = split /;/m, $sql;
! 176: foreach my $s (@sql) {
! 177: $dbh->do($s);
! 178: }
! 179: }
! 180: main::debug(ALL, "connected to $dbpath");
! 181: return defined($dbh);
! 182: }
! 183:
! 184: # Inserts comma-separated keys and vals into table
! 185: # Returns number of rows successfully inserted
! 186: sub insertrow {
! 187: my ($table, $keys, $vals) = @_;
! 188: if (!defined($dbh)) { connectdb(); }
! 189: my $rows = $dbh->do("INSERT INTO $table ($keys) values ($vals)");
! 190: if ($rows) {
! 191: main::debug(ALL, "INSERT INTO $table ($keys) values ($vals)");
! 192: } else {
! 193: main::debug(ERRORS, "ERRORS: Failed INSERT INTO $table ($keys) values ($vals)");
! 194: }
! 195: return $rows;
! 196: }
! 197:
! 198: # Update key, value pair for record where idkey equals idval in table
! 199: # Returns number of rows successfully updated
! 200: sub updaterow {
! 201: my ($table, $idkey, $idval, $key, $val) = @_;
! 202: if (!defined($dbh)) { connectdb(); }
! 203: my $rows = $dbh->do("UPDATE $table SET $key = ? where $idkey = ?", undef, $val, $idval);
! 204: if ($rows) {
! 205: main::debug(ALL, "UPDATE $table SET $key = $val where $idkey = $idval");
! 206: } else {
! 207: main::debug(ERRORS, "ERRORS: Failed UPDATE $table SET $key = $val where $idkey = $idval");
! 208: }
! 209: return $rows;
! 210: }
! 211:
! 212: # Delete records from $table where $key = $val
! 213: # Returns number of rows deleted
! 214: sub deleterows {
! 215: my ($table, $key, $val) = @_;
! 216: if (!defined($dbh)) { connectdb(); }
! 217: my $rows = $dbh->do("DELETE FROM $table WHERE $key = ?", undef, $val);
! 218: if ($rows) {
! 219: main::debug(ALL, "DELETE FROM $table WHERE $key = $val");
! 220: } else {
! 221: main::debug(ERRORS, "ERRORS: Failed DELETE FROM $table WHERE $key = $val");
! 222: }
! 223: return $rows;
! 224: }
! 225:
! 226: # Returns all records in the database
! 227: sub selectall {
! 228: my ($table) = @_;
! 229: if (!defined($dbh)) { connectdb(); }
! 230: my $sth = $dbh->prepare("SELECT * FROM $table");
! 231: $sth->execute();
! 232: my @results;
! 233: while (my $row = $sth->fetchrow_hashref) {
! 234: push(@results, $row);
! 235: }
! 236: return @results;
! 237: }
! 238:
! 239: # Returns all records from table where key equals value
! 240: sub selectrows {
! 241: my ($table, $key, $val) = @_;
! 242: if (!defined($dbh)) { connectdb(); }
! 243: my $sth = $dbh->prepare("SELECT * FROM $table WHERE $key = ?");
! 244: $sth->execute($val);
! 245: my @results;
! 246: while (my $row = $sth->fetchrow_hashref) {
! 247: push(@results, $row);
! 248: }
! 249: return @results;
! 250: }
! 251:
! 252: # Returns list of tables
! 253: sub tables {
! 254: # if (!defined($dbh)) { connectdb(); }
! 255: # my $sth = $dbh->prepare(".tables");
! 256: # $sth->execute($val);
! 257: # my @results;
! 258: # while (my $row = $sth->fetchrow_hashref) {
! 259: # push(@results, $row);
! 260: # }
! 261: # return @results;
! 262: return qw(bnc shell www irc smtp);
! 263: }
! 264:
! 265: # Returns value of key in record in table where idkey = idval
! 266: sub get {
! 267: my ($table, $idkey, $idval, $key) = @_;
! 268: if (!defined($dbh)) { connectdb(); }
! 269: my $sth = $dbh->prepare("SELECT * FROM $table WHERE $idkey = ?");
! 270: $sth->execute($idval);
! 271: if (my $row = $sth->fetchrow_hashref) {
! 272: my $val = $row->{$key};
! 273: if (!defined($val)) { $val = "undefined"; }
! 274: main::debug(ALL, "get: $table $key => $val where $idkey = $idval");
! 275: return $row->{$key};
! 276: } else {
! 277: main::debug(ERRORS, "ERRORS: $table $key undefined where $idkey = $idval");
! 278: return;
! 279: }
! 280: }
! 281:
! 282: # Sets value of key in the record in table where idkey = idval
! 283: # Returns true on success; false on failure
! 284: sub set {
! 285: my ($table, $idkey, $idval, $key, $val) = @_;
! 286: if (defined(get($table, $idkey, $idval, $idkey))) {
! 287: main::debug(ALL, "set: update");
! 288: return updaterow($table, $idkey, $idval, $key, $val) > 0;
! 289: } else {
! 290: main::debug(ALL, "set: insert");
! 291: return insertrow($table, "$idkey,$key", "\"$idval\",\"$val\"") > 0;
! 292: }
! 293: }
! 294:
! 295: # given a key, val pair in table, return the id that falls within expires seconds
! 296: sub id {
! 297: my ($table, $key, $val, $expires) = @_;
! 298: my @rows = selectrows($table, $key, $val);
! 299: if (scalar(@rows) == 0) {
! 300: print "table => $table, key => $key, val => $val\n\n";
! 301: }
! 302: my $maxrow;
! 303: foreach my $row (@rows) {
! 304: if (!defined($maxrow)) { $maxrow = $row; }
! 305: if ($row->{localtime} > $maxrow->{localtime}) {
! 306: $maxrow = $row;
! 307: }
! 308: }
! 309: if (abs(time() - $maxrow->{localtime}) <= $expires) {
! 310: main::debug(ALL, "id: $maxrow->{id} where $key = $val at $expires");
! 311: return $maxrow->{id};
! 312: } else {
! 313: main::debug(ERRORS, "no id found");
! 314: return;
! 315: }
! 316: }
! 317:
! 318: 1; # MUST BE LAST STATEMENT IN FILE
CVSweb
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to SQLite.pm CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / botnow