Diff -- /var/www/vhosts/3dshawn.com/site1/MODS/Diff.pm
Diff
/var/www/vhosts/3dshawn.com/site1/MODS/Diff.pm
added on local at 2026-07-12 00:02:00
Added
+73
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to ae268cd7efea
to ae268cd7efea
Unified diff
Naive LCS-based line diff. Additions in emerald, deletions in rose. Both sides decompressed live from BLOB_STORE.| 1 | package MODS::Diff; | |
| 2 | #====================================================================== | |
| 3 | # DriftSense -- line-level diff helper (extracted from diff.cgi so | |
| 4 | # restore.cgi + any future viewer can reuse it). | |
| 5 | # | |
| 6 | # lines($before_str, $after_str) -> ( { op, text, old_n, new_n }, ... ) | |
| 7 | # | |
| 8 | # op is 'add' | 'del' | 'ctx'. `text` is NOT HTML-escaped; the caller | |
| 9 | # is responsible for escaping when rendering. | |
| 10 | # | |
| 11 | # Naive LCS-based diff, capped at 5000 lines per side. Beyond the cap | |
| 12 | # we fall back to "all-del + all-add" to keep memory bounded. | |
| 13 | #====================================================================== | |
| 14 | use strict; | |
| 15 | use warnings; | |
| 16 | ||
| 17 | my $MAX_LCS_LINES = 5000; | |
| 18 | ||
| 19 | sub lines { | |
| 20 | my ($old, $new) = @_; | |
| 21 | my @old_lines = split /\r?\n/, ($old // ''); | |
| 22 | my @new_lines = split /\r?\n/, ($new // ''); | |
| 23 | my $O = scalar @old_lines; | |
| 24 | my $N = scalar @new_lines; | |
| 25 | ||
| 26 | if ($O > $MAX_LCS_LINES || $N > $MAX_LCS_LINES) { | |
| 27 | my @out; | |
| 28 | my $i = 0; | |
| 29 | push @out, { op => 'del', text => $_, old_n => ++$i, new_n => '' } for @old_lines; | |
| 30 | my $j = 0; | |
| 31 | push @out, { op => 'add', text => $_, old_n => '', new_n => ++$j } for @new_lines; | |
| 32 | return @out; | |
| 33 | } | |
| 34 | ||
| 35 | # DP table | |
| 36 | my @lcs; | |
| 37 | for my $i (0..$O) { $lcs[$i][0] = 0; } | |
| 38 | for my $j (0..$N) { $lcs[0][$j] = 0; } | |
| 39 | for my $i (1..$O) { | |
| 40 | for my $j (1..$N) { | |
| 41 | $lcs[$i][$j] = $old_lines[$i-1] eq $new_lines[$j-1] | |
| 42 | ? $lcs[$i-1][$j-1] + 1 | |
| 43 | : ($lcs[$i-1][$j] >= $lcs[$i][$j-1] ? $lcs[$i-1][$j] : $lcs[$i][$j-1]); | |
| 44 | } | |
| 45 | } | |
| 46 | my @out; | |
| 47 | my ($i, $j) = ($O, $N); | |
| 48 | while ($i > 0 || $j > 0) { | |
| 49 | if ($i > 0 && $j > 0 && $old_lines[$i-1] eq $new_lines[$j-1]) { | |
| 50 | unshift @out, { op => 'ctx', text => $old_lines[$i-1], old_n => $i, new_n => $j }; | |
| 51 | $i--; $j--; | |
| 52 | } elsif ($j > 0 && ($i == 0 || $lcs[$i][$j-1] >= $lcs[$i-1][$j])) { | |
| 53 | unshift @out, { op => 'add', text => $new_lines[$j-1], old_n => '', new_n => $j }; | |
| 54 | $j--; | |
| 55 | } else { | |
| 56 | unshift @out, { op => 'del', text => $old_lines[$i-1], old_n => $i, new_n => '' }; | |
| 57 | $i--; | |
| 58 | } | |
| 59 | } | |
| 60 | return @out; | |
| 61 | } | |
| 62 | ||
| 63 | sub html_escape_lines { | |
| 64 | my (@lines) = @_; | |
| 65 | for my $L (@lines) { | |
| 66 | my $t = $L->{text}; $t = '' unless defined $t; | |
| 67 | $t =~ s/&/&/g; $t =~ s/</</g; $t =~ s/>/>/g; | |
| 68 | $L->{text} = $t; | |
| 69 | } | |
| 70 | return @lines; | |
| 71 | } | |
| 72 | ||
| 73 | 1; |