Diff -- /var/www/vhosts/3dshawn.com/site1/pin_hotspots.cgi
Diff
/var/www/vhosts/3dshawn.com/site1/pin_hotspots.cgi
added on local at 2026-07-12 00:02:11
Added
+113
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to 37a1a9fc1137
to 37a1a9fc1137
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 | # DriftSense -- /pin_hotspots.cgi | |
| 4 | # | |
| 5 | # Bulk-pin the top-N most-changed files into a new Named Release. | |
| 6 | # GET shows a preview form (default N=20 over 30 days). | |
| 7 | # POST creates a NAMED_RELEASES row + one NAMED_RELEASE_PINS row per | |
| 8 | # top-file (references the file's latest file_changes_id). | |
| 9 | #====================================================================== | |
| 10 | use strict; | |
| 11 | use warnings; | |
| 12 | use CGI (); | |
| 13 | use MODS::Config; | |
| 14 | use MODS::DBConnect; | |
| 15 | use MODS::Template; | |
| 16 | use MODS::PageWrapper; | |
| 17 | ||
| 18 | my $cgi = CGI->new; | |
| 19 | my $db = MODS::DBConnect->new; | |
| 20 | my $tpl = MODS::Template->new; | |
| 21 | $|=1; | |
| 22 | ||
| 23 | my $dbh = $db->db_connect or die "DriftSense: DB connect failed\n"; | |
| 24 | ||
| 25 | my $method = $ENV{REQUEST_METHOD} || 'GET'; | |
| 26 | my $limit = int($cgi->param('n') || 20); $limit = 5 if $limit < 5; $limit = 100 if $limit > 100; | |
| 27 | my $days = int($cgi->param('days') || 30); $days = 1 if $days < 1; $days = 365 if $days > 365; | |
| 28 | ||
| 29 | # ---- Top-N most-changed files in the window ------------------------- | |
| 30 | my @top = $db->db_readwrite_multiple($dbh, qq~ | |
| 31 | SELECT fc.file_name, | |
| 32 | m.scan_name, | |
| 33 | m.file_monitor_list_id AS mid, | |
| 34 | COUNT(*) AS change_ct, | |
| 35 | MAX(fc.file_changes_id) AS latest_id, | |
| 36 | (SELECT bs.blob_sha FROM FILE_CHANGES fc2 | |
| 37 | WHERE fc2.file_changes_id = MAX(fc.file_changes_id) | |
| 38 | AND fc2.blob_sha IS NOT NULL | |
| 39 | LIMIT 1) AS blob_sha | |
| 40 | FROM FILE_CHANGES fc | |
| 41 | LEFT JOIN FILE_MONITOR_SETTINGS m ON m.file_monitor_list_id = fc.file_monitor_list_id | |
| 42 | WHERE fc.date_time >= DATE_SUB(NOW(), INTERVAL $days DAY) | |
| 43 | AND fc.blob_sha IS NOT NULL | |
| 44 | GROUP BY fc.file_name, m.file_monitor_list_id, m.scan_name | |
| 45 | ORDER BY change_ct DESC, latest_id DESC | |
| 46 | LIMIT $limit | |
| 47 | ~, __FILE__, __LINE__); | |
| 48 | ||
| 49 | # ---- POST: create the pin release ---------------------------------- | |
| 50 | if ($method eq 'POST' && $cgi->param('confirm')) { | |
| 51 | my $name = $cgi->param('name') || 'hotspot-pin-' . time(); | |
| 52 | my $desc = $cgi->param('description') | |
| 53 | || "Auto-pinned top-$limit files by change count over last $days days"; | |
| 54 | my $by = 'Operator'; | |
| 55 | ||
| 56 | my $q_name = $dbh->quote($name); | |
| 57 | my $q_desc = $dbh->quote($desc); | |
| 58 | my $q_by = $dbh->quote($by); | |
| 59 | $db->db_readwrite($dbh, qq~ | |
| 60 | INSERT INTO NAMED_RELEASES | |
| 61 | (name, description, released_at, released_by, is_locked, created_at) | |
| 62 | VALUES | |
| 63 | ($q_name, $q_desc, NOW(), $q_by, 1, NOW()) | |
| 64 | ~, __FILE__, __LINE__); | |
| 65 | my $rel = $db->db_readwrite($dbh, "SELECT LAST_INSERT_ID() AS id", __FILE__, __LINE__); | |
| 66 | my $rid = $rel && $rel->{id}; | |
| 67 | ||
| 68 | my $pinned = 0; | |
| 69 | if ($rid) { | |
| 70 | foreach my $t (@top) { | |
| 71 | next unless $t->{latest_id} && $t->{blob_sha}; | |
| 72 | my $q_file = $dbh->quote($t->{file_name}); | |
| 73 | my $q_sha = $dbh->quote($t->{blob_sha}); | |
| 74 | $db->db_readwrite($dbh, qq~ | |
| 75 | INSERT INTO NAMED_RELEASE_PINS | |
| 76 | (named_release_id, file_changes_id, file_name, blob_sha) | |
| 77 | VALUES | |
| 78 | ($rid, $t->{latest_id}, $q_file, $q_sha) | |
| 79 | ~, __FILE__, __LINE__); | |
| 80 | $pinned++; | |
| 81 | } | |
| 82 | } | |
| 83 | $db->db_disconnect($dbh); | |
| 84 | print "Status: 302 Found\nLocation: /named_releases.cgi?pinned=$pinned\n\n"; | |
| 85 | exit; | |
| 86 | } | |
| 87 | ||
| 88 | # ---- GET: preview page --------------------------------------------- | |
| 89 | foreach my $t (@top) { | |
| 90 | $t->{file_short} = length($t->{file_name} // '') > 70 | |
| 91 | ? '...' . substr($t->{file_name}, -67) : ($t->{file_name} // ''); | |
| 92 | $t->{sha_short} = substr($t->{blob_sha} // '', 0, 12); | |
| 93 | $t->{diff_url} = "/diff.cgi?kind=file&id=" . ($t->{latest_id} || 0); | |
| 94 | } | |
| 95 | $db->db_disconnect($dbh); | |
| 96 | ||
| 97 | my $suggest_name = sprintf('hotspot-pin-%s', POSIX::strftime('%Y%m%d-%H%M', localtime)); | |
| 98 | require POSIX; | |
| 99 | $suggest_name = 'hotspot-pin-' . POSIX::strftime('%Y%m%d-%H%M', localtime); | |
| 100 | ||
| 101 | print "Content-Type: text/html; charset=utf-8\nCache-Control: no-cache\n\n"; | |
| 102 | my @body = $tpl->template('pin_hotspots.html', { | |
| 103 | top => \@top, | |
| 104 | has_top => scalar(@top) ? 1 : 0, | |
| 105 | total => scalar @top, | |
| 106 | limit => $limit, | |
| 107 | days => $days, | |
| 108 | suggest_name => $suggest_name, | |
| 109 | }); | |
| 110 | MODS::PageWrapper->new->wrapper( | |
| 111 | page_title => 'Pin hotspots', page_key => '', | |
| 112 | body_html => join('', @body), userinfo => { display_name => 'Operator' }, | |
| 113 | ); |