Diff -- /var/www/vhosts/3dshawn.com/site1/diff.cgi

O Operator
Diff

/var/www/vhosts/3dshawn.com/site1/diff.cgi

added on local at 2026-07-10 22:19:08

Added
+183
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to 85df3ad0f26d
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# DriftSense -- /diff.cgi
4#
5# Renders a two-pane diff for a single change captured in FILE_CHANGES
6# or SCHEMA_CHANGE. Pulls both blobs from BLOB_STORE, decompresses,
7# runs a naive LCS-style line diff, marks added / removed / context,
8# renders as syntax-highlight-ish HTML with monospace typography.
9#
10# URL:
11# /diff.cgi?kind=file&id=N -- FILE_CHANGES row
12# /diff.cgi?kind=schema&id=N -- SCHEMA_CHANGE row
13#======================================================================
14use strict;
15use warnings;
16use CGI ();
17use Compress::Zlib qw(uncompress);
18use MODS::Config; use MODS::DBConnect; use MODS::Template; use MODS::PageWrapper;
19
20my $cgi = CGI->new;
21my $db = MODS::DBConnect->new;
22my $tpl = MODS::Template->new;
23$|=1; print "Content-Type: text/html; charset=utf-8\nCache-Control: no-cache\n\n";
24
25my $kind = $cgi->param('kind') || '';
26my $id = int($cgi->param('id') || 0);
27
28my $dbh = $db->db_connect or die "DB connect failed\n";
29
30my ($title, $subtitle, $blob_sha, $prev_sha, $meta) = ('', '', '', '', {});
31
32if ($kind eq 'file' && $id) {
33 my $row = $db->db_readwrite($dbh, qq~
34 SELECT fc.file_changes_id AS id, fc.file_name, fc.status, fc.blob_sha,
35 fc.date_time, fc.uid, fc.gid, fc.permissions, fc.is_ts_only,
36 fc.file_monitor_list_id, s.server_name
37 FROM FILE_CHANGES fc LEFT JOIN SERVERS s ON s.server_id = fc.server_id
38 WHERE fc.file_changes_id = $id LIMIT 1
39 ~, __FILE__, __LINE__);
40 if ($row && $row->{id}) {
41 # Find the previous captured version of this file for the "before" pane
42 my $q_fname = $dbh->quote($row->{file_name});
43 my $prev = $db->db_readwrite($dbh, qq~
44 SELECT blob_sha FROM FILE_CHANGES
45 WHERE file_monitor_list_id = $row->{file_monitor_list_id}
46 AND file_name = $q_fname
47 AND file_changes_id < $id
48 AND blob_sha IS NOT NULL
49 ORDER BY file_changes_id DESC LIMIT 1
50 ~, __FILE__, __LINE__);
51 $title = $row->{file_name};
52 $subtitle = "$row->{status} on $row->{server_name} at $row->{date_time}";
53 $blob_sha = $row->{blob_sha};
54 $prev_sha = $prev && $prev->{blob_sha} ? $prev->{blob_sha} : '';
55 $meta = { %$row };
56 }
57}
58elsif ($kind eq 'schema' && $id) {
59 my $row = $db->db_readwrite($dbh, qq~
60 SELECT sc.schema_change_id AS id, sc.database_name, sc.table_name, sc.changes,
61 sc.schema_blob_sha, sc.change_datetime, s.server_name, sc.server_id
62 FROM SCHEMA_CHANGE sc LEFT JOIN SERVERS s ON s.server_id = sc.server_id
63 WHERE sc.schema_change_id = $id LIMIT 1
64 ~, __FILE__, __LINE__);
65 if ($row && $row->{id}) {
66 my $q_db = $dbh->quote($row->{database_name});
67 my $q_t = $dbh->quote($row->{table_name});
68 my $prev = $db->db_readwrite($dbh, qq~
69 SELECT schema_blob_sha FROM SCHEMA_CHANGE
70 WHERE server_id = $row->{server_id}
71 AND database_name = $q_db AND table_name = $q_t
72 AND schema_change_id < $id
73 AND schema_blob_sha IS NOT NULL
74 ORDER BY schema_change_id DESC LIMIT 1
75 ~, __FILE__, __LINE__);
76 $title = "$row->{database_name}.$row->{table_name}";
77 $subtitle = "on $row->{server_name} at $row->{change_datetime}";
78 $blob_sha = $row->{schema_blob_sha};
79 $prev_sha = $prev && $prev->{schema_blob_sha} ? $prev->{schema_blob_sha} : '';
80 $meta = { %$row };
81 }
82}
83
84# Fetch + decompress blobs
85my $curr = $blob_sha ? _fetch_blob($db, $dbh, $blob_sha) : '';
86my $prev = $prev_sha ? _fetch_blob($db, $dbh, $prev_sha) : '';
87
88$db->db_disconnect($dbh);
89
90# Compute a naive line-level diff
91my @lines = _line_diff($prev // '', $curr // '');
92my ($ct_add, $ct_del) = (0, 0);
93foreach my $L (@lines) {
94 $ct_add++ if $L->{op} eq 'add';
95 $ct_del++ if $L->{op} eq 'del';
96}
97
98my $tvars = {
99 title => $title || '(unknown)',
100 subtitle => $subtitle,
101 kind => $kind,
102 id => $id,
103 has_diff => scalar(@lines) ? 1 : 0,
104 lines => \@lines,
105 ct_add => $ct_add,
106 ct_del => $ct_del,
107 ct_context => scalar(@lines) - $ct_add - $ct_del,
108 has_prev => $prev_sha ? 1 : 0,
109 curr_sha => substr($blob_sha || '', 0, 12),
110 prev_sha => substr($prev_sha || '', 0, 12),
111};
112
113my @body = $tpl->template('diff.html', $tvars);
114MODS::PageWrapper->new->wrapper(
115 page_title => "Diff -- $title",
116 page_key => ($kind eq 'schema' ? 'schema_changes' : 'file_changes'),
117 body_html => join('', @body),
118 userinfo => { display_name => 'Operator' },
119);
120
121#---------------------------------------------------------------------
122sub _fetch_blob {
123 my ($db, $dbh, $sha) = @_;
124 my $sth = $dbh->prepare("SELECT content_gz FROM BLOB_STORE WHERE blob_sha = ?");
125 return '' unless $sth && $sth->execute($sha);
126 my $row = $sth->fetchrow_arrayref;
127 $sth->finish;
128 return '' unless $row && $row->[0];
129 my $decompressed = eval { uncompress($row->[0]) };
130 return $decompressed // '';
131}
132
133#---------------------------------------------------------------------
134# _line_diff -- naive line-level diff. Returns an array of hashrefs:
135# { op => 'add' | 'del' | 'ctx', text => $line, old_n, new_n }
136# Uses a simple LCS-based approach; adequate for small-to-medium files.
137# For huge diffs shell out to /usr/bin/diff (future optimization).
138#---------------------------------------------------------------------
139sub _line_diff {
140 my ($old, $new) = @_;
141 my @old_lines = split /\r?\n/, ($old // '');
142 my @new_lines = split /\r?\n/, ($new // '');
143
144 # LCS length table (dynamic programming) -- capped to prevent
145 # runaway memory on huge inputs.
146 my $O = scalar @old_lines;
147 my $N = scalar @new_lines;
148 if ($O > 5000 || $N > 5000) {
149 # Fall back: just dump both sides linearly, marked as del/add.
150 my @out;
151 my $i = 0;
152 push @out, { op => 'del', text => $_, old_n => ++$i, new_n => '' } for @old_lines;
153 my $j = 0;
154 push @out, { op => 'add', text => $_, old_n => '', new_n => ++$j } for @new_lines;
155 return @out;
156 }
157
158 my @lcs; for my $i (0..$O) { $lcs[$i][0] = 0; }
159 for my $j (0..$N) { $lcs[0][$j] = 0; }
160 for my $i (1..$O) {
161 for my $j (1..$N) {
162 $lcs[$i][$j] = $old_lines[$i-1] eq $new_lines[$j-1]
163 ? $lcs[$i-1][$j-1] + 1
164 : ($lcs[$i-1][$j] >= $lcs[$i][$j-1] ? $lcs[$i-1][$j] : $lcs[$i][$j-1]);
165 }
166 }
167
168 my @out;
169 my ($i, $j) = ($O, $N);
170 while ($i > 0 || $j > 0) {
171 if ($i > 0 && $j > 0 && $old_lines[$i-1] eq $new_lines[$j-1]) {
172 unshift @out, { op => 'ctx', text => $old_lines[$i-1], old_n => $i, new_n => $j };
173 $i--; $j--;
174 } elsif ($j > 0 && ($i == 0 || $lcs[$i][$j-1] >= $lcs[$i-1][$j])) {
175 unshift @out, { op => 'add', text => $new_lines[$j-1], old_n => '', new_n => $j };
176 $j--;
177 } else {
178 unshift @out, { op => 'del', text => $old_lines[$i-1], old_n => $i, new_n => '' };
179 $i--;
180 }
181 }
182 return @out;
183}