Diff -- /var/www/vhosts/3dshawn.com/site1/MODS/DBConnect.pm

O Operator
Diff

/var/www/vhosts/3dshawn.com/site1/MODS/DBConnect.pm

added on local at 2026-07-10 18:57:30

Added
+218
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to 715820688cd8
Unified diff
Naive LCS-based line diff. Additions in emerald, deletions in rose. Both sides decompressed live from BLOB_STORE.
1package MODS::DBConnect;
2#======================================================================
3# DriftSense -- MySQL/SQLite connection wrapper.
4#
5# Adapted from the portfolio's unified DBConnect.pm (2026-07-10) so the
6# same idioms apply everywhere. Credentials come from MODS::Config
7# (which reads /etc/drift_sense/drift_sense.conf) so this file has NO
8# baked-in secrets and ships identically across all customer installs.
9#
10# Public API:
11# $dbh = $db->db_connect
12# $db->db_disconnect($dbh)
13# $db->set_session_timezone($dbh, $tz) # SET time_zone
14# $hashref = $db->db_readwrite($dbh, $sql, __FILE__, __LINE__)
15# @rows = $db->db_readwrite_multiple($dbh, $sql, __FILE__, __LINE__)
16# $sth = $db->db_query($dbh, $sql, @binds) # placeholder helper
17# $bool = $db->ping($dbh)
18# $csv = $db->quote_list($dbh, \@vals)
19# $code = MODS::DBConnect::generate($n)
20#
21# Any db_readwrite / _multiple statement failure calls error() which
22# writes a structured entry to the on-disk error log AND prints a
23# marker to STDERR AND exits. Strict canary behavior -- bad SQL kills
24# the request loud instead of failing silently.
25#======================================================================
26use strict;
27use warnings;
28use DBI;
29use MODS::Config;
30
31my $cfg = MODS::Config->new;
32
33sub new { return bless({}, shift); }
34
35#---------------------------------------------------------------------
36# db_connect -- open a DBI handle to the configured DB. Reads engine +
37# credentials from MODS::Config at call time so a config change picks
38# up on next connect without restarting the process.
39#---------------------------------------------------------------------
40sub db_connect {
41 my $self = shift;
42 my $engine = $cfg->settings('db_engine') || 'mysql';
43
44 my $dbh;
45 if ($engine eq 'sqlite') {
46 my $path = $cfg->settings('sqlite_path') || '/var/lib/drift_sense/drift_sense.db';
47 $dbh = DBI->connect("DBI:SQLite:dbname=$path", '', '', {
48 PrintError => 0, RaiseError => 0, AutoCommit => 1,
49 });
50 return undef unless $dbh;
51 # Sensible SQLite defaults
52 eval { $dbh->do("PRAGMA journal_mode = WAL") };
53 eval { $dbh->do("PRAGMA foreign_keys = ON") };
54 } else {
55 my $host = $cfg->settings('db_host') || 'localhost';
56 my $port = $cfg->settings('db_port') || 3306;
57 my $name = $cfg->settings('db_name') || 'drift_sense';
58 my $user = $cfg->settings('db_user') || 'drift_sense';
59 my $pass = $cfg->settings('db_password') || '';
60
61 my $dsn = "DBI:mysql:$name:$host:$port";
62 $dbh = DBI->connect($dsn, $user, $pass, {
63 PrintError => 0,
64 RaiseError => 0,
65 AutoCommit => 1,
66 mysql_connect_timeout => 5,
67 mysql_enable_utf8mb4 => 1,
68 });
69 return undef unless $dbh;
70 eval { $dbh->do("SET NAMES utf8mb4") };
71
72 # Session timezone: honor the viewer's IANA tz if MODS::Login
73 # has cached one (matches portfolio pattern).
74 if (defined $MODS::Login::CURRENT_USER_TZ && length $MODS::Login::CURRENT_USER_TZ) {
75 my $tz = $MODS::Login::CURRENT_USER_TZ;
76 $tz =~ s/[^A-Za-z0-9_+\-:\/]//g;
77 if (length $tz) {
78 my $ok = eval { $dbh->do("SET time_zone = " . $dbh->quote($tz)) };
79 if (!$ok || $@) {
80 eval { $dbh->do("SET time_zone = '+00:00'") };
81 }
82 }
83 }
84 }
85 return $dbh;
86}
87
88sub set_session_timezone {
89 my ($self, $dbh, $tz) = @_;
90 return unless $dbh;
91 $tz = 'UTC' unless defined $tz && length $tz;
92 $tz =~ s/[^A-Za-z0-9_+\-:\/]//g;
93 $tz = 'UTC' unless length $tz;
94 my $ok = eval { $dbh->do("SET time_zone = " . $dbh->quote($tz)) };
95 if (!$ok || $@) {
96 eval { $dbh->do("SET time_zone = '+00:00'") };
97 }
98 return 1;
99}
100
101sub db_readwrite {
102 my ($self, $dbh, $sql, $script_name, $error_line, $prevent_looping) = @_;
103 my $data;
104
105 my $sth = $dbh->prepare($sql);
106 unless ($sth) {
107 return error($self, $dbh, $script_name, $error_line, $sql, $prevent_looping);
108 }
109 my $rows_affected = $sth->execute;
110 unless ($rows_affected) {
111 $rows_affected = $sth->execute; # one retry for transient blips
112 }
113 unless ($rows_affected) {
114 return error($self, $dbh, $script_name, $error_line, $sql, $prevent_looping);
115 }
116
117 if ($sql =~ m/^\s*\t*(explain|select|show)/i) {
118 $data = $sth->fetchrow_hashref;
119 }
120 $data->{mysql_insertid} = $sth->{mysql_insertid} if $sth->{mysql_insertid};
121 $data->{rows_affected} = $rows_affected if $rows_affected;
122
123 $sth->finish;
124 return $data;
125}
126
127sub db_readwrite_multiple {
128 my ($self, $dbh, $sql, $script_name, $error_line, $nospaces) = @_;
129 my @data;
130
131 my $sth = $dbh->prepare($sql);
132 unless ($sth) {
133 return error($self, $dbh, $script_name, $error_line, $sql);
134 }
135 unless ($sth->execute) {
136 return error($self, $dbh, $script_name, $error_line, $sql);
137 }
138 if ($sql =~ m/^\s*\t*(explain|select|show)/i) {
139 while (my $row = $sth->fetchrow_hashref) { push @data, $row; }
140 }
141 $sth->finish;
142 return wantarray ? @data : \@data;
143}
144
145sub db_query {
146 my ($self, $dbh, $sql, @binds) = @_;
147 my $sth = $dbh->prepare($sql) or return undef;
148 return undef unless $sth->execute(@binds);
149 return $sth;
150}
151
152sub ping {
153 my ($self, $dbh) = @_;
154 return 0 unless $dbh;
155 my $r = eval { $dbh->selectrow_array("SELECT 1") };
156 return ($r && !$@) ? 1 : 0;
157}
158
159sub quote_list {
160 my ($self, $dbh, $vals) = @_;
161 return "''" unless $vals && ref($vals) eq 'ARRAY' && @$vals;
162 return join(',', map { $dbh->quote($_) } @$vals);
163}
164
165sub db_disconnect {
166 my ($self, $dbh) = @_;
167 return unless $dbh;
168 eval { $dbh->disconnect };
169 return 1;
170}
171
172sub generate {
173 my $code_length = shift;
174 my $code = '';
175 my @chars = ('a'..'z','A'..'Z','0'..'9');
176 for (1..$code_length) { $code .= $chars[rand @chars]; }
177 return $code;
178}
179
180#---------------------------------------------------------------------
181# error -- structured logging + STDERR + exit. Log path is
182# configurable; defaults to /var/log/drift_sense/db_errors.log.
183#---------------------------------------------------------------------
184sub error {
185 my ($self, $dbh, $script_name, $error_line, $application_sql, $prevent_looping) = @_;
186
187 my $log_path = $cfg->settings('db_error_log') || '/var/log/drift_sense/db_errors.log';
188
189 my $unique_id = generate(15) . '_' . time();
190 my $ltime = localtime();
191
192 my $dbi_err = '';
193 if (ref($dbh) && $dbh->can('errstr')) {
194 $dbi_err = $dbh->errstr // '';
195 }
196 $dbi_err ||= $DBI::errstr // '';
197 $dbi_err = '(no DBI error reported)' unless length $dbi_err;
198
199 if (open(my $log_fh, '>>', $log_path)) {
200 print $log_fh qq~----- UNIQUE ID:($unique_id) -----\n~;
201 print $log_fh qq~Date: $ltime\n~;
202 print $log_fh qq~File: $script_name\n~;
203 print $log_fh qq~Line: $error_line\n~;
204 print $log_fh qq~DBI: $dbi_err\n~;
205 print $log_fh qq~SQL:\n$application_sql\n\n~;
206 close $log_fh;
207 }
208
209 my $sql_copy = $application_sql;
210 $sql_copy =~ s/\s+/ /g;
211 $sql_copy =~ s/\n$//g;
212 print STDERR qq~-----DB_MODULE_ERROR----- UNIQUE ID:($unique_id) LINE:($error_line) FILE:($script_name) SQL:($sql_copy)\n~;
213
214 print qq~@_~;
215 exit;
216}
217
2181;