Diff -- /var/www/vhosts/3dshawn.com/affiliate.3dshawn.com/admin_teams.cgi

O Operator
Diff

/var/www/vhosts/3dshawn.com/affiliate.3dshawn.com/admin_teams.cgi

added on local at 2026-07-11 18:38:38

Added
+538
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to d2f60ada8813
Restore this content →
Unified diff
Naive LCS-based line diff. Additions in emerald, deletions in rose. Both sides decompressed live from BLOB_STORE.
1#!/usr/bin/perl
2#======================================================================
3# AffSoft - SUPER-ADMIN: Teams + Admin Team Members
4#
5# Consolidates former /admin_team.cgi (admin roster: add/edit/remove
6# platform admins + role management) into this file. Dispatches on
7# SCRIPT_NAME entry (not on a query param -- neither is a per-record
8# detail page, so param dispatch would be arbitrary). URL routes:
9# /admin_teams.cgi -> teams CRUD (create teams, assign staff)
10# /admin_team.cgi -> admin roster (peer admin management)
11# /admin_team.cgi is now a 3-line wrapper that `do`s this file.
12#======================================================================
13use strict; use warnings;
14use lib '/var/www/vhosts/3dshawn.com/affiliate.3dshawn.com';
15use CGI;
16use MODS::Template;
17use MODS::DBConnect;
18use MODS::Login;
19use MODS::AffSoft::Config;
20use MODS::AffSoft::Wrapper;
21use MODS::AffSoft::Admin;
22
23my $q = CGI->new;
24my $form = $q->Vars;
25my $auth = MODS::Login->new;
26my $wrap = MODS::AffSoft::Wrapper->new;
27my $tfile = MODS::Template->new;
28my $db = MODS::DBConnect->new;
29my $cfg = MODS::AffSoft::Config->new;
30my $admin = MODS::AffSoft::Admin->new;
31my $DB = $cfg->settings('database_name');
32
33my $entry = ($ENV{SCRIPT_NAME} || '') =~ m{/([^/]+)\.cgi$} ? $1 : 'admin_teams';
34
35if ($entry eq 'admin_team') {
36 _tm_admin_team_page();
37} else {
38 _tm_admin_teams_page();
39}
40exit;
41
42#======================================================================
43# admin_teams.cgi entry: teams CRUD
44#======================================================================
45sub _tm_admin_teams_page {
46 my $u = $auth->login_verify();
47 unless ($u) { print "Status: 302 Found\nLocation: /login.cgi\n\n"; return; }
48 $admin->require_admin($u);
49
50 my $uid = $u->{user_id}; $uid =~ s/[^0-9]//g if defined $uid;
51 my $dbh = $db->db_connect();
52
53 # Verify super-admin via direct lookup (login_verify doesn't populate)
54 my $sa = $db->db_readwrite($dbh,
55 "SELECT is_super_admin FROM `${DB}`.users WHERE id='$uid' LIMIT 1",
56 $ENV{SCRIPT_NAME}, __LINE__);
57 unless ($sa && $sa->{is_super_admin}) {
58 $db->db_disconnect($dbh);
59 print "Status: 403 Forbidden\nContent-Type: text/plain\n\nSuper-admin only.\n"; return;
60 }
61
62 # POST actions
63 if (($ENV{REQUEST_METHOD}||'') eq 'POST') {
64 my $act = $form->{act} || '';
65 if ($act eq 'create') {
66 my $name = $form->{name} || ''; $name =~ s/^\s+|\s+$//g; $name = substr($name, 0, 120);
67 my $color = $form->{color} || '#5aa9ff';
68 $color = '#5aa9ff' unless $color =~ /^#[0-9a-fA-F]{6}$/;
69 my $parent = $form->{parent_team_id} || 0; $parent =~ s/[^0-9]//g;
70 my $parent_clause = $parent ? "'$parent'" : 'NULL';
71 if (length $name) {
72 my $n_sql = $name; $n_sql =~ s/'/\\'/g;
73 $db->db_readwrite($dbh,
74 "INSERT INTO `${DB}`.teams (name, color, parent_team_id) VALUES ('$n_sql', '$color', $parent_clause)",
75 $ENV{SCRIPT_NAME}, __LINE__);
76 }
77 } elsif ($act eq 'assign') {
78 my $user_id = $form->{user_id} || 0; $user_id =~ s/[^0-9]//g;
79 my $team_id = $form->{team_id} || 0; $team_id =~ s/[^0-9]//g;
80 my $tc = $team_id ? "'$team_id'" : 'NULL';
81 if ($user_id) {
82 $db->db_readwrite($dbh,
83 "UPDATE `${DB}`.users SET team_id=$tc WHERE id='$user_id'",
84 $ENV{SCRIPT_NAME}, __LINE__);
85 }
86 } elsif ($act eq 'delete') {
87 my $team_id = $form->{team_id} || 0; $team_id =~ s/[^0-9]//g;
88 if ($team_id) {
89 $db->db_readwrite($dbh,
90 "UPDATE `${DB}`.users SET team_id=NULL WHERE team_id='$team_id'",
91 $ENV{SCRIPT_NAME}, __LINE__);
92 $db->db_readwrite($dbh,
93 "DELETE FROM `${DB}`.teams WHERE id='$team_id'",
94 $ENV{SCRIPT_NAME}, __LINE__);
95 }
96 }
97 $db->db_disconnect($dbh);
98 print "Status: 302 Found\nLocation: /admin_teams.cgi\n\n"; return;
99 }
100
101 my @teams = $db->db_readwrite_multiple($dbh,
102 "SELECT t.id, t.name, t.color, t.parent_team_id, p.name AS parent_name,
103 (SELECT COUNT(*) FROM `${DB}`.users u WHERE u.team_id=t.id) AS members_n
104 FROM `${DB}`.teams t
105 LEFT JOIN `${DB}`.teams p ON p.id = t.parent_team_id
106 ORDER BY t.name",
107 $ENV{SCRIPT_NAME}, __LINE__);
108
109 my @staff = $db->db_readwrite_multiple($dbh,
110 "SELECT u.id, u.email, u.display_name, u.team_id, t.name AS team_name, t.color AS team_color
111 FROM `${DB}`.users u
112 LEFT JOIN `${DB}`.teams t ON t.id = u.team_id
113 WHERE u.is_admin = 1
114 ORDER BY u.display_name, u.email",
115 $ENV{SCRIPT_NAME}, __LINE__);
116
117 foreach my $t (@teams) {
118 $t->{name} = _tm_h($t->{name});
119 $t->{parent_name} = _tm_h($t->{parent_name} || '');
120 }
121 foreach my $s (@staff) {
122 $s->{display_name} = _tm_h($s->{display_name} || $s->{email});
123 $s->{email} = _tm_h($s->{email});
124 $s->{team_name} = _tm_h($s->{team_name} || '');
125 }
126
127 $db->db_disconnect($dbh);
128
129 my $tvars = {
130 teams => \@teams,
131 has_teams => scalar(@teams) ? 1 : 0,
132 staff => \@staff,
133 has_staff => scalar(@staff) ? 1 : 0,
134 };
135
136 print "Content-Type: text/html; charset=utf-8\nCache-Control: no-store\n\n";
137 my $body = join('', $tfile->template('affsoft_admin_teams.html', $tvars, $u));
138 $wrap->render({ userinfo => $u, page_key => 'admin_teams', title => 'Teams', body => $body });
139}
140
141#======================================================================
142# admin_team.cgi entry: admin roster management
143#======================================================================
144sub _tm_admin_team_page {
145 $|=1;
146 my $userinfo = $auth->login_verify();
147 if (!$userinfo) {
148 print "Status: 302 Found\nLocation: /login.cgi\n\n";
149 return;
150 }
151 $admin->require_admin($userinfo);
152
153 # Resolve whether the *viewer* is super-admin. login_verify doesn't
154 # populate users.is_super_admin into the session, so go through the
155 # Permissions helper which probes lazily and caches.
156 require MODS::AffSoft::Permissions;
157 my $perm = MODS::AffSoft::Permissions->new;
158 my $viewer_is_super = $perm->is_super_admin($userinfo) ? 1 : 0;
159
160 my $me_uid = $userinfo->{user_id};
161 $me_uid =~ s/[^0-9]//g;
162
163 my $dbh = $db->db_connect();
164
165 # ---- Guard: permission_groups must exist before we query it ---------
166 my $have_pg_tbl = $db->db_readwrite($dbh, qq~
167 SELECT COUNT(*) AS n FROM information_schema.tables
168 WHERE table_schema='$DB' AND table_name='permission_groups'
169 ~, $ENV{SCRIPT_NAME}, __LINE__);
170 my $perm_ready = ($have_pg_tbl && $have_pg_tbl->{n}) ? 1 : 0;
171
172 my $flash_msg = '';
173 my $flash_kind = '';
174
175 my $action = $form->{action} || '';
176
177 if ($action eq 'add_admin' && $perm_ready) {
178 my $email = $form->{email} // '';
179 my $name = $form->{display_name} // '';
180 my $pw = $form->{password} // '';
181 my $role_id = $form->{permission_groups_id} // '';
182
183 $email =~ s/^\s+|\s+$//g;
184 $name =~ s/^\s+|\s+$//g;
185 $role_id =~ s/[^0-9]//g;
186
187 if ($email !~ /\@/ || $name eq '' || length($pw) < 8 || !$role_id) {
188 $flash_msg = 'Email, display name, role, and a password (8+ chars) are required.';
189 $flash_kind = 'error';
190 } else {
191 my $existing = $db->db_readwrite($dbh, qq~
192 SELECT id FROM `${DB}`.users WHERE email='~ . _tm_esc($email) . qq~' LIMIT 1
193 ~, $ENV{SCRIPT_NAME}, __LINE__);
194
195 if ($existing && $existing->{id}) {
196 $flash_msg = 'An account with that email already exists.';
197 $flash_kind = 'error';
198 } else {
199 my $role_ok = $db->db_readwrite($dbh, qq~
200 SELECT id FROM `${DB}`.permission_groups
201 WHERE id='$role_id' AND scope='admin'
202 AND group_status=1
203 AND owner_user_id IS NULL
204 LIMIT 1
205 ~, $ENV{SCRIPT_NAME}, __LINE__);
206
207 if (!$role_ok || !$role_ok->{id}) {
208 $flash_msg = 'Pick a valid admin role.';
209 $flash_kind = 'error';
210 } else {
211 my $new_id = $auth->signup($email, $pw, $name, 'free');
212 if (!$new_id) {
213 $flash_msg = 'Could not create the user (password may be too weak or email rejected).';
214 $flash_kind = 'error';
215 } else {
216 # Mark them admin and attach role. No owner_user_id
217 # for admins -- they're peers, not sub-accounts.
218 $db->db_readwrite($dbh, qq~
219 UPDATE `${DB}`.users
220 SET is_admin=1,
221 permission_groups_id='$role_id'
222 WHERE id='$new_id'
223 ~, $ENV{SCRIPT_NAME}, __LINE__);
224 $flash_msg = "Added admin $email.";
225 $flash_kind = 'success';
226 }
227 }
228 }
229 }
230 }
231 elsif ($action eq 'update_role' && $perm_ready) {
232 my $member_id = $form->{member_id} // '';
233 my $role_id = $form->{permission_groups_id} // '';
234 $member_id =~ s/[^0-9]//g;
235 $role_id =~ s/[^0-9]//g;
236
237 if ($member_id eq $me_uid) {
238 $flash_msg = "You can't change your own admin role from here.";
239 $flash_kind = 'error';
240 } elsif ($member_id && $role_id) {
241 my $target_ok = $db->db_readwrite($dbh, qq~
242 SELECT id FROM `${DB}`.users
243 WHERE id='$member_id' AND is_admin=1 LIMIT 1
244 ~, $ENV{SCRIPT_NAME}, __LINE__);
245 my $role_ok = $db->db_readwrite($dbh, qq~
246 SELECT id FROM `${DB}`.permission_groups
247 WHERE id='$role_id' AND scope='admin' AND group_status=1 AND owner_user_id IS NULL LIMIT 1
248 ~, $ENV{SCRIPT_NAME}, __LINE__);
249 if ($target_ok && $target_ok->{id} && $role_ok && $role_ok->{id}) {
250 $db->db_readwrite($dbh, qq~
251 UPDATE `${DB}`.users SET permission_groups_id='$role_id' WHERE id='$member_id'
252 ~, $ENV{SCRIPT_NAME}, __LINE__);
253 $flash_msg = 'Role updated.';
254 $flash_kind = 'success';
255 } else {
256 $flash_msg = 'Could not update that admin.';
257 $flash_kind = 'error';
258 }
259 }
260 }
261 elsif ($action eq 'toggle_super_admin' && $viewer_is_super) {
262 # Promote or revoke super-admin on another admin. Guards:
263 # - self-toggle blocked (you can't demote yourself; would leave no
264 # super-admin if you're the only one)
265 # - target must already be an admin
266 # - last-super-admin guard: demote refused if it would leave zero
267 my $member_id = $form->{member_id} // '';
268 $member_id =~ s/[^0-9]//g;
269 my $want = ($form->{want} && $form->{want} eq '1') ? 1 : 0;
270
271 if (!$member_id || $member_id eq $me_uid) {
272 $flash_msg = "You can't change your own super-admin status from here.";
273 $flash_kind = 'error';
274 } else {
275 my $target = $db->db_readwrite($dbh, qq~
276 SELECT id, is_super_admin FROM `${DB}`.users
277 WHERE id='$member_id' AND is_admin=1 LIMIT 1
278 ~, $ENV{SCRIPT_NAME}, __LINE__);
279 if (!$target || !$target->{id}) {
280 $flash_msg = 'Target admin not found.';
281 $flash_kind = 'error';
282 } elsif (!$want) {
283 # Refuse the demote if it would leave zero super-admins.
284 my $count = $db->db_readwrite($dbh, qq~
285 SELECT COUNT(*) AS n FROM `${DB}`.users
286 WHERE is_super_admin=1 AND id != '$member_id'
287 ~, $ENV{SCRIPT_NAME}, __LINE__);
288 if (!$count || !$count->{n}) {
289 $flash_msg = "Can't demote the last super-admin.";
290 $flash_kind = 'error';
291 } else {
292 $db->db_readwrite($dbh, qq~
293 UPDATE `${DB}`.users
294 SET is_super_admin=0, updated_at=NOW()
295 WHERE id='$member_id'
296 ~, $ENV{SCRIPT_NAME}, __LINE__);
297 $flash_msg = 'Super-admin removed.';
298 $flash_kind = 'success';
299 }
300 } else {
301 $db->db_readwrite($dbh, qq~
302 UPDATE `${DB}`.users
303 SET is_super_admin=1, is_admin=1, updated_at=NOW()
304 WHERE id='$member_id'
305 ~, $ENV{SCRIPT_NAME}, __LINE__);
306 $flash_msg = 'Promoted to super-admin.';
307 $flash_kind = 'success';
308 }
309 }
310 }
311 elsif ($action eq 'remove_admin') {
312 my $member_id = $form->{member_id} // '';
313 $member_id =~ s/[^0-9]//g;
314
315 if ($member_id eq $me_uid) {
316 $flash_msg = "You can't remove yourself.";
317 $flash_kind = 'error';
318 } elsif ($member_id) {
319 # Belt-and-suspenders: only demote admins, never sellers.
320 my $target_ok = $db->db_readwrite($dbh, qq~
321 SELECT id FROM `${DB}`.users
322 WHERE id='$member_id' AND is_admin=1 LIMIT 1
323 ~, $ENV{SCRIPT_NAME}, __LINE__);
324 if ($target_ok && $target_ok->{id}) {
325 # Two-step: revoke admin + null permission group, then
326 # close the account. Keeps the audit trail intact (we
327 # don't blow the user row away) but blocks future admin
328 # access.
329 $db->db_readwrite($dbh, qq~
330 UPDATE `${DB}`.users
331 SET is_admin=0,
332 permission_groups_id=NULL,
333 account_status='closed'
334 WHERE id='$member_id'
335 ~, $ENV{SCRIPT_NAME}, __LINE__);
336 # Revoke any live sessions so they're kicked immediately.
337 $db->db_readwrite($dbh, qq~
338 UPDATE `${DB}`.user_sessions SET revoked_at=NOW()
339 WHERE user_id='$member_id' AND revoked_at IS NULL
340 ~, $ENV{SCRIPT_NAME}, __LINE__);
341 $flash_msg = 'Admin removed.';
342 $flash_kind = 'success';
343 }
344 }
345 }
346
347 # ---- Load admin roster ----------------------------------------------
348 my @members;
349 @members = $db->db_readwrite_multiple($dbh, qq~
350 SELECT u.id, u.email, u.display_name, u.last_login_at,
351 u.permission_groups_id,
352 u.is_super_admin,
353 COALESCE(pg.name, 'Unconstrained') AS role_name,
354 DATE_FORMAT(u.created_at, '%b %e, %Y') AS added_on,
355 DATE_FORMAT(u.last_login_at, '%b %e, %Y') AS last_seen,
356 UNIX_TIMESTAMP(u.created_at) AS added_on_epoch,
357 UNIX_TIMESTAMP(u.last_login_at) AS last_seen_epoch
358 FROM `${DB}`.users u
359 LEFT JOIN `${DB}`.permission_groups pg ON pg.id = u.permission_groups_id
360 WHERE u.is_admin=1 AND u.account_status='active'
361 ORDER BY u.created_at ASC
362 ~, $ENV{SCRIPT_NAME}, __LINE__) if $perm_ready;
363
364 # Fallback when permission_groups doesn't exist yet -- still list the
365 # active admins so the page renders something usable on the first deploy.
366 if (!$perm_ready) {
367 @members = $db->db_readwrite_multiple($dbh, qq~
368 SELECT id, email, display_name, last_login_at,
369 is_super_admin,
370 DATE_FORMAT(created_at, '%b %e, %Y') AS added_on,
371 DATE_FORMAT(last_login_at, '%b %e, %Y') AS last_seen,
372 UNIX_TIMESTAMP(created_at) AS added_on_epoch,
373 UNIX_TIMESTAMP(last_login_at) AS last_seen_epoch
374 FROM `${DB}`.users
375 WHERE is_admin=1 AND account_status='active'
376 ORDER BY created_at ASC
377 ~, $ENV{SCRIPT_NAME}, __LINE__);
378 }
379
380 # ---- Load admin roles -----------------------------------------------
381 my @roles;
382 if ($perm_ready) {
383 @roles = $db->db_readwrite_multiple($dbh, qq~
384 SELECT id, name, system_slug
385 FROM `${DB}`.permission_groups
386 WHERE scope='admin' AND group_status=1 AND owner_user_id IS NULL
387 ORDER BY name ASC
388 ~, $ENV{SCRIPT_NAME}, __LINE__);
389 }
390
391 # ---- Role -> feature labels for the "What each role can do" panel
392 my @role_features;
393 if ($perm_ready) {
394 @role_features = $db->db_readwrite_multiple($dbh, qq~
395 SELECT pg.id AS role_id, pg.name AS role_name,
396 pf.label AS feature_label, pf.sort_order
397 FROM `${DB}`.permission_groups pg
398 JOIN `${DB}`.permission_features pf
399 ON FIND_IN_SET(pf.id, pg.permission_features_ids) > 0
400 WHERE pg.scope='admin'
401 AND pg.group_status=1
402 AND pg.owner_user_id IS NULL
403 ORDER BY pg.name ASC, pf.sort_order ASC
404 ~, $ENV{SCRIPT_NAME}, __LINE__);
405 }
406
407 $db->db_disconnect($dbh);
408
409 # ---- Build template vars --------------------------------------------
410 my @member_rows;
411 foreach my $m (@members) {
412 my @role_opts;
413 foreach my $r (@roles) {
414 push @role_opts, {
415 value => $r->{id},
416 label => _tm_h($r->{name}),
417 selected_attr => ($r->{id} eq ($m->{permission_groups_id} || '') ? ' selected' : ''),
418 };
419 }
420 my $is_self = ($m->{id} eq $me_uid) ? 1 : 0;
421 my $is_super = $m->{is_super_admin} ? 1 : 0;
422 # TF-parity decoration
423 my @_palette_ = ('#5aa9ff','#34d399','#fbbf24','#a78bfa','#f87171','#22c55e','#06b6d4','#ec4899','#f59e0b');
424 my $_av_ = $_palette_[ ($m->{id} || 0) % scalar(@_palette_) ];
425 my $_dn_ = $m->{display_name} || $m->{email} || '?';
426 my @_p_ = split /\s+/, $_dn_, 2;
427 my $_ini_ = uc(substr($_p_[0]||'',0,1)) . uc(substr($_p_[1]||'',0,1));
428 $_ini_ = uc(substr($_dn_,0,2)) unless length $_ini_;
429 push @member_rows, {
430 avatar_color => $_av_,
431 initials => $_ini_,
432 id => $m->{id},
433 email => _tm_h($m->{email}),
434 display_name => _tm_h($m->{display_name}),
435 role_name => _tm_h($m->{role_name} || 'Unconstrained'),
436 added_on => _tm_h($m->{added_on} || '-'),
437 added_on_epoch => ($m->{added_on_epoch} || 0) + 0,
438 last_seen => _tm_h($m->{last_seen} || 'Never'),
439 last_seen_epoch => ($m->{last_seen_epoch} || 0) + 0,
440 is_self => $is_self,
441 is_super_admin => $is_super,
442 not_super_admin => $is_super ? 0 : 1,
443 role_options => \@role_opts,
444 # Only render the super-admin toggle on rows other than the
445 # viewer's own (and only if the viewer can flip the bit at all).
446 # The action handler enforces this too.
447 show_super_toggle => ($viewer_is_super && !$is_self) ? 1 : 0,
448 };
449 }
450
451 my @add_role_opts;
452 foreach my $r (@roles) {
453 push @add_role_opts, {
454 value => $r->{id},
455 label => _tm_h($r->{name}),
456 };
457 }
458
459 # Collapse the flat role-feature join into role-grouped cards.
460 my @role_cards;
461 my %role_idx;
462 foreach my $rf (@role_features) {
463 my $rid = $rf->{role_id};
464 if (!exists $role_idx{$rid}) {
465 push @role_cards, {
466 name => _tm_h($rf->{role_name}),
467 features => [],
468 is_super => 0,
469 };
470 $role_idx{$rid} = $#role_cards;
471 }
472 push @{ $role_cards[ $role_idx{$rid} ]{features} }, { label => _tm_h($rf->{feature_label}) };
473 }
474
475 # Append a synthetic Super Admin card. This role isn't backed by a
476 # permission_groups row -- it's the users.is_super_admin flag -- so
477 # its capabilities are hardcoded here. Listed last so the implicit
478 # ordering reads "weakest to strongest": Viewer -> Editor -> Manager
479 # -> Super Admin.
480 push @role_cards, {
481 name => 'Super Admin',
482 is_super => 1,
483 features => [
484 { label => 'Everything in Manager' },
485 { label => 'View platform-wide revenue, MRR / ARR, signups' },
486 { label => 'Edit plan pricing &amp; packages' },
487 { label => 'Manage sandbox test credit cards' },
488 { label => 'Edit Software Configuration (Stripe keys, branding)' },
489 { label => 'Promote / demote other super admins' },
490 ],
491 };
492
493 my $tvars = {
494 perm_ready => $perm_ready,
495 has_perm_ready => $perm_ready ? 1 : 0,
496 flash_msg => _tm_h($flash_msg),
497 has_flash => $flash_msg ? 1 : 0,
498 flash_is_error => ($flash_kind eq 'error') ? 1 : 0,
499 flash_is_success => ($flash_kind eq 'success') ? 1 : 0,
500 members => \@member_rows,
501 has_members => scalar(@member_rows) ? 1 : 0,
502 member_count => scalar(@member_rows),
503 add_role_options => \@add_role_opts,
504 has_roles => scalar(@add_role_opts) ? 1 : 0,
505 role_cards => \@role_cards,
506 has_role_cards => scalar(@role_cards) ? 1 : 0,
507 viewer_is_super_admin => $viewer_is_super,
508 };
509
510 print "Content-Type: text/html; charset=utf-8\nCache-Control: no-store, no-cache, must-revalidate, max-age=0\nPragma: no-cache\nExpires: 0\n\n";
511
512 my $body = join('', $tfile->template('webstls_admin_team.html', $tvars, $userinfo));
513
514 $wrap->render({
515 userinfo => $userinfo,
516 page_key => 'admin_team',
517 title => 'Admin Team',
518 body => $body,
519 });
520}
521
522sub _tm_esc {
523 my $s = shift;
524 $s //= '';
525 $s =~ s/\\/\\\\/g;
526 $s =~ s/'/''/g;
527 return $s;
528}
529
530sub _tm_h {
531 my $s = shift;
532 $s //= '';
533 $s =~ s/&/&amp;/g;
534 $s =~ s/</&lt;/g;
535 $s =~ s/>/&gt;/g;
536 $s =~ s/"/&quot;/g;
537 return $s;
538}