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

O Operator
Diff

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

modified on local at 2026-07-10 22:22:26

Added
+8
lines
Removed
-3
lines
Context
180
unchanged
Blobs
from 85df3ad0f26d
to ba2f6f72e4fb
Restore this content →
Unified diff
Naive LCS-based line diff. Additions in emerald, deletions in rose. Both sides decompressed live from BLOB_STORE.
11#!/usr/bin/perl
22#======================================================================
33# DriftSense -- /diff.cgi
44#
55# Renders a two-pane diff for a single change captured in FILE_CHANGES
66# or SCHEMA_CHANGE. Pulls both blobs from BLOB_STORE, decompresses,
77# runs a naive LCS-style line diff, marks added / removed / context,
88# renders as syntax-highlight-ish HTML with monospace typography.
99#
1010# URL:
1111# /diff.cgi?kind=file&id=N -- FILE_CHANGES row
1212# /diff.cgi?kind=schema&id=N -- SCHEMA_CHANGE row
1313#======================================================================
1414use strict;
1515use warnings;
1616use CGI ();
1717use Compress::Zlib qw(uncompress);
1818use MODS::Config; use MODS::DBConnect; use MODS::Template; use MODS::PageWrapper;
1919
2020my $cgi = CGI->new;
2121my $db = MODS::DBConnect->new;
2222my $tpl = MODS::Template->new;
2323$|=1; print "Content-Type: text/html; charset=utf-8\nCache-Control: no-cache\n\n";
2424
2525my $kind = $cgi->param('kind') || '';
2626my $id = int($cgi->param('id') || 0);
2727
2828my $dbh = $db->db_connect or die "DB connect failed\n";
2929
3030my ($title, $subtitle, $blob_sha, $prev_sha, $meta) = ('', '', '', '', {});
3131
3232if ($kind eq 'file' && $id) {
3333 my $row = $db->db_readwrite($dbh, qq~
3434 SELECT fc.file_changes_id AS id, fc.file_name, fc.status, fc.blob_sha,
3535 fc.date_time, fc.uid, fc.gid, fc.permissions, fc.is_ts_only,
3636 fc.file_monitor_list_id, s.server_name
3737 FROM FILE_CHANGES fc LEFT JOIN SERVERS s ON s.server_id = fc.server_id
3838 WHERE fc.file_changes_id = $id LIMIT 1
3939 ~, __FILE__, __LINE__);
4040 if ($row && $row->{id}) {
41 # Find the previous captured version of this file for the "before" pane
41 # Find the previous captured version of this file for the "before" pane.
42 # Prefer same-monitor scope, but fall back to file-name-only for legacy
43 # rows where file_monitor_list_id is NULL.
4244 my $q_fname = $dbh->quote($row->{file_name});
45 my $scope = defined $row->{file_monitor_list_id}
46 ? "file_monitor_list_id = $row->{file_monitor_list_id} AND "
47 : '';
4348 my $prev = $db->db_readwrite($dbh, qq~
4449 SELECT blob_sha FROM FILE_CHANGES
45 WHERE file_monitor_list_id = $row->{file_monitor_list_id}
46 AND file_name = $q_fname
50 WHERE $scope
51 file_name = $q_fname
4752 AND file_changes_id < $id
4853 AND blob_sha IS NOT NULL
4954 ORDER BY file_changes_id DESC LIMIT 1
5055 ~, __FILE__, __LINE__);
5156 $title = $row->{file_name};
5257 $subtitle = "$row->{status} on $row->{server_name} at $row->{date_time}";
5358 $blob_sha = $row->{blob_sha};
5459 $prev_sha = $prev && $prev->{blob_sha} ? $prev->{blob_sha} : '';
5560 $meta = { %$row };
5661 }
5762}
5863elsif ($kind eq 'schema' && $id) {
5964 my $row = $db->db_readwrite($dbh, qq~
6065 SELECT sc.schema_change_id AS id, sc.database_name, sc.table_name, sc.changes,
6166 sc.schema_blob_sha, sc.change_datetime, s.server_name, sc.server_id
6267 FROM SCHEMA_CHANGE sc LEFT JOIN SERVERS s ON s.server_id = sc.server_id
6368 WHERE sc.schema_change_id = $id LIMIT 1
6469 ~, __FILE__, __LINE__);
6570 if ($row && $row->{id}) {
6671 my $q_db = $dbh->quote($row->{database_name});
6772 my $q_t = $dbh->quote($row->{table_name});
6873 my $prev = $db->db_readwrite($dbh, qq~
6974 SELECT schema_blob_sha FROM SCHEMA_CHANGE
7075 WHERE server_id = $row->{server_id}
7176 AND database_name = $q_db AND table_name = $q_t
7277 AND schema_change_id < $id
7378 AND schema_blob_sha IS NOT NULL
7479 ORDER BY schema_change_id DESC LIMIT 1
7580 ~, __FILE__, __LINE__);
7681 $title = "$row->{database_name}.$row->{table_name}";
7782 $subtitle = "on $row->{server_name} at $row->{change_datetime}";
7883 $blob_sha = $row->{schema_blob_sha};
7984 $prev_sha = $prev && $prev->{schema_blob_sha} ? $prev->{schema_blob_sha} : '';
8085 $meta = { %$row };
8186 }
8287}
8388
8489# Fetch + decompress blobs
8590my $curr = $blob_sha ? _fetch_blob($db, $dbh, $blob_sha) : '';
8691my $prev = $prev_sha ? _fetch_blob($db, $dbh, $prev_sha) : '';
8792
8893$db->db_disconnect($dbh);
8994
9095# Compute a naive line-level diff
9196my @lines = _line_diff($prev // '', $curr // '');
9297my ($ct_add, $ct_del) = (0, 0);
9398foreach my $L (@lines) {
9499 $ct_add++ if $L->{op} eq 'add';
95100 $ct_del++ if $L->{op} eq 'del';
96101}
97102
98103my $tvars = {
99104 title => $title || '(unknown)',
100105 subtitle => $subtitle,
101106 kind => $kind,
102107 id => $id,
103108 has_diff => scalar(@lines) ? 1 : 0,
104109 lines => \@lines,
105110 ct_add => $ct_add,
106111 ct_del => $ct_del,
107112 ct_context => scalar(@lines) - $ct_add - $ct_del,
108113 has_prev => $prev_sha ? 1 : 0,
109114 curr_sha => substr($blob_sha || '', 0, 12),
110115 prev_sha => substr($prev_sha || '', 0, 12),
111116};
112117
113118my @body = $tpl->template('diff.html', $tvars);
114119MODS::PageWrapper->new->wrapper(
115120 page_title => "Diff -- $title",
116121 page_key => ($kind eq 'schema' ? 'schema_changes' : 'file_changes'),
117122 body_html => join('', @body),
118123 userinfo => { display_name => 'Operator' },
119124);
120125
121126#---------------------------------------------------------------------
122127sub _fetch_blob {
123128 my ($db, $dbh, $sha) = @_;
124129 my $sth = $dbh->prepare("SELECT content_gz FROM BLOB_STORE WHERE blob_sha = ?");
125130 return '' unless $sth && $sth->execute($sha);
126131 my $row = $sth->fetchrow_arrayref;
127132 $sth->finish;
128133 return '' unless $row && $row->[0];
129134 my $decompressed = eval { uncompress($row->[0]) };
130135 return $decompressed // '';
131136}
132137
133138#---------------------------------------------------------------------
134139# _line_diff -- naive line-level diff. Returns an array of hashrefs:
135140# { op => 'add' | 'del' | 'ctx', text => $line, old_n, new_n }
136141# Uses a simple LCS-based approach; adequate for small-to-medium files.
137142# For huge diffs shell out to /usr/bin/diff (future optimization).
138143#---------------------------------------------------------------------
139144sub _line_diff {
140145 my ($old, $new) = @_;
141146 my @old_lines = split /\r?\n/, ($old // '');
142147 my @new_lines = split /\r?\n/, ($new // '');
143148
144149 # LCS length table (dynamic programming) -- capped to prevent
145150 # runaway memory on huge inputs.
146151 my $O = scalar @old_lines;
147152 my $N = scalar @new_lines;
148153 if ($O > 5000 || $N > 5000) {
149154 # Fall back: just dump both sides linearly, marked as del/add.
150155 my @out;
151156 my $i = 0;
152157 push @out, { op => 'del', text => $_, old_n => ++$i, new_n => '' } for @old_lines;
153158 my $j = 0;
154159 push @out, { op => 'add', text => $_, old_n => '', new_n => ++$j } for @new_lines;
155160 return @out;
156161 }
157162
158163 my @lcs; for my $i (0..$O) { $lcs[$i][0] = 0; }
159164 for my $j (0..$N) { $lcs[0][$j] = 0; }
160165 for my $i (1..$O) {
161166 for my $j (1..$N) {
162167 $lcs[$i][$j] = $old_lines[$i-1] eq $new_lines[$j-1]
163168 ? $lcs[$i-1][$j-1] + 1
164169 : ($lcs[$i-1][$j] >= $lcs[$i][$j-1] ? $lcs[$i-1][$j] : $lcs[$i][$j-1]);
165170 }
166171 }
167172
168173 my @out;
169174 my ($i, $j) = ($O, $N);
170175 while ($i > 0 || $j > 0) {
171176 if ($i > 0 && $j > 0 && $old_lines[$i-1] eq $new_lines[$j-1]) {
172177 unshift @out, { op => 'ctx', text => $old_lines[$i-1], old_n => $i, new_n => $j };
173178 $i--; $j--;
174179 } elsif ($j > 0 && ($i == 0 || $lcs[$i][$j-1] >= $lcs[$i-1][$j])) {
175180 unshift @out, { op => 'add', text => $new_lines[$j-1], old_n => '', new_n => $j };
176181 $j--;
177182 } else {
178183 unshift @out, { op => 'del', text => $old_lines[$i-1], old_n => $i, new_n => '' };
179184 $i--;
180185 }
181186 }
182187 return @out;
183188}