Diff -- /var/www/vhosts/3dshawn.com/crm.3dshawn.com/MODS/ContactForge/SEO.pm

O Operator
Diff

/var/www/vhosts/3dshawn.com/crm.3dshawn.com/MODS/ContactForge/SEO.pm

added on local at 2026-07-01 15:02:55

Added
+0
lines
Removed
-0
lines
Context
233
unchanged
Blobs
from abb238726b56
to abb238726b56
Restore this content →
Unified diff
Naive LCS-based line diff. Additions in emerald, deletions in rose. Both sides decompressed live from BLOB_STORE.
11package MODS::ContactForge::SEO;
22#======================================================================
33# ContactForge - SEO + Open Graph + Twitter Card helper.
44#
55# Two scopes:
66# - dashboard SEO: per-row columns on the dashboards table
77# (seo_title, seo_description, seo_keywords, ...)
88# - platform SEO: rows in platform_settings keyed by setting_key
99# ('seo.title', 'seo.description', ...)
1010#
1111# render_tags() builds the <meta> block (title + description + OG +
1212# twitter) the wrapper template injects into <head>. Sensible fallbacks
1313# at every layer so a brand-new dashboard still emits good defaults.
1414#
1515# Every query is guarded with information_schema checks because the
1616# platform_settings table and the new dashboards.seo_* columns may
1717# not be present yet on early-adopter accounts -- DBConnect's error()
1818# calls exit() so we ALWAYS check schema before reading.
1919#======================================================================
2020use strict;
2121use warnings;
2222
2323sub new {
2424 my ($class, %args) = @_;
2525 return bless({}, $class);
2626}
2727
2828# ---- Schema readiness ------------------------------------------------
2929sub platform_settings_ready {
3030 my ($self, $db, $dbh, $DB) = @_;
3131 my $r = $db->db_readwrite($dbh, qq~
3232 SELECT COUNT(*) AS n FROM information_schema.tables
3333 WHERE table_schema='$DB' AND table_name='platform_settings'
3434 ~, $ENV{SCRIPT_NAME}, __LINE__);
3535 return ($r && $r->{n}) ? 1 : 0;
3636}
3737
3838sub dashboard_seo_ready {
3939 my ($self, $db, $dbh, $DB) = @_;
4040 my $r = $db->db_readwrite($dbh, qq~
4141 SELECT COUNT(*) AS n FROM information_schema.columns
4242 WHERE table_schema='$DB' AND table_name='dashboards'
4343 AND column_name='seo_title'
4444 ~, $ENV{SCRIPT_NAME}, __LINE__);
4545 return ($r && $r->{n}) ? 1 : 0;
4646}
4747
4848# ---- Platform-wide SEO ----------------------------------------------
4949# Returns a hash of every seo.* setting. Missing keys come back as
5050# undef so callers can apply per-key fallbacks.
5151sub get_platform_settings {
5252 my ($self, $db, $dbh, $DB) = @_;
5353 return {} unless $self->platform_settings_ready($db, $dbh, $DB);
5454 my @rows = $db->db_readwrite_multiple($dbh, qq~
5555 SELECT setting_key, setting_value
5656 FROM `${DB}`.platform_settings
5757 WHERE setting_key LIKE 'seo.%'
5858 ~, $ENV{SCRIPT_NAME}, __LINE__);
5959 my %out;
6060 foreach my $r (@rows) {
6161 $out{ $r->{setting_key} } = $r->{setting_value};
6262 }
6363 return \%out;
6464}
6565
6666sub set_platform_setting {
6767 my ($self, $db, $dbh, $DB, $key, $value, $actor_uid) = @_;
6868 return 0 unless $key;
6969 return 0 unless $self->platform_settings_ready($db, $dbh, $DB);
7070
7171 # Sanitize the key - dotted lowercase + alphanumeric/underscore only.
7272 $key =~ s/[^a-z0-9._]//g;
7373 $key = substr($key, 0, 120);
7474 return 0 unless length $key;
7575
7676 # SQL-escape the value as a single-quoted string.
7777 my $sv = defined $value ? $value : '';
7878 $sv =~ s/'/''/g;
7979
8080 my $actor = defined $actor_uid ? $actor_uid : '';
8181 $actor =~ s/[^0-9]//g;
8282 my $actor_sql = $actor eq '' ? 'NULL' : "'$actor'";
8383
8484 # UPSERT: insert, or update on duplicate key.
8585 $db->db_readwrite($dbh, qq~
8686 INSERT INTO `${DB}`.platform_settings
8787 SET setting_key='$key',
8888 setting_value='$sv',
8989 updated_by_user_id=$actor_sql
9090 ON DUPLICATE KEY UPDATE
9191 setting_value='$sv',
9292 updated_by_user_id=$actor_sql
9393 ~, $ENV{SCRIPT_NAME}, __LINE__);
9494 return 1;
9595}
9696
9797# ---- Per-dashboard SEO ---------------------------------------------
9898sub get_dashboard_seo {
9999 my ($self, $db, $dbh, $DB, $dashboard_id) = @_;
100100 $dashboard_id =~ s/[^0-9]//g;
101101 return {} unless $dashboard_id;
102102 return {} unless $self->dashboard_seo_ready($db, $dbh, $DB);
103103
104104 my $r = $db->db_readwrite($dbh, qq~
105105 SELECT id, name, tagline, subdomain, hero_image_1,
106106 seo_title, seo_description, seo_keywords,
107107 seo_canonical_url, seo_og_image,
108108 seo_robots_index, seo_twitter_card, seo_twitter_site
109109 FROM `${DB}`.dashboards
110110 WHERE id='$dashboard_id'
111111 LIMIT 1
112112 ~, $ENV{SCRIPT_NAME}, __LINE__);
113113 return ($r && $r->{id}) ? $r : {};
114114}
115115
116116sub update_dashboard_seo {
117117 my ($self, $db, $dbh, $DB, $dashboard_id, %a) = @_;
118118 $dashboard_id =~ s/[^0-9]//g;
119119 return 0 unless $dashboard_id;
120120 return 0 unless $self->dashboard_seo_ready($db, $dbh, $DB);
121121
122122 my $title = _trim($a{seo_title}, 160);
123123 my $desc = _trim($a{seo_description}, 320);
124124 my $kw = _trim($a{seo_keywords}, 255);
125125 my $canon = _trim($a{seo_canonical_url}, 255);
126126 my $og = _trim($a{seo_og_image}, 255);
127127 my $tsite = _trim($a{seo_twitter_site}, 64);
128128 my $robots = ($a{seo_robots_index} && $a{seo_robots_index} ne '0') ? 1 : 0;
129129
130130 my $card = $a{seo_twitter_card} || 'summary_large_image';
131131 my %card_ok = (summary => 1, summary_large_image => 1);
132132 $card = 'summary_large_image' unless $card_ok{$card};
133133
134134 my $q_title = _qstr($title);
135135 my $q_desc = _qstr($desc);
136136 my $q_kw = _qstr($kw);
137137 my $q_canon = _qstr($canon);
138138 my $q_og = _qstr($og);
139139 my $q_tsite = _qstr($tsite);
140140
141141 $db->db_readwrite($dbh, qq~
142142 UPDATE `${DB}`.dashboards
143143 SET seo_title=$q_title,
144144 seo_description=$q_desc,
145145 seo_keywords=$q_kw,
146146 seo_canonical_url=$q_canon,
147147 seo_og_image=$q_og,
148148 seo_robots_index='$robots',
149149 seo_twitter_card='$card',
150150 seo_twitter_site=$q_tsite
151151 WHERE id='$dashboard_id'
152152 ~, $ENV{SCRIPT_NAME}, __LINE__);
153153 return 1;
154154}
155155
156156# ---- Tag rendering ---------------------------------------------------
157157# Builds the head <meta> block for either:
158158# - a dashboard page (pass dashboard row + page title)
159159# - the platform dashboard / marketing pages (pass undef for store,
160160# and we draw entirely from platform_settings + fallback title)
161161#
162162# Returns an HTML string ready to drop into <head>.
163163sub render_tags {
164164 my ($self, %a) = @_;
165165 my $store = $a{dashboard} || {}; # dashboard row from get_dashboard_seo()
166166 my $platform = $a{platform} || {}; # hash from get_platform_settings()
167167 my $page_title = $a{page_title} || '';
168168 my $request_url = $a{request_url} || '';
169169
170170 # Compute effective values with this priority:
171171 # dashboard override > dashboard defaults > platform > page_title
172172 my $title = $store->{seo_title} || $store->{name} || $page_title || $platform->{'seo.title'} || 'ContactForge';
173173 my $description = $store->{seo_description} || $store->{tagline} || $platform->{'seo.description'} || '';
174174 my $keywords = $store->{seo_keywords} || $platform->{'seo.keywords'} || '';
175175 my $canonical = $store->{seo_canonical_url} || $request_url || '';
176176 my $og_image = $store->{seo_og_image} || $store->{hero_image_1} || $platform->{'seo.og_image'} || '';
177177 my $og_site = $platform->{'seo.og_site_name'} || 'ContactForge';
178178 my $twit_card = $store->{seo_twitter_card}|| $platform->{'seo.twitter_card'} || 'summary_large_image';
179179 my $twit_site = $store->{seo_twitter_site}|| $platform->{'seo.twitter_site'} || '';
180180
181181 # robots_index: 1 = index,follow. 0 = noindex,nofollow.
182182 # If dashboard override is explicit 0, honor it; otherwise platform default.
183183 my $robots_on = 1;
184184 if (defined $store->{seo_robots_index}) {
185185 $robots_on = $store->{seo_robots_index} ? 1 : 0;
186186 } elsif (defined $platform->{'seo.robots_index'} && $platform->{'seo.robots_index'} eq '0') {
187187 $robots_on = 0;
188188 }
189189 my $robots_str = $robots_on ? 'index,follow' : 'noindex,nofollow';
190190
191191 # HTML-escape every field that lands inside an attribute.
192192 foreach ($title, $description, $keywords, $canonical, $og_image, $og_site, $twit_card, $twit_site) {
193193 $_ = '' unless defined $_;
194194 s/&/&amp;/g; s/</&lt;/g; s/>/&gt;/g; s/"/&quot;/g;
195195 }
196196
197197 my $h = '';
198198 $h .= qq~ <meta name="description" content="$description">\n~ if length $description;
199199 $h .= qq~ <meta name="keywords" content="$keywords">\n~ if length $keywords;
200200 $h .= qq~ <meta name="robots" content="$robots_str">\n~;
201201 $h .= qq~ <link rel="canonical" href="$canonical">\n~ if length $canonical;
202202 $h .= qq~ <meta property="og:title" content="$title">\n~;
203203 $h .= qq~ <meta property="og:description" content="$description">\n~ if length $description;
204204 $h .= qq~ <meta property="og:type" content="website">\n~;
205205 $h .= qq~ <meta property="og:site_name" content="$og_site">\n~ if length $og_site;
206206 $h .= qq~ <meta property="og:image" content="$og_image">\n~ if length $og_image;
207207 $h .= qq~ <meta property="og:url" content="$canonical">\n~ if length $canonical;
208208 $h .= qq~ <meta name="twitter:card" content="$twit_card">\n~;
209209 $h .= qq~ <meta name="twitter:title" content="$title">\n~;
210210 $h .= qq~ <meta name="twitter:description" content="$description">\n~ if length $description;
211211 $h .= qq~ <meta name="twitter:image" content="$og_image">\n~ if length $og_image;
212212 $h .= qq~ <meta name="twitter:site" content="$twit_site">\n~ if length $twit_site;
213213 return $h;
214214}
215215
216216# ---- Internal --------------------------------------------------------
217217sub _trim {
218218 my ($s, $max) = @_;
219219 return '' unless defined $s;
220220 $s =~ s/^\s+|\s+$//g;
221221 $s =~ s/[\r\n]+/ /g;
222222 $max ||= 255;
223223 return substr($s, 0, $max);
224224}
225225
226226sub _qstr {
227227 my $s = shift;
228228 return 'NULL' unless defined $s && length $s;
229229 $s =~ s/'/''/g;
230230 return "'$s'";
231231}
232232
2332331;