added on local at 2026-07-01 16:01:29
| 1 | package MODS::ABForge::SEO; | |
| 2 | #====================================================================== | |
| 3 | # ABForge - SEO + Open Graph + Twitter Card helper. | |
| 4 | # | |
| 5 | # Two scopes: | |
| 6 | # - storefront SEO: per-row columns on the storefronts table | |
| 7 | # (seo_title, seo_description, seo_keywords, ...) | |
| 8 | # - platform SEO: rows in platform_settings keyed by setting_key | |
| 9 | # ('seo.title', 'seo.description', ...) | |
| 10 | # | |
| 11 | # render_tags() builds the <meta> block (title + description + OG + | |
| 12 | # twitter) the wrapper template injects into <head>. Sensible fallbacks | |
| 13 | # at every layer so a brand-new storefront still emits good defaults. | |
| 14 | # | |
| 15 | # Every query is guarded with information_schema checks because the | |
| 16 | # platform_settings table and the new storefronts.seo_* columns may | |
| 17 | # not be present yet on early-adopter accounts -- DBConnect's error() | |
| 18 | # calls exit() so we ALWAYS check schema before reading. | |
| 19 | #====================================================================== | |
| 20 | use strict; | |
| 21 | use warnings; | |
| 22 | ||
| 23 | sub new { | |
| 24 | my ($class, %args) = @_; | |
| 25 | return bless({}, $class); | |
| 26 | } | |
| 27 | ||
| 28 | # ---- Schema readiness ------------------------------------------------ | |
| 29 | sub platform_settings_ready { | |
| 30 | my ($self, $db, $dbh, $DB) = @_; | |
| 31 | my $r = $db->db_readwrite($dbh, qq~ | |
| 32 | SELECT COUNT(*) AS n FROM information_schema.tables | |
| 33 | WHERE table_schema='$DB' AND table_name='platform_settings' | |
| 34 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 35 | return ($r && $r->{n}) ? 1 : 0; | |
| 36 | } | |
| 37 | ||
| 38 | sub storefront_seo_ready { | |
| 39 | my ($self, $db, $dbh, $DB) = @_; | |
| 40 | my $r = $db->db_readwrite($dbh, qq~ | |
| 41 | SELECT COUNT(*) AS n FROM information_schema.columns | |
| 42 | WHERE table_schema='$DB' AND table_name='storefronts' | |
| 43 | AND column_name='seo_title' | |
| 44 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 45 | return ($r && $r->{n}) ? 1 : 0; | |
| 46 | } | |
| 47 | ||
| 48 | # ---- Platform-wide SEO ---------------------------------------------- | |
| 49 | # Returns a hash of every seo.* setting. Missing keys come back as | |
| 50 | # undef so callers can apply per-key fallbacks. | |
| 51 | sub get_platform_settings { | |
| 52 | my ($self, $db, $dbh, $DB) = @_; | |
| 53 | return {} unless $self->platform_settings_ready($db, $dbh, $DB); | |
| 54 | my @rows = $db->db_readwrite_multiple($dbh, qq~ | |
| 55 | SELECT setting_key, setting_value | |
| 56 | FROM `${DB}`.platform_settings | |
| 57 | WHERE setting_key LIKE 'seo.%' | |
| 58 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 59 | my %out; | |
| 60 | foreach my $r (@rows) { | |
| 61 | $out{ $r->{setting_key} } = $r->{setting_value}; | |
| 62 | } | |
| 63 | return \%out; | |
| 64 | } | |
| 65 | ||
| 66 | sub set_platform_setting { | |
| 67 | my ($self, $db, $dbh, $DB, $key, $value, $actor_uid) = @_; | |
| 68 | return 0 unless $key; | |
| 69 | return 0 unless $self->platform_settings_ready($db, $dbh, $DB); | |
| 70 | ||
| 71 | # Sanitize the key - dotted lowercase + alphanumeric/underscore only. | |
| 72 | $key =~ s/[^a-z0-9._]//g; | |
| 73 | $key = substr($key, 0, 120); | |
| 74 | return 0 unless length $key; | |
| 75 | ||
| 76 | # SQL-escape the value as a single-quoted string. | |
| 77 | my $sv = defined $value ? $value : ''; | |
| 78 | $sv =~ s/'/''/g; | |
| 79 | ||
| 80 | my $actor = defined $actor_uid ? $actor_uid : ''; | |
| 81 | $actor =~ s/[^0-9]//g; | |
| 82 | my $actor_sql = $actor eq '' ? 'NULL' : "'$actor'"; | |
| 83 | ||
| 84 | # UPSERT: insert, or update on duplicate key. | |
| 85 | $db->db_readwrite($dbh, qq~ | |
| 86 | INSERT INTO `${DB}`.platform_settings | |
| 87 | SET setting_key='$key', | |
| 88 | setting_value='$sv', | |
| 89 | updated_by_user_id=$actor_sql | |
| 90 | ON DUPLICATE KEY UPDATE | |
| 91 | setting_value='$sv', | |
| 92 | updated_by_user_id=$actor_sql | |
| 93 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 94 | return 1; | |
| 95 | } | |
| 96 | ||
| 97 | # ---- Per-storefront SEO --------------------------------------------- | |
| 98 | sub get_storefront_seo { | |
| 99 | my ($self, $db, $dbh, $DB, $storefront_id) = @_; | |
| 100 | $storefront_id =~ s/[^0-9]//g; | |
| 101 | return {} unless $storefront_id; | |
| 102 | return {} unless $self->storefront_seo_ready($db, $dbh, $DB); | |
| 103 | ||
| 104 | my $r = $db->db_readwrite($dbh, qq~ | |
| 105 | SELECT id, name, tagline, subdomain, hero_image_1, | |
| 106 | seo_title, seo_description, seo_keywords, | |
| 107 | seo_canonical_url, seo_og_image, | |
| 108 | seo_robots_index, seo_twitter_card, seo_twitter_site | |
| 109 | FROM `${DB}`.storefronts | |
| 110 | WHERE id='$storefront_id' | |
| 111 | LIMIT 1 | |
| 112 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 113 | return ($r && $r->{id}) ? $r : {}; | |
| 114 | } | |
| 115 | ||
| 116 | sub update_storefront_seo { | |
| 117 | my ($self, $db, $dbh, $DB, $storefront_id, %a) = @_; | |
| 118 | $storefront_id =~ s/[^0-9]//g; | |
| 119 | return 0 unless $storefront_id; | |
| 120 | return 0 unless $self->storefront_seo_ready($db, $dbh, $DB); | |
| 121 | ||
| 122 | my $title = _trim($a{seo_title}, 160); | |
| 123 | my $desc = _trim($a{seo_description}, 320); | |
| 124 | my $kw = _trim($a{seo_keywords}, 255); | |
| 125 | my $canon = _trim($a{seo_canonical_url}, 255); | |
| 126 | my $og = _trim($a{seo_og_image}, 255); | |
| 127 | my $tsite = _trim($a{seo_twitter_site}, 64); | |
| 128 | my $robots = ($a{seo_robots_index} && $a{seo_robots_index} ne '0') ? 1 : 0; | |
| 129 | ||
| 130 | my $card = $a{seo_twitter_card} || 'summary_large_image'; | |
| 131 | my %card_ok = (summary => 1, summary_large_image => 1); | |
| 132 | $card = 'summary_large_image' unless $card_ok{$card}; | |
| 133 | ||
| 134 | my $q_title = _qstr($title); | |
| 135 | my $q_desc = _qstr($desc); | |
| 136 | my $q_kw = _qstr($kw); | |
| 137 | my $q_canon = _qstr($canon); | |
| 138 | my $q_og = _qstr($og); | |
| 139 | my $q_tsite = _qstr($tsite); | |
| 140 | ||
| 141 | $db->db_readwrite($dbh, qq~ | |
| 142 | UPDATE `${DB}`.storefronts | |
| 143 | SET seo_title=$q_title, | |
| 144 | seo_description=$q_desc, | |
| 145 | seo_keywords=$q_kw, | |
| 146 | seo_canonical_url=$q_canon, | |
| 147 | seo_og_image=$q_og, | |
| 148 | seo_robots_index='$robots', | |
| 149 | seo_twitter_card='$card', | |
| 150 | seo_twitter_site=$q_tsite | |
| 151 | WHERE id='$storefront_id' | |
| 152 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 153 | return 1; | |
| 154 | } | |
| 155 | ||
| 156 | # ---- Tag rendering --------------------------------------------------- | |
| 157 | # Builds the head <meta> block for either: | |
| 158 | # - a storefront page (pass storefront row + page title) | |
| 159 | # - the platform dashboard / marketing pages (pass undef for store, | |
| 160 | # and we draw entirely from platform_settings + fallback title) | |
| 161 | # | |
| 162 | # Returns an HTML string ready to drop into <head>. | |
| 163 | sub render_tags { | |
| 164 | my ($self, %a) = @_; | |
| 165 | my $store = $a{storefront} || {}; # storefront row from get_storefront_seo() | |
| 166 | my $platform = $a{platform} || {}; # hash from get_platform_settings() | |
| 167 | my $page_title = $a{page_title} || ''; | |
| 168 | my $request_url = $a{request_url} || ''; | |
| 169 | ||
| 170 | # Compute effective values with this priority: | |
| 171 | # storefront override > storefront defaults > platform > page_title | |
| 172 | my $title = $store->{seo_title} || $store->{name} || $page_title || $platform->{'seo.title'} || 'ABForge'; | |
| 173 | my $description = $store->{seo_description} || $store->{tagline} || $platform->{'seo.description'} || ''; | |
| 174 | my $keywords = $store->{seo_keywords} || $platform->{'seo.keywords'} || ''; | |
| 175 | my $canonical = $store->{seo_canonical_url} || $request_url || ''; | |
| 176 | my $og_image = $store->{seo_og_image} || $store->{hero_image_1} || $platform->{'seo.og_image'} || ''; | |
| 177 | my $og_site = $platform->{'seo.og_site_name'} || 'ABForge'; | |
| 178 | my $twit_card = $store->{seo_twitter_card}|| $platform->{'seo.twitter_card'} || 'summary_large_image'; | |
| 179 | my $twit_site = $store->{seo_twitter_site}|| $platform->{'seo.twitter_site'} || ''; | |
| 180 | ||
| 181 | # robots_index: 1 = index,follow. 0 = noindex,nofollow. | |
| 182 | # If storefront override is explicit 0, honor it; otherwise platform default. | |
| 183 | my $robots_on = 1; | |
| 184 | if (defined $store->{seo_robots_index}) { | |
| 185 | $robots_on = $store->{seo_robots_index} ? 1 : 0; | |
| 186 | } elsif (defined $platform->{'seo.robots_index'} && $platform->{'seo.robots_index'} eq '0') { | |
| 187 | $robots_on = 0; | |
| 188 | } | |
| 189 | my $robots_str = $robots_on ? 'index,follow' : 'noindex,nofollow'; | |
| 190 | ||
| 191 | # HTML-escape every field that lands inside an attribute. | |
| 192 | foreach ($title, $description, $keywords, $canonical, $og_image, $og_site, $twit_card, $twit_site) { | |
| 193 | $_ = '' unless defined $_; | |
| 194 | s/&/&/g; s/</</g; s/>/>/g; s/"/"/g; | |
| 195 | } | |
| 196 | ||
| 197 | my $h = ''; | |
| 198 | $h .= qq~ <meta name="description" content="$description">\n~ if length $description; | |
| 199 | $h .= qq~ <meta name="keywords" content="$keywords">\n~ if length $keywords; | |
| 200 | $h .= qq~ <meta name="robots" content="$robots_str">\n~; | |
| 201 | $h .= qq~ <link rel="canonical" href="$canonical">\n~ if length $canonical; | |
| 202 | $h .= qq~ <meta property="og:title" content="$title">\n~; | |
| 203 | $h .= qq~ <meta property="og:description" content="$description">\n~ if length $description; | |
| 204 | $h .= qq~ <meta property="og:type" content="website">\n~; | |
| 205 | $h .= qq~ <meta property="og:site_name" content="$og_site">\n~ if length $og_site; | |
| 206 | $h .= qq~ <meta property="og:image" content="$og_image">\n~ if length $og_image; | |
| 207 | $h .= qq~ <meta property="og:url" content="$canonical">\n~ if length $canonical; | |
| 208 | $h .= qq~ <meta name="twitter:card" content="$twit_card">\n~; | |
| 209 | $h .= qq~ <meta name="twitter:title" content="$title">\n~; | |
| 210 | $h .= qq~ <meta name="twitter:description" content="$description">\n~ if length $description; | |
| 211 | $h .= qq~ <meta name="twitter:image" content="$og_image">\n~ if length $og_image; | |
| 212 | $h .= qq~ <meta name="twitter:site" content="$twit_site">\n~ if length $twit_site; | |
| 213 | return $h; | |
| 214 | } | |
| 215 | ||
| 216 | # ---- Internal -------------------------------------------------------- | |
| 217 | sub _trim { | |
| 218 | my ($s, $max) = @_; | |
| 219 | return '' unless defined $s; | |
| 220 | $s =~ s/^\s+|\s+$//g; | |
| 221 | $s =~ s/[\r\n]+/ /g; | |
| 222 | $max ||= 255; | |
| 223 | return substr($s, 0, $max); | |
| 224 | } | |
| 225 | ||
| 226 | sub _qstr { | |
| 227 | my $s = shift; | |
| 228 | return 'NULL' unless defined $s && length $s; | |
| 229 | $s =~ s/'/''/g; | |
| 230 | return "'$s'"; | |
| 231 | } | |
| 232 | ||
| 233 | 1; |