#!/usr/bin/perl -w # Copyright © 2015-2022 Jamie Zawinski # # Permission to use, copy, modify, distribute, and sell this software and its # documentation for any purpose is hereby granted without fee, provided that # the above copyright notice appear in all copies and that both that # copyright notice and this permission notice appear in supporting # documentation. No representations are made about the suitability of this # software for any purpose. It is provided "as is" without express or # implied warranty. # # Utility for emailing diffs of files. # I wrote this because Text::Diff is a piece of shit: http://jwz.org/b/yiHm # # Created: 25-Feb-2015. require 5; use diagnostics; use strict; use IPC::Open2; my $progname = $0; $progname =~ s@.*/@@g; my ($version) = ('$Revision: 1.13 $' =~ m/\s(\d[.\d]+)\s/s); my $verbose = 0; my $debug_p = 0; my $sendmail = '/usr/sbin/sendmail'; my $html_header = "\ "; my $html_footer = "\n \n\n"; sub html_quote($) { my ($s) = @_; $s =~ s/&/&/gs; $s =~ s//>/gs; return $s; } sub diff_to_html($) { my ($lines) = @_; my $out = ''; my $oclass = ''; my $chunkp = 0; foreach my $line (split(/\n/, $lines)) { utf8::decode($line); # Pack multi-byte UTF-8 into wide chars. $line = html_quote($line); my $class = ($line =~ m/^--- /s ? 'file' : $line =~ m/^\+\+\+ /s ? 'file' : $line =~ m/^\@\@ /s ? 'lines' : $line =~ s/^-//s ? 'del' : $line =~ s/^\+//s ? 'ins' : $line =~ s/^ //s ? 'ctx' : ''); if ($class ne $oclass) { $out .= "" if ($oclass); if (($oclass eq 'ins' || $oclass eq 'del') && ($class ne 'ins' && $class ne 'del' && $class ne 'ctx')) { # With -U0 we still need a blank ctx at the end of the 'chunk' # to make the floaters clear. $out .= '

'; } if ($class eq 'lines') { $out .= "" if ($chunkp); $out .= "

"; $chunkp = 1; } my $class2 = $class; # If there's an insert-only, let it take up both columns. # Doing this for delete-only would require backtracking. if ($class eq 'ins' && $oclass ne 'del') { $class2 .= ' wide'; } $out .= "

" if $class2; $oclass = $class; } $out .= $line . "\n"; } if ($out) { $out .= "

" if ($oclass); if ($oclass eq 'ins' || $oclass eq 'del') { $out .= '

'; } $out .= "

" if ($chunkp); $out = "

\n$out

\n"; } return $out; } sub diff_files($$$) { my ($old, $new, $ctx) = @_; my ($in, $out); my @cmd = ('diff', "-U$ctx", $old, $new); print STDERR "$progname: exec: " . join(' ', @cmd) . "\n" if ($verbose); my $pid = open2 ($out, $in, @cmd); close ($in); local $/ = undef; # read entire file my $lines = ''; while (<$out>) { $lines .= $_; } waitpid ($pid, 0); print STDERR "$progname: " . length($lines) . " bytes\n" if ($verbose); return diff_to_html ($lines); } sub mail_diff($$$$$) { my ($from, $to, $subj, $file, $ctx) = @_; my $cache = undef; my $diff = ''; if ($file eq '-') { print STDERR "$progname: reading stdin\n" if ($verbose); local $/ = undef; # read entire file while () { $diff .= $_; } $diff = diff_to_html ($diff); } else { my $f2 = $file; $f2 =~ s@^.*/@@s; $cache = $f2; $cache =~ s@^\.+@@s; $cache = ".$cache"; if ($cache ne $f2) { } elsif ($cache =~ m/^.[^.]+$/s) { # .foo -> .foo.2, foo -> foo.2 $cache .= '.2'; } else { $cache =~ s@(\.[^.]+)$@.2$1@s; # foo.txt -> foo.2.txt } $cache = $ENV{HOME} . "/$cache"; error ("same file: $file, $cache") if ($file eq $cache); my $cs = ((stat($cache))[7]); my $fs = ((stat($file)) [7]); error ("$file: empty file") unless $fs; if ($cs) { $diff = diff_files ($cache, $file, $ctx); } else { $diff = 'new file'; } } if ($diff) { if ($file =~ m@/topten\.txt$@s) { #### Kludge $diff =~ s@^([A-Z].*:)$@$1@gmi; $diff =~ s@^( +Last .*:)$@$1@gmi; } my $mail = ("From: $from\n" . "Subject: $subj\n" . "MIME-Version: 1.0\n" . "Content-Type: text/html; charset=UTF-8\n" . "To: $to\n" . "\n" . $html_header . $diff . $html_footer); my $to2 = $to; $to2 =~ s/,/ /gs; my @cmd = ($sendmail, '-t', $to2); if ($debug_p) { print STDERR "$progname: not mailing: " . join(' ', @cmd) . "\n$mail\n"; print STDERR "$progname: not writing: $cache\n" if ($cache); } else { print STDERR "$progname: mailing: " . join(' ', @cmd) . "\n$mail\n" if ($verbose); my ($in, $out); my $pid = open2 ($out, $in, @cmd); close ($out); binmode ($in, ':utf8'); print $in $mail; close ($in); waitpid ($pid, 0); # Copy $file to $cache if ($cache) { open ($out, '>:raw', $cache) || error ("$cache: $!"); open ($in, '<:raw', $file) || error ("$file: $!"); local $/ = undef; # read entire file while (<$in>) { print $out $_; } close $out; close $in; print STDERR "$progname: wrote $cache\n" if ($verbose); } } } else { print STDERR "$progname: $file: no changes\n" if ($verbose); } } sub error($) { my ($err) = @_; print STDERR "$progname: $err\n"; exit 1; } sub usage() { print STDERR "usage: $progname [--verbose] [--debug] " . "-Un from to subject file\n"; exit 1; } sub main() { my ($from, $to, $subj, $file); my $ctx = 3; while ($#ARGV >= 0) { $_ = shift @ARGV; if (m/^--?verbose$/) { $verbose++; } elsif (m/^-v+$/) { $verbose += length($_)-1; } elsif (m/^--?debug$/) { $debug_p++; } elsif (m/^--?ctx$/) { $ctx = shift @ARGV; } elsif (m/^-[Uu](\d+)$/) { $ctx = $1; } elsif (m/^-./) { usage; } elsif (!$from) { $from = $_; } elsif (!$to) { $to = $_; } elsif (!$subj) { $subj = $_; } elsif (!$file) { $file = $_; } else { usage; } } usage unless ($file); mail_diff ($from, $to, $subj, $file, $ctx); } main(); exit 0;