added on local at 2026-07-12 23:17:37
| 1 | #!/usr/bin/perl | |
| 2 | #====================================================================== | |
| 3 | # DriftSense -- /orphan_blobs.cgi | |
| 4 | # | |
| 5 | # Advisory-only report: BLOB_STORE rows with no reference from | |
| 6 | # FILE_CHANGES nor NAMED_RELEASE_PINS. These SHOULD be zero if | |
| 7 | # _purge.pl is running properly; a non-zero count is either | |
| 8 | # (a) a purge scheduling issue, or (b) a bug that lost references. | |
| 9 | # | |
| 10 | # This page NEVER deletes -- it just lists. Deletion is the exclusive | |
| 11 | # job of _purge.pl (which is auditable via /purge_log.cgi). | |
| 12 | #====================================================================== | |
| 13 | use strict; | |
| 14 | use warnings; | |
| 15 | use CGI (); | |
| 16 | use MODS::Config; use MODS::DBConnect; use MODS::Template; use MODS::PageWrapper; | |
| 17 | ||
| 18 | my $cgi = CGI->new; my $db = MODS::DBConnect->new; my $tpl = MODS::Template->new; | |
| 19 | $|=1; print "Content-Type: text/html; charset=utf-8\nCache-Control: no-cache\n\n"; | |
| 20 | ||
| 21 | my $dbh = $db->db_connect or die "DB connect failed\n"; | |
| 22 | ||
| 23 | # Total counts (fast) | |
| 24 | my $tot_blobs = $db->db_readwrite($dbh, "SELECT COUNT(*) AS n FROM BLOB_STORE", __FILE__, __LINE__); | |
| 25 | my $tot_refs = $db->db_readwrite($dbh, "SELECT COUNT(DISTINCT blob_sha) AS n FROM FILE_CHANGES WHERE blob_sha IS NOT NULL", __FILE__, __LINE__); | |
| 26 | ||
| 27 | # Orphans: in BLOB_STORE, NOT in FILE_CHANGES, NOT in NAMED_RELEASE_PINS | |
| 28 | # NULL-anti-join, cap at 500 for display. | |
| 29 | my @orphans = $db->db_readwrite_multiple($dbh, q~ | |
| 30 | SELECT bs.blob_sha, | |
| 31 | LENGTH(bs.content_gz) AS gzlen, | |
| 32 | bs.first_seen_at, | |
| 33 | UNIX_TIMESTAMP(bs.first_seen_at) AS captured_epoch | |
| 34 | FROM BLOB_STORE bs | |
| 35 | LEFT JOIN FILE_CHANGES fc ON fc.blob_sha = bs.blob_sha | |
| 36 | LEFT JOIN NAMED_RELEASE_PINS nrp ON nrp.blob_sha = bs.blob_sha | |
| 37 | WHERE fc.blob_sha IS NULL | |
| 38 | AND nrp.blob_sha IS NULL | |
| 39 | ORDER BY bs.first_seen_at ASC | |
| 40 | LIMIT 500 | |
| 41 | ~, __FILE__, __LINE__); | |
| 42 | ||
| 43 | foreach my $o (@orphans) { | |
| 44 | $o->{gzlen_kb} = sprintf('%.1f', ($o->{gzlen} // 0) / 1024); | |
| 45 | $o->{blob_short} = substr($o->{blob_sha}, 0, 12); | |
| 46 | $o->{captured_epoch} //= 0; | |
| 47 | } | |
| 48 | ||
| 49 | my $orphan_ct = scalar @orphans; | |
| 50 | my $orphan_bytes = 0; $orphan_bytes += ($_->{gzlen} // 0) for @orphans; | |
| 51 | my $orphan_mb = sprintf('%.2f', $orphan_bytes / 1024 / 1024); | |
| 52 | my $tot_bytes_row = $db->db_readwrite($dbh, "SELECT SUM(LENGTH(content_gz)) AS b FROM BLOB_STORE", __FILE__, __LINE__); | |
| 53 | my $tot_mb = $tot_bytes_row && $tot_bytes_row->{b} ? sprintf('%.2f', $tot_bytes_row->{b} / 1024 / 1024) : '0'; | |
| 54 | ||
| 55 | $db->db_disconnect($dbh); | |
| 56 | ||
| 57 | my $tvars = { | |
| 58 | tot_blobs => $tot_blobs->{n} // 0, | |
| 59 | tot_refs => $tot_refs->{n} // 0, | |
| 60 | tot_mb => $tot_mb, | |
| 61 | orphans => \@orphans, | |
| 62 | has_orphans => $orphan_ct ? 1 : 0, | |
| 63 | orphan_ct => $orphan_ct, | |
| 64 | orphan_mb => $orphan_mb, | |
| 65 | truncated => ($orphan_ct >= 500) ? 1 : 0, | |
| 66 | }; | |
| 67 | my @body = $tpl->template('orphan_blobs.html', $tvars); | |
| 68 | MODS::PageWrapper->new->wrapper( | |
| 69 | page_title => 'Orphan blobs', page_key => 'orphan_blobs', | |
| 70 | body_html => join('', @body), userinfo => { display_name => 'Operator' }, | |
| 71 | ); |