ONO::DB
package ONO::DB;
################################################################################
# COPYRIGHT / LICENSE #
################################################################################
#
# This file is part of the ONO Software Project.
#
# Copyright (C) 2000-2025 Jos KIRPS [ www.kirps.com | jos_AT_kirps_DOT_com ]
# and The Joopita Project [ www.joopita.org | contact_AT_joopita_DOT_com ]
#
# This file, as well as other parts of the ONO Software Project or related
# elements, are FREE SOFTWARE available under the ARTISTIC LICENSE 2.0.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
#
# For the full license, see /ono/osr/license/LICENSE.txt, or write to
# jos_AT_kirps_DOT_com or contact_AT_joopita_DOT_com.
#
################################################################################
# END OF COPYRIGHT / LICENSE, HERE COMES THE CODE ... #
################################################################################
use strict;
use DBI;
use ONO::IO;
use ONO::Lib::DateTime::ToolBox;
use ONO::Lib::Encoding::ODBC;
use ONO::Lib::Web::BotDetect;
use ONO::Lib::Web::Client;
use ONO::Lib::Web::MaliciousIP;
###############################################################################
# ONO
###############################################################################
#: ONO_DB is responsible for all database. All DB related I/O should always be
#: handled by ONO_DB, you should not use DBI/DBD or any low level Perl DB I/O
#: stuff in your ONO projects.
#:
#: Important DB calls include:
#:
#; connect(), command(), select(), readcols()
#:
#: SQL databases should be listed in /etc/sql, note that database_name
#: doesn't need to be the actual name of the SQL database:
#:
#; /etc/sql/database_name.conf
#:
#: The content of the file looks more or less like this, please adjust to your
#: needs:
#:
#; driver mysql#;#host localhost#;#database your_db_name#;#username your_db_username#;#password your_db_password
#:
#: You may then connect to be database and execute commands:
#:
#; my $db = ONO_DB->connect('database_name');#;#ONO_DB->command($db,"UPDATE ...");
#:
#: To read data from a table:
#:
#; foreach my $line (ONO_DB->select($db,$table,$where,$order)) {#;#my @col = ONO_DB->readcols($line);#;#my $first_column_data = $col[0];#;#...#;#}
my $db_driver = "mysql";
if (ONO::IO->exists("etc/sql/drivers/odbc-mssql.conf")) {
$db_driver = "odbc";
}
my $debugger_mode;
if (ONO::IO->devstation || ONO::IO->exists("var/tmp/debug/ono_debugger.conf")) {
$debugger_mode = 1;
}
my $db_driver_odbc_encode_command = 0;
my $db_driver_odbc_encode_decode = 0;
my $db_driver_odbc_encode_readcols = 1;
my $db_driver_odbc_encode_get = 1;
###############################################################################
# LOCAL DEBUGGER
###############################################################################
# ask for user agent to prevent this on the command line:
if ($ENV{'HTTP_USER_AGENT'} && $debugger_mode) {
ONO::IO->mkpath("var/tmp/debug");
ONO::IO->rm("var/tmp/debug/ono_db.txt");
}
sub _debug {
#: Internal function used to log DB calls.
if ($debugger_mode) {
ONO::IO->append("var/tmp/debug/ono_db.txt","$_[0]\n");
}
}
sub _error {
#: Internal function used to log errors.
if ($debugger_mode) {
my $ERR = $_[0]->errstr;
if ($ERR) {
&_debug(qq~<span class="bold lightred">ONO_DB ERROR: $ERR</span>~);
}
}
}
###############################################################################
# DB API
###############################################################################
sub driver {
#: Returns the name / ID of the current driver, this will either be 'mysql'
#: or 'odbc'. MySQL is the default DB used by ONO, you may access Microsoft
#: SQL server databases by adding a file named
#: etc/sql/drivers/odbc-mssql.conf.
#:
#: Note that ONO cannot use MySQL and MS SQL simultaneously, you will need
#: to opt for one single solution at a time.
return $db_driver;
}
sub connect {
#: Connect to a database, and return a DB handle. Note that ONO can connect
#: to multiple databases at once, as lons as they use the same driver.
#:
#: Databases should be configured in /etc/sql (on the document root level,
#: NOT in the UNIX /etc directory), so that you can simply connect to
#: database_name by creating the file /etc/sql/database_name.conf and then
#: using the ONO_DB->connect('database_name') command.
#:
#: Alternatively, you may also use the -d switch to pass username and
#: password information directly to the connact() function.
#:
#: Switches:
#:
#: -d use username and password input (only DBI, not ODBC)
#: -u use username and password input (only DBI, not ODBC) (onsolete, use -d)
#: -s store status
my (
$self,
$database,
$switches,
$username,
$password,
) = @_;
my ($db_name,$db_user,$db_pass,$db_driver);
if ($switches =~ /d/) {
$db_name = $database;
$db_user = $username;
$db_pass = $password;
$db_driver = "dbi";
} else {
(
$db_name,
$db_user,
$db_pass,
$db_driver,
) = &read("",$database);
}
my $status = "ONO_DB connect [ok]\n";
if ($db_name && $db_user && $db_pass) {
$status .= "config is valid\n";
if ($db_driver =~ /odbc/i) {
$status .= "driver: ODBC\n";
eval "use DBD::ODBC";
if (!$@) {
$status .= "trying to connect...\n";
my $db = DBI->connect("dbi:ODBC:DSN=$db_name;UID=$db_user;PWD=$db_pass",'','',{ RaiseError => 1,AutoCommit => 1,odbc_utf8_on => 1});
$db->{LongTruncOk} = 1;
$db->{LongReadLen} = 4 * 4096 * 1024;
return $db;
}
} else {
$status .= "driver: MySQL\n";
eval "use DBD::mysql";
if (!$@) {
$status .= "trying to connect...\n";
my $db = DBI->connect("DBI:mysql:host=localhost:$db_name",$db_user,$db_pass);
return $db;
}
}
}
if ($switches =~ /s/) {
ONO::IO->store("root/db_status.txt",$status);
}
&_debug($status);
}
sub bad_sql_bot {
#: Returns 1 of ONO thinks that the web client is an evil web bot, or 0
#: if ONO thinks it's a human or a friendly bot.
if (ONO::Lib::Web::BotDetect->evil_bot()) {
return 1;
} else {
return 0;
}
}
sub bad_sql_ip {
#: Returns 1 of ONO thinks that the web client uses an evil IP, or 0
#: if ONO thinks that the IP doesn't look suspicious.
return ONO::Lib::Web::MaliciousIP->evil_ip_simple(ONO::Lib::Web::Client->ip());
}
sub read {
#: Read a configuration file in /etc/sql and return its data as an array.
my $database = $_[1];
my @confs = ONO::IO->load("etc/sql/$database.conf");
my ($db_name,$db_user,$db_pass,$db_driver);
foreach my $conf (@confs) {
if ($conf =~ /database (.*?)\n/ ) {$db_name = $1}
if ($conf =~ /username (.*?)\n/ ) {$db_user = $1}
if ($conf =~ /password (.*?)\n/ ) {$db_pass = $1}
if ($conf =~ /driver (.*?)\n/ ) {$db_driver = $1}
}
return ($db_name,$db_user,$db_pass,$db_driver);
}
sub confcheck {
#: Check if configuration data is complete.
my $conf_ref = $_[1];
my %conf = %$conf_ref;
if ($conf{'driver'} =~ /[A-Za-z0-9]/ &&$conf{'host'} =~ /[A-Za-z0-9]/ && $conf{'database'} =~ /[A-Za-z0-9]/ && $conf{'username'} =~ /[A-Za-z0-9]/ && $conf{'password'} =~ /[A-Za-z0-9]/) {
return 1;
} else {
return 0;
}
}
sub decode {
#: Decode data from UTF-8 to cp1252, which may be required on
#: ODBC installations in some cases.
my ($self,$data) = @_;
if ($db_driver eq "odbc" && $db_driver_odbc_encode_decode) {
eval "use Encode";
if (!$@) {
# Encode::from_to($data,'utf-8','cp1252');
}
}
return $data;
}
sub command {
#: Execute an SQL command. In case of INSERT, UPDATE or DELETE this
#: may also return data in array format.
#:
#: ONO::IO->command() is usually used to store, update or delete
#: data from tables. To read data, use select() and readcols().
#:
#: If $dump is true, then the status will be saved into a file named
#: __SQL_ERR_DUMP.txt on development stations.
#:
#: When storing binary data, ODBC may require $no_encode to be set to 1.
#: In this case, data may have be be decoded when reading later on.
my (
$self,
$db,
$command,
$dump,
$no_encode,
) = @_;
# no_encode is only for ODBC, if we need to store BINARY data or UNICODE / EMOJIS for example
# note that we'll need to decode when reading later on in this case though...
&_debug($command);
if ($db_driver eq "odbc") {
$command = ONO::Lib::Encoding::ODBC->encode($command);
if (!$no_encode && $db_driver_odbc_encode_command) {
eval "use Encode";
if (!$@) {
Encode::from_to($command,'utf-8','cp1252');
}
}
}
my @data;
my $stat = $db->prepare("$command;");
$stat->execute();
if ($command !~ /^(INSERT|UPDATE|DELETE) /) {
while (my @row = $stat->fetchrow_array()) {
@data = (@data,\@row);
}
}
&_error($stat);
if (ONO::IO->devstation && $dump) {
my $str = $stat->errstr;
ONO::IO->append("__SQL_ERR_DUMP.txt","$str:\n$command\n\n####\n");
}
$stat->finish();
return @data;
}
sub command_update {
#: Like command(), additionally this will automatically update
#: modification_username and modification_timestamp (will only
#: work with tables offering those).
my ($self,$db,$command,$user) = @_;
my $UPDATE = &update_timestamp_string("",$user);
$command =~ s~ WHERE ~ , $UPDATE WHERE ~;
&command("",$db,$command);
}
sub dump {
#: Make a backup of a specific MySQL database table. Note that this will
#: not work with ODBC databases.
my (
$self,
$vpath,$community,$table,$dir,
) = @_;
my ($db_name,$db_user,$db_pass) = &read("",$community);
`mysqldump $db_name $table --user=$db_user --password=$db_pass > $vpath/$dir/$table.sql`;
&_debug("dump: $vpath/$dir/$table.sql");
return "$vpath/$dir/$table.sql";
}
sub inc {
#: Increment the value of a database table column.
my (
$self,
$db,
$column,
$table,
$where,
) = @_;
$table = &clean("",$table);
if ($where && $where !~ /WHERE/gi) {
$where = "WHERE $where";
}
&_debug("UPDATE $table SET $column = $column + 1 $where;");
my $stat = $db->prepare("UPDATE $table SET $column = $column + 1 $where;");
$stat->execute();
return $stat->fetchrow_array();
$stat->finish();
}
sub tables {
#: Return a list of all tables contained in a database.
my ($self,$db,$driver) = @_;
&_debug("reading out tables...");
my (@tables,$found);
if ($driver eq "odbc" || $db_driver eq "odbc") {
# MS-SQL and ODBC code:
my $stat = $db->prepare("SELECT Distinct TABLE_NAME FROM information_schema.TABLES;");
$stat->execute();
while (my @row = $stat->fetchrow_array()) {
$found++;
@tables = (@tables,$row[0]);
}
$stat->finish();
} else {
# standard MySQL code:
my $stat = $db->prepare("SHOW TABLES;");
$stat->execute();
while (my @row = $stat->fetchrow_array()) {
$found++;
@tables = (@tables,$row[0]);
}
$stat->finish();
}
return sort @tables;
}
sub clean {
#: Clean up a table or column name. Mostly used internally by the
#: module, to make sure no bad code will be passed to functions.
my $code = $_[1];
$code =~ s~[^A-Za-z0-9\_\,]~~g;
return $code;
}
sub table_exists {
#: Check if a specific table exists in a database. Returns 1 if the
#: table exists, or 0 if it doesn't exist.
my ($self,$db,$table ) = @_;
$table = &clean("",$table);
my $exists;
foreach my $tab (&tables) {
if ($tab eq $table) {
$exists++;
}
}
return $exists;
}
sub copy_record {
#: Copy a record, which means that a table record will be duplicated, using
#: a new primary key.
my (
$self,
$db,
$table,
$primkey,
$old,
$new,
) = @_;
$table = &clean("",$table);
$primkey =~ s~[^A-Za-z0-9]~~g;
$old =~ s~[^A-Za-z0-9]~~g;
$new =~ s~[^A-Za-z0-9]~~g;
my $tmp_id = 1000+int(rand(999));
my $RET;
foreach my $COM (
"CREATE TEMPORARY TABLE tmptable_$tmp_id SELECT * FROM $table WHERE $primkey = '$old';",
"UPDATE tmptable_$tmp_id SET $primkey = '$new';",
"INSERT INTO $table SELECT * FROM tmptable_$tmp_id;",
"DROP TEMPORARY TABLE IF EXISTS tmptable_$tmp_id;",
) {
$RET .= "$COM<br>";
my $stat = $db->prepare($COM);
$stat->execute();
$stat->finish();
}
return $RET;
}
sub count {
#: Count the number of rows / records in a table.
my ($self,$db,$table,$options) = @_;
$table = &clean("",$table);
if ($options && $options !~ /WHERE/gi) {
$options = "WHERE $options";
}
&_debug("SELECT count(*) FROM $table $options;");
my $stat = $db->prepare("SELECT count(*) FROM $table $options;");
$stat->execute();
my $count = $stat->fetchrow_array();
$stat->finish();
if ($count < 1) {
return 0;
} else {
return $count;
}
}
sub select {
#: Read data from a table, which should always be used along with the
#: readcols() function. $select will filter results, $order can be used
#: to sort results, $limitoffset allows to limit the number of rows
#: returned an to set an offset.
#:
#: If debug is true, then select() will not return the data, but the
#: generated SQL command.
my (
$self,
$db,
$table,
$select,
$order,
$limitoffset,
$debug,
) = @_;
if (&bad_sql_bot || &bad_sql_ip) {
return ();
} else {
my $columns = "*";
if ($table =~ s~:(.*?)$~~) {
$columns = $1;
$columns =~ s~[^A-Za-z0-9\_\,]~~g;
}
$table = &clean("",$table);
my $INPUT = qq~"$table","$select","$order","$limitoffset"~;
my $WHERE = &_where($select);
my ($ORDER,$LIMIT);
if ($order =~ /[A-Za-z0-9]/) {
$ORDER = $order;
# ms-sql / odbc exceptions:
# RAND() becomes NEWID()
if ($db_driver eq "odbc") {
$ORDER =~ s~RAND\(\)~NEWID\(\)~gi;
}
if ($ORDER !~ /ORDER/) {
$ORDER = "ORDER BY $ORDER";
}
}
if ($limitoffset) {
$LIMIT = $limitoffset;
}
# mysql format:
# LIMIT 10 OFFSET 10
# ms-sql / odbc format:
# ORDER BY * OFFSET 10 ROWS FETCH NEXT 10 ROWS
if ($db_driver eq "odbc" && $limitoffset) {
$limitoffset .= " ";
if ($limitoffset =~ /LIMIT (.*?) OFFSET (.*?) /) {
$LIMIT = "OFFSET $2 ROWS FETCH NEXT $1 ROWS ONLY";
} else {
$limitoffset =~ s~LIMIT (.*?) ~~;
if ($limitoffset < 1) {
$limitoffset = 0;
}
if ($1) {
$LIMIT = "OFFSET $limitoffset ROWS FETCH NEXT $1 ROWS ONLY";
}
}
if (!$ORDER && $LIMIT) {
$ORDER = "ORDER BY 1";
}
}
my @records;
&_debug("SELECT $columns FROM $table $WHERE $ORDER $LIMIT;");
my $stat = $db->prepare("SELECT $columns FROM $table $WHERE $ORDER $LIMIT;");
if ($db_driver eq "odbc") {
$stat->{LongTruncOk} = 1;
$stat->{LongReadLen} = 4 * 4096 * 1024;
}
$stat->execute();
while (my @row = $stat->fetchrow_array()) {
# if ($db_driver =~ /odbc/i) {
#
# eval "use Encode";
# if (!$@) {
#
# foreach my $col (@row) {
# $col = ONO::Lib::Encoding::ODBC-decode($col);
# if ($col =~ /(Ã)/) {
# Encode::from_to($col,'utf-8','cp1252');
# }
# }
#
# }
#
# }
@records = (@records,\@row);
}
$stat->finish();
if ($debug) {
return qq~SELECT $columns FROM $table $WHERE $ORDER $LIMIT; ($INPUT)~;
} else {
return @records;
}
}
}
sub readcols {
#: Will turn the output of select() into readable arrays.
my $line = $_[1];
if ($db_driver !~ /odbc/i) {
# mysql just returns the line data
return (@$line);
} else {
# microsoft sql fix - don't know why empty spaces are returned from NULL cols,
# but we need to get rid of them…
my @newline;
eval "use Encode";
if (!$@) {
foreach my $col (@$line) {
$col = ONO::Lib::Encoding::ODBC->decode($col);
if ($col =~ /(Ã)/ && $db_driver_odbc_encode_readcols) {
Encode::from_to($col,'utf-8','cp1252');
}
@newline = (@newline,$col);
}
}
return (@newline);
# return (@$line);
}
}
sub get {
#: Returns a specific column from a specific row.
my ($self,$db,$column,$table,$where,$order,$limit) = @_;
$table = &clean("",$table);
$column =~ s~[^A-Za-z0-9\_\-\,]~~g;
if ($where && $where !~ /WHERE/gi) {
$where = "WHERE $where";
}
# ms-sql / odbc exceptions:
# RAND() becomes NEWID()
if ($db_driver eq "odbc") {
$order =~ s~RAND\(\)~NEWID\(\)~gi;
}
if ($order && $order !~ /ORDER BY/) {
$order = "ORDER BY $order";
}
if ($db_driver eq "odbc") {
if ($limit =~ /[0-9]/) {
$limit =~ s~LIMIT ~~;
$limit = "OFFSET 0 ROWS FETCH NEXT $limit ROWS ONLY";
}
} else {
if ($limit =~ /[0-9]/ && $limit !~ /LIMIT/) {
$limit = "LIMIT $limit";
}
}
&_debug("SELECT $column FROM $table $where;");
if ($column =~ /\,/) {
my $stat = $db->prepare("SELECT $column FROM $table $where $order $limit;");
$stat->execute();
if ($db_driver eq "odbc") {
# this is a dirty fix, as it only checks the first 3 columns for encoding problems
my @data = $stat->fetchrow_array();
if ($db_driver_odbc_encode_get) {
for (my $i = 0; $i < 9; $i++) {
$data[$i] = ONO::Lib::Encoding::ODBC->decode($data[$i]);
if ($data[$i] =~ /(Ã)/) {
Encode::from_to($data[$i],'utf-8','cp1252');
}
}
}
return @data;
} else {
return $stat->fetchrow_array();
}
$stat->finish();
} else {
my $stat = $db->prepare("SELECT $column FROM $table $where $order $limit;");
$stat->execute();
my $data = $stat->fetchrow_array();
$stat->finish();
if ($db_driver eq "odbc") {
$data = ONO::Lib::Encoding::ODBC->decode($data);
if ($data =~ /(Ã)/ && $db_driver_odbc_encode_get) {
Encode::from_to($data,'utf-8','cp1252');
}
}
return $data;
}
}
sub get_highest_primkey {
#: Detect the highest primary key in a table.
#: Also see get_next_primkey() and get_auto_inc().
my (
$self,
$db,
$primkey,
$table,
$where,
) = @_;
$table = &clean("",$table);
my $WHERE = &_where($where);
$primkey =~ s~[^A-Za-z0-9\_\-\,]~~g;
my $return = 0;
my $stat = $db->prepare("SELECT $primkey FROM $table $WHERE;");
$stat->execute();
while (my @row = $stat->fetchrow_array()) {
if ($row[0] > $return) {
$return = $row[0];
}
}
$stat->finish();
return $return;
}
sub get_next_primkey {
#: Detect the next primary key that can be used in a table.
#: Also see get_highest_primkey() and get_auto_inc().
return &get_highest_primkey("",$_[1],$_[2],$_[3])+1;
}
sub get_auto_inc {
#: Get the next automatic increment id from a table.
#: Also see get_highest_primkey() and get_next_primkey().
my ($self,$db,$table) = @_;
$table = &clean("",$table);
my $stat = $db->prepare("SELECT AUTO_INCREMENT FROM INFORMATION_SCHEMA.TABLES WHERE TABLE_SCHEMA = DATABASE() AND TABLE_NAME = '$table';");
$stat-> execute();
return $stat->fetchrow_array();
}
sub update_timestamp_string {
#: Generated the string required to update username and timestamp in
#: ONO standard SQL tables.
my $user = lc $_[1];
my $timestamp = time();
$user =~ s~[^a-z0-9]~~g;
return "modification_username = '$user', modification_timestamp = '$timestamp'";
}
sub update_timestamp {
#: Update columns modification_username and modification_timestamp
#: with current data.
my ($self,$db,$table,$record,$user) = @_;
$table = &clean("",$table);
if ($table && $record =~ /=/ && $user) {
my $WHERE = &_where($record);
my $TIME = &update_timestamp_string("",$user);
my $command = qq~UPDATE $table SET $TIME $WHERE;~;
my $stat = $db->prepare("$command");
$stat->execute();
$stat->finish();
&_debug($command);
return $command;
}
}
sub delete {
#: Delete a table row / record.
my ($self,$db,$table,$where) = @_;
$table = &clean("",$table);
if ($where =~ /=/) {
my $WHERE = &_where($where);
my $command = qq~DELETE FROM $table $WHERE;~;
my $stat = $db->prepare("$command");
$stat->execute();
$stat->finish();
&_debug($command);
return $command;
}
}
sub describe_table {
#: Return the names of all table columns as an array.
#: The driver (MySQL or ODBC) is being automatically detected,
#: but you may also force using ODBC by indicating it manually.
my ($self,$db,$table,$driver) = @_;
$table =~ s~[^A-Za-z0-9\_]~~g;
my $SQL = "DESCRIBE $table";
if ("$driver$db_driver" =~ /odbc/i) {
$SQL = "SELECT COLUMN_NAME,DATA_TYPE,CHARACTER_MAXIMUM_LENGTH FROM information_schema.COLUMNS WHERE TABLE_NAME = '$table' ORDER BY ORDINAL_POSITION";
}
&_debug($SQL);
my @columns;
my $stat = $db->prepare($SQL);
$stat->execute();
while (my @row = $stat->fetchrow_array()) {
@columns = (@columns,\@row);
}
$stat->finish();
return @columns;
}
sub connection_error {
#: Error message to be displayed in case of a connection error.
my ($self,$db,$mode,$lang,$test) = @_;
my $ERR;
if (!$db || $test) {
$mode = "database_connection_error";
$ERR = qq~<div class="box_red w80 auto">
<h2>Ooops...</h2>
<div class="box_paper large">
<div class="mb10">I seems that we're experiencing technical difficulties right now...</div>
<div class="mb10 bold">Please try again in a few minutes - thanks !</div>
<div>Sorry for the inconvenience :/</div>
</div>
<div class="large mt10">Error: ONO/DB connection failure</div>
</div>
~;
}
return ($ERR,$mode);
}
sub query_umlaut {
#: Umlaut compatibility for ODBC databases.
#: Simply processes and returns the string.
my $query = $_[1];
if ($db_driver eq "odbc") {
$query =~ s~(Ä|Ë|Ü|Ö|ä|à|â|ë|é|è|ê|ü|û|ö|ô|ï|î|ç|ß)~__~g;
}
return $query;
}
sub _where {
#: Internal function used to pre-process WHERE clause data.
my $select = $_[0];
$select =~ s~ =~=~g;
$select =~ s~= ~=~g;
my $WHERE;
if ($select =~ /=/ && $select =~ /\,/ && $select !~ / IN\(/) {
$select = qq~ AND $select~;
my @parts = split(/ AND /,$select);
foreach my $part (@parts) {
if ($part =~ /=/) {
my @sel_parts = split(/=/,$part);
$sel_parts[0] =~ s~('|`)~~g;
$sel_parts[1] =~ s~('|`)~~g;
$WHERE .= qq~ AND $sel_parts[0] = '$sel_parts[1]'~;
}
}
$WHERE =~ s~ AND ~ WHERE ~;
} else {
$WHERE = $select;
}
if ($WHERE =~ /[A-Za-z0-9]/ && $WHERE !~ /WHERE/) {
$WHERE = "WHERE $WHERE";
}
return $WHERE;
}
###############################################################################
# end of script
###############################################################################
1;
__END__
################################################################################
# COPYRIGHT / LICENSE #
################################################################################
#
# This file is part of the ONO Software Project.
#
# Copyright (C) 2000-2025 Jos KIRPS [ www.kirps.com | jos_AT_kirps_DOT_com ]
# and The Joopita Project [ www.joopita.org | contact_AT_joopita_DOT_com ]
#
# This file, as well as other parts of the ONO Software Project or related
# elements, are FREE SOFTWARE available under the ARTISTIC LICENSE 2.0.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
#
# For the full license, see /ono/osr/license/LICENSE.txt, or write to
# jos_AT_kirps_DOT_com or contact_AT_joopita_DOT_com.
#
################################################################################
# END OF COPYRIGHT / LICENSE, HERE COMES THE CODE ... #
################################################################################
use strict;
use DBI;
use ONO::IO;
use ONO::Lib::DateTime::ToolBox;
use ONO::Lib::Encoding::ODBC;
use ONO::Lib::Web::BotDetect;
use ONO::Lib::Web::Client;
use ONO::Lib::Web::MaliciousIP;
###############################################################################
# ONO
###############################################################################
#: ONO_DB is responsible for all database. All DB related I/O should always be
#: handled by ONO_DB, you should not use DBI/DBD or any low level Perl DB I/O
#: stuff in your ONO projects.
#:
#: Important DB calls include:
#:
#; connect(), command(), select(), readcols()
#:
#: SQL databases should be listed in /etc/sql, note that database_name
#: doesn't need to be the actual name of the SQL database:
#:
#; /etc/sql/database_name.conf
#:
#: The content of the file looks more or less like this, please adjust to your
#: needs:
#:
#; driver mysql#;#host localhost#;#database your_db_name#;#username your_db_username#;#password your_db_password
#:
#: You may then connect to be database and execute commands:
#:
#; my $db = ONO_DB->connect('database_name');#;#ONO_DB->command($db,"UPDATE ...");
#:
#: To read data from a table:
#:
#; foreach my $line (ONO_DB->select($db,$table,$where,$order)) {#;#my @col = ONO_DB->readcols($line);#;#my $first_column_data = $col[0];#;#...#;#}
my $db_driver = "mysql";
if (ONO::IO->exists("etc/sql/drivers/odbc-mssql.conf")) {
$db_driver = "odbc";
}
my $debugger_mode;
if (ONO::IO->devstation || ONO::IO->exists("var/tmp/debug/ono_debugger.conf")) {
$debugger_mode = 1;
}
my $db_driver_odbc_encode_command = 0;
my $db_driver_odbc_encode_decode = 0;
my $db_driver_odbc_encode_readcols = 1;
my $db_driver_odbc_encode_get = 1;
###############################################################################
# LOCAL DEBUGGER
###############################################################################
# ask for user agent to prevent this on the command line:
if ($ENV{'HTTP_USER_AGENT'} && $debugger_mode) {
ONO::IO->mkpath("var/tmp/debug");
ONO::IO->rm("var/tmp/debug/ono_db.txt");
}
sub _debug {
#: Internal function used to log DB calls.
if ($debugger_mode) {
ONO::IO->append("var/tmp/debug/ono_db.txt","$_[0]\n");
}
}
sub _error {
#: Internal function used to log errors.
if ($debugger_mode) {
my $ERR = $_[0]->errstr;
if ($ERR) {
&_debug(qq~<span class="bold lightred">ONO_DB ERROR: $ERR</span>~);
}
}
}
###############################################################################
# DB API
###############################################################################
sub driver {
#: Returns the name / ID of the current driver, this will either be 'mysql'
#: or 'odbc'. MySQL is the default DB used by ONO, you may access Microsoft
#: SQL server databases by adding a file named
#: etc/sql/drivers/odbc-mssql.conf.
#:
#: Note that ONO cannot use MySQL and MS SQL simultaneously, you will need
#: to opt for one single solution at a time.
return $db_driver;
}
sub connect {
#: Connect to a database, and return a DB handle. Note that ONO can connect
#: to multiple databases at once, as lons as they use the same driver.
#:
#: Databases should be configured in /etc/sql (on the document root level,
#: NOT in the UNIX /etc directory), so that you can simply connect to
#: database_name by creating the file /etc/sql/database_name.conf and then
#: using the ONO_DB->connect('database_name') command.
#:
#: Alternatively, you may also use the -d switch to pass username and
#: password information directly to the connact() function.
#:
#: Switches:
#:
#: -d use username and password input (only DBI, not ODBC)
#: -u use username and password input (only DBI, not ODBC) (onsolete, use -d)
#: -s store status
my (
$self,
$database,
$switches,
$username,
$password,
) = @_;
my ($db_name,$db_user,$db_pass,$db_driver);
if ($switches =~ /d/) {
$db_name = $database;
$db_user = $username;
$db_pass = $password;
$db_driver = "dbi";
} else {
(
$db_name,
$db_user,
$db_pass,
$db_driver,
) = &read("",$database);
}
my $status = "ONO_DB connect [ok]\n";
if ($db_name && $db_user && $db_pass) {
$status .= "config is valid\n";
if ($db_driver =~ /odbc/i) {
$status .= "driver: ODBC\n";
eval "use DBD::ODBC";
if (!$@) {
$status .= "trying to connect...\n";
my $db = DBI->connect("dbi:ODBC:DSN=$db_name;UID=$db_user;PWD=$db_pass",'','',{ RaiseError => 1,AutoCommit => 1,odbc_utf8_on => 1});
$db->{LongTruncOk} = 1;
$db->{LongReadLen} = 4 * 4096 * 1024;
return $db;
}
} else {
$status .= "driver: MySQL\n";
eval "use DBD::mysql";
if (!$@) {
$status .= "trying to connect...\n";
my $db = DBI->connect("DBI:mysql:host=localhost:$db_name",$db_user,$db_pass);
return $db;
}
}
}
if ($switches =~ /s/) {
ONO::IO->store("root/db_status.txt",$status);
}
&_debug($status);
}
sub bad_sql_bot {
#: Returns 1 of ONO thinks that the web client is an evil web bot, or 0
#: if ONO thinks it's a human or a friendly bot.
if (ONO::Lib::Web::BotDetect->evil_bot()) {
return 1;
} else {
return 0;
}
}
sub bad_sql_ip {
#: Returns 1 of ONO thinks that the web client uses an evil IP, or 0
#: if ONO thinks that the IP doesn't look suspicious.
return ONO::Lib::Web::MaliciousIP->evil_ip_simple(ONO::Lib::Web::Client->ip());
}
sub read {
#: Read a configuration file in /etc/sql and return its data as an array.
my $database = $_[1];
my @confs = ONO::IO->load("etc/sql/$database.conf");
my ($db_name,$db_user,$db_pass,$db_driver);
foreach my $conf (@confs) {
if ($conf =~ /database (.*?)\n/ ) {$db_name = $1}
if ($conf =~ /username (.*?)\n/ ) {$db_user = $1}
if ($conf =~ /password (.*?)\n/ ) {$db_pass = $1}
if ($conf =~ /driver (.*?)\n/ ) {$db_driver = $1}
}
return ($db_name,$db_user,$db_pass,$db_driver);
}
sub confcheck {
#: Check if configuration data is complete.
my $conf_ref = $_[1];
my %conf = %$conf_ref;
if ($conf{'driver'} =~ /[A-Za-z0-9]/ &&$conf{'host'} =~ /[A-Za-z0-9]/ && $conf{'database'} =~ /[A-Za-z0-9]/ && $conf{'username'} =~ /[A-Za-z0-9]/ && $conf{'password'} =~ /[A-Za-z0-9]/) {
return 1;
} else {
return 0;
}
}
sub decode {
#: Decode data from UTF-8 to cp1252, which may be required on
#: ODBC installations in some cases.
my ($self,$data) = @_;
if ($db_driver eq "odbc" && $db_driver_odbc_encode_decode) {
eval "use Encode";
if (!$@) {
# Encode::from_to($data,'utf-8','cp1252');
}
}
return $data;
}
sub command {
#: Execute an SQL command. In case of INSERT, UPDATE or DELETE this
#: may also return data in array format.
#:
#: ONO::IO->command() is usually used to store, update or delete
#: data from tables. To read data, use select() and readcols().
#:
#: If $dump is true, then the status will be saved into a file named
#: __SQL_ERR_DUMP.txt on development stations.
#:
#: When storing binary data, ODBC may require $no_encode to be set to 1.
#: In this case, data may have be be decoded when reading later on.
my (
$self,
$db,
$command,
$dump,
$no_encode,
) = @_;
# no_encode is only for ODBC, if we need to store BINARY data or UNICODE / EMOJIS for example
# note that we'll need to decode when reading later on in this case though...
&_debug($command);
if ($db_driver eq "odbc") {
$command = ONO::Lib::Encoding::ODBC->encode($command);
if (!$no_encode && $db_driver_odbc_encode_command) {
eval "use Encode";
if (!$@) {
Encode::from_to($command,'utf-8','cp1252');
}
}
}
my @data;
my $stat = $db->prepare("$command;");
$stat->execute();
if ($command !~ /^(INSERT|UPDATE|DELETE) /) {
while (my @row = $stat->fetchrow_array()) {
@data = (@data,\@row);
}
}
&_error($stat);
if (ONO::IO->devstation && $dump) {
my $str = $stat->errstr;
ONO::IO->append("__SQL_ERR_DUMP.txt","$str:\n$command\n\n####\n");
}
$stat->finish();
return @data;
}
sub command_update {
#: Like command(), additionally this will automatically update
#: modification_username and modification_timestamp (will only
#: work with tables offering those).
my ($self,$db,$command,$user) = @_;
my $UPDATE = &update_timestamp_string("",$user);
$command =~ s~ WHERE ~ , $UPDATE WHERE ~;
&command("",$db,$command);
}
sub dump {
#: Make a backup of a specific MySQL database table. Note that this will
#: not work with ODBC databases.
my (
$self,
$vpath,$community,$table,$dir,
) = @_;
my ($db_name,$db_user,$db_pass) = &read("",$community);
`mysqldump $db_name $table --user=$db_user --password=$db_pass > $vpath/$dir/$table.sql`;
&_debug("dump: $vpath/$dir/$table.sql");
return "$vpath/$dir/$table.sql";
}
sub inc {
#: Increment the value of a database table column.
my (
$self,
$db,
$column,
$table,
$where,
) = @_;
$table = &clean("",$table);
if ($where && $where !~ /WHERE/gi) {
$where = "WHERE $where";
}
&_debug("UPDATE $table SET $column = $column + 1 $where;");
my $stat = $db->prepare("UPDATE $table SET $column = $column + 1 $where;");
$stat->execute();
return $stat->fetchrow_array();
$stat->finish();
}
sub tables {
#: Return a list of all tables contained in a database.
my ($self,$db,$driver) = @_;
&_debug("reading out tables...");
my (@tables,$found);
if ($driver eq "odbc" || $db_driver eq "odbc") {
# MS-SQL and ODBC code:
my $stat = $db->prepare("SELECT Distinct TABLE_NAME FROM information_schema.TABLES;");
$stat->execute();
while (my @row = $stat->fetchrow_array()) {
$found++;
@tables = (@tables,$row[0]);
}
$stat->finish();
} else {
# standard MySQL code:
my $stat = $db->prepare("SHOW TABLES;");
$stat->execute();
while (my @row = $stat->fetchrow_array()) {
$found++;
@tables = (@tables,$row[0]);
}
$stat->finish();
}
return sort @tables;
}
sub clean {
#: Clean up a table or column name. Mostly used internally by the
#: module, to make sure no bad code will be passed to functions.
my $code = $_[1];
$code =~ s~[^A-Za-z0-9\_\,]~~g;
return $code;
}
sub table_exists {
#: Check if a specific table exists in a database. Returns 1 if the
#: table exists, or 0 if it doesn't exist.
my ($self,$db,$table ) = @_;
$table = &clean("",$table);
my $exists;
foreach my $tab (&tables) {
if ($tab eq $table) {
$exists++;
}
}
return $exists;
}
sub copy_record {
#: Copy a record, which means that a table record will be duplicated, using
#: a new primary key.
my (
$self,
$db,
$table,
$primkey,
$old,
$new,
) = @_;
$table = &clean("",$table);
$primkey =~ s~[^A-Za-z0-9]~~g;
$old =~ s~[^A-Za-z0-9]~~g;
$new =~ s~[^A-Za-z0-9]~~g;
my $tmp_id = 1000+int(rand(999));
my $RET;
foreach my $COM (
"CREATE TEMPORARY TABLE tmptable_$tmp_id SELECT * FROM $table WHERE $primkey = '$old';",
"UPDATE tmptable_$tmp_id SET $primkey = '$new';",
"INSERT INTO $table SELECT * FROM tmptable_$tmp_id;",
"DROP TEMPORARY TABLE IF EXISTS tmptable_$tmp_id;",
) {
$RET .= "$COM<br>";
my $stat = $db->prepare($COM);
$stat->execute();
$stat->finish();
}
return $RET;
}
sub count {
#: Count the number of rows / records in a table.
my ($self,$db,$table,$options) = @_;
$table = &clean("",$table);
if ($options && $options !~ /WHERE/gi) {
$options = "WHERE $options";
}
&_debug("SELECT count(*) FROM $table $options;");
my $stat = $db->prepare("SELECT count(*) FROM $table $options;");
$stat->execute();
my $count = $stat->fetchrow_array();
$stat->finish();
if ($count < 1) {
return 0;
} else {
return $count;
}
}
sub select {
#: Read data from a table, which should always be used along with the
#: readcols() function. $select will filter results, $order can be used
#: to sort results, $limitoffset allows to limit the number of rows
#: returned an to set an offset.
#:
#: If debug is true, then select() will not return the data, but the
#: generated SQL command.
my (
$self,
$db,
$table,
$select,
$order,
$limitoffset,
$debug,
) = @_;
if (&bad_sql_bot || &bad_sql_ip) {
return ();
} else {
my $columns = "*";
if ($table =~ s~:(.*?)$~~) {
$columns = $1;
$columns =~ s~[^A-Za-z0-9\_\,]~~g;
}
$table = &clean("",$table);
my $INPUT = qq~"$table","$select","$order","$limitoffset"~;
my $WHERE = &_where($select);
my ($ORDER,$LIMIT);
if ($order =~ /[A-Za-z0-9]/) {
$ORDER = $order;
# ms-sql / odbc exceptions:
# RAND() becomes NEWID()
if ($db_driver eq "odbc") {
$ORDER =~ s~RAND\(\)~NEWID\(\)~gi;
}
if ($ORDER !~ /ORDER/) {
$ORDER = "ORDER BY $ORDER";
}
}
if ($limitoffset) {
$LIMIT = $limitoffset;
}
# mysql format:
# LIMIT 10 OFFSET 10
# ms-sql / odbc format:
# ORDER BY * OFFSET 10 ROWS FETCH NEXT 10 ROWS
if ($db_driver eq "odbc" && $limitoffset) {
$limitoffset .= " ";
if ($limitoffset =~ /LIMIT (.*?) OFFSET (.*?) /) {
$LIMIT = "OFFSET $2 ROWS FETCH NEXT $1 ROWS ONLY";
} else {
$limitoffset =~ s~LIMIT (.*?) ~~;
if ($limitoffset < 1) {
$limitoffset = 0;
}
if ($1) {
$LIMIT = "OFFSET $limitoffset ROWS FETCH NEXT $1 ROWS ONLY";
}
}
if (!$ORDER && $LIMIT) {
$ORDER = "ORDER BY 1";
}
}
my @records;
&_debug("SELECT $columns FROM $table $WHERE $ORDER $LIMIT;");
my $stat = $db->prepare("SELECT $columns FROM $table $WHERE $ORDER $LIMIT;");
if ($db_driver eq "odbc") {
$stat->{LongTruncOk} = 1;
$stat->{LongReadLen} = 4 * 4096 * 1024;
}
$stat->execute();
while (my @row = $stat->fetchrow_array()) {
# if ($db_driver =~ /odbc/i) {
#
# eval "use Encode";
# if (!$@) {
#
# foreach my $col (@row) {
# $col = ONO::Lib::Encoding::ODBC-decode($col);
# if ($col =~ /(Ã)/) {
# Encode::from_to($col,'utf-8','cp1252');
# }
# }
#
# }
#
# }
@records = (@records,\@row);
}
$stat->finish();
if ($debug) {
return qq~SELECT $columns FROM $table $WHERE $ORDER $LIMIT; ($INPUT)~;
} else {
return @records;
}
}
}
sub readcols {
#: Will turn the output of select() into readable arrays.
my $line = $_[1];
if ($db_driver !~ /odbc/i) {
# mysql just returns the line data
return (@$line);
} else {
# microsoft sql fix - don't know why empty spaces are returned from NULL cols,
# but we need to get rid of them…
my @newline;
eval "use Encode";
if (!$@) {
foreach my $col (@$line) {
$col = ONO::Lib::Encoding::ODBC->decode($col);
if ($col =~ /(Ã)/ && $db_driver_odbc_encode_readcols) {
Encode::from_to($col,'utf-8','cp1252');
}
@newline = (@newline,$col);
}
}
return (@newline);
# return (@$line);
}
}
sub get {
#: Returns a specific column from a specific row.
my ($self,$db,$column,$table,$where,$order,$limit) = @_;
$table = &clean("",$table);
$column =~ s~[^A-Za-z0-9\_\-\,]~~g;
if ($where && $where !~ /WHERE/gi) {
$where = "WHERE $where";
}
# ms-sql / odbc exceptions:
# RAND() becomes NEWID()
if ($db_driver eq "odbc") {
$order =~ s~RAND\(\)~NEWID\(\)~gi;
}
if ($order && $order !~ /ORDER BY/) {
$order = "ORDER BY $order";
}
if ($db_driver eq "odbc") {
if ($limit =~ /[0-9]/) {
$limit =~ s~LIMIT ~~;
$limit = "OFFSET 0 ROWS FETCH NEXT $limit ROWS ONLY";
}
} else {
if ($limit =~ /[0-9]/ && $limit !~ /LIMIT/) {
$limit = "LIMIT $limit";
}
}
&_debug("SELECT $column FROM $table $where;");
if ($column =~ /\,/) {
my $stat = $db->prepare("SELECT $column FROM $table $where $order $limit;");
$stat->execute();
if ($db_driver eq "odbc") {
# this is a dirty fix, as it only checks the first 3 columns for encoding problems
my @data = $stat->fetchrow_array();
if ($db_driver_odbc_encode_get) {
for (my $i = 0; $i < 9; $i++) {
$data[$i] = ONO::Lib::Encoding::ODBC->decode($data[$i]);
if ($data[$i] =~ /(Ã)/) {
Encode::from_to($data[$i],'utf-8','cp1252');
}
}
}
return @data;
} else {
return $stat->fetchrow_array();
}
$stat->finish();
} else {
my $stat = $db->prepare("SELECT $column FROM $table $where $order $limit;");
$stat->execute();
my $data = $stat->fetchrow_array();
$stat->finish();
if ($db_driver eq "odbc") {
$data = ONO::Lib::Encoding::ODBC->decode($data);
if ($data =~ /(Ã)/ && $db_driver_odbc_encode_get) {
Encode::from_to($data,'utf-8','cp1252');
}
}
return $data;
}
}
sub get_highest_primkey {
#: Detect the highest primary key in a table.
#: Also see get_next_primkey() and get_auto_inc().
my (
$self,
$db,
$primkey,
$table,
$where,
) = @_;
$table = &clean("",$table);
my $WHERE = &_where($where);
$primkey =~ s~[^A-Za-z0-9\_\-\,]~~g;
my $return = 0;
my $stat = $db->prepare("SELECT $primkey FROM $table $WHERE;");
$stat->execute();
while (my @row = $stat->fetchrow_array()) {
if ($row[0] > $return) {
$return = $row[0];
}
}
$stat->finish();
return $return;
}
sub get_next_primkey {
#: Detect the next primary key that can be used in a table.
#: Also see get_highest_primkey() and get_auto_inc().
return &get_highest_primkey("",$_[1],$_[2],$_[3])+1;
}
sub get_auto_inc {
#: Get the next automatic increment id from a table.
#: Also see get_highest_primkey() and get_next_primkey().
my ($self,$db,$table) = @_;
$table = &clean("",$table);
my $stat = $db->prepare("SELECT AUTO_INCREMENT FROM INFORMATION_SCHEMA.TABLES WHERE TABLE_SCHEMA = DATABASE() AND TABLE_NAME = '$table';");
$stat-> execute();
return $stat->fetchrow_array();
}
sub update_timestamp_string {
#: Generated the string required to update username and timestamp in
#: ONO standard SQL tables.
my $user = lc $_[1];
my $timestamp = time();
$user =~ s~[^a-z0-9]~~g;
return "modification_username = '$user', modification_timestamp = '$timestamp'";
}
sub update_timestamp {
#: Update columns modification_username and modification_timestamp
#: with current data.
my ($self,$db,$table,$record,$user) = @_;
$table = &clean("",$table);
if ($table && $record =~ /=/ && $user) {
my $WHERE = &_where($record);
my $TIME = &update_timestamp_string("",$user);
my $command = qq~UPDATE $table SET $TIME $WHERE;~;
my $stat = $db->prepare("$command");
$stat->execute();
$stat->finish();
&_debug($command);
return $command;
}
}
sub delete {
#: Delete a table row / record.
my ($self,$db,$table,$where) = @_;
$table = &clean("",$table);
if ($where =~ /=/) {
my $WHERE = &_where($where);
my $command = qq~DELETE FROM $table $WHERE;~;
my $stat = $db->prepare("$command");
$stat->execute();
$stat->finish();
&_debug($command);
return $command;
}
}
sub describe_table {
#: Return the names of all table columns as an array.
#: The driver (MySQL or ODBC) is being automatically detected,
#: but you may also force using ODBC by indicating it manually.
my ($self,$db,$table,$driver) = @_;
$table =~ s~[^A-Za-z0-9\_]~~g;
my $SQL = "DESCRIBE $table";
if ("$driver$db_driver" =~ /odbc/i) {
$SQL = "SELECT COLUMN_NAME,DATA_TYPE,CHARACTER_MAXIMUM_LENGTH FROM information_schema.COLUMNS WHERE TABLE_NAME = '$table' ORDER BY ORDINAL_POSITION";
}
&_debug($SQL);
my @columns;
my $stat = $db->prepare($SQL);
$stat->execute();
while (my @row = $stat->fetchrow_array()) {
@columns = (@columns,\@row);
}
$stat->finish();
return @columns;
}
sub connection_error {
#: Error message to be displayed in case of a connection error.
my ($self,$db,$mode,$lang,$test) = @_;
my $ERR;
if (!$db || $test) {
$mode = "database_connection_error";
$ERR = qq~<div class="box_red w80 auto">
<h2>Ooops...</h2>
<div class="box_paper large">
<div class="mb10">I seems that we're experiencing technical difficulties right now...</div>
<div class="mb10 bold">Please try again in a few minutes - thanks !</div>
<div>Sorry for the inconvenience :/</div>
</div>
<div class="large mt10">Error: ONO/DB connection failure</div>
</div>
~;
}
return ($ERR,$mode);
}
sub query_umlaut {
#: Umlaut compatibility for ODBC databases.
#: Simply processes and returns the string.
my $query = $_[1];
if ($db_driver eq "odbc") {
$query =~ s~(Ä|Ë|Ü|Ö|ä|à|â|ë|é|è|ê|ü|û|ö|ô|ï|î|ç|ß)~__~g;
}
return $query;
}
sub _where {
#: Internal function used to pre-process WHERE clause data.
my $select = $_[0];
$select =~ s~ =~=~g;
$select =~ s~= ~=~g;
my $WHERE;
if ($select =~ /=/ && $select =~ /\,/ && $select !~ / IN\(/) {
$select = qq~ AND $select~;
my @parts = split(/ AND /,$select);
foreach my $part (@parts) {
if ($part =~ /=/) {
my @sel_parts = split(/=/,$part);
$sel_parts[0] =~ s~('|`)~~g;
$sel_parts[1] =~ s~('|`)~~g;
$WHERE .= qq~ AND $sel_parts[0] = '$sel_parts[1]'~;
}
}
$WHERE =~ s~ AND ~ WHERE ~;
} else {
$WHERE = $select;
}
if ($WHERE =~ /[A-Za-z0-9]/ && $WHERE !~ /WHERE/) {
$WHERE = "WHERE $WHERE";
}
return $WHERE;
}
###############################################################################
# end of script
###############################################################################
1;
__END__