|
1
|
#!/usr/bin/env perl |
|
2
|
# Fossil emulation of the "git log --patch / -p" feature: emit a stream |
|
3
|
# of diffs from one version to the next for each file named on the |
|
4
|
# command line. |
|
5
|
# |
|
6
|
# LIMITATIONS: It does not assume "all files" if you give no args, and |
|
7
|
# it cannot take a directory to mean "all files under this parent". |
|
8
|
# |
|
9
|
# PREREQUISITES: This script needs several CPAN modules to run properly. |
|
10
|
# There are multiple methods to install them: |
|
11
|
# |
|
12
|
# sudo dnf install perl-File-Which perl-IO-Interactive |
|
13
|
# sudo apt install libfile-which-perl libio-interactive-perl |
|
14
|
# sudo cpanm File::Which IO::Interactive |
|
15
|
# ...etc... |
|
16
|
|
|
17
|
use strict; |
|
18
|
use warnings; |
|
19
|
|
|
20
|
use Carp; |
|
21
|
use File::Which; |
|
22
|
use IO::Interactive qw(is_interactive); |
|
23
|
|
|
24
|
die "usage: $0 <files...>\n\n" unless @ARGV; |
|
25
|
|
|
26
|
my $out; |
|
27
|
if (is_interactive()) { |
|
28
|
my $pager = $ENV{PAGER} || which('less') || which('more'); |
|
29
|
open $out, '|-', $pager or croak "Cannot pipe to $pager: $!"; |
|
30
|
} |
|
31
|
else { |
|
32
|
$out = *STDOUT; |
|
33
|
} |
|
34
|
|
|
35
|
open my $bcmd, '-|', 'fossil branch current' |
|
36
|
or die "Cannot get branch: $!\n"; |
|
37
|
my $cbranch = <$bcmd>; |
|
38
|
chomp $cbranch; |
|
39
|
close $bcmd; |
|
40
|
|
|
41
|
for my $file (@ARGV) { |
|
42
|
my $lastckid; |
|
43
|
open my $finfo, '-|', "fossil finfo --brief --limit 0 '$file'" |
|
44
|
or die "Failed to get file info: $!\n"; |
|
45
|
my @filines = <$finfo>; |
|
46
|
close $finfo; |
|
47
|
|
|
48
|
for my $line (@filines) { |
|
49
|
my ($currckid, $date, $user, $branch, @cwords) = split ' ', $line; |
|
50
|
next unless $branch eq $cbranch; |
|
51
|
if (defined $lastckid and defined $branch) { |
|
52
|
my $comment = join ' ', @cwords; |
|
53
|
open my $diff, '-|', 'fossil', 'diff', $file, |
|
54
|
'--from', $currckid, |
|
55
|
'--to', $lastckid, |
|
56
|
or die "Failed to diff $currckid -> $lastckid: $!\n"; |
|
57
|
my @dl = <$diff>; |
|
58
|
close $diff; |
|
59
|
my $patch = join '', @dl; |
|
60
|
|
|
61
|
print $out <<"OUT" |
|
62
|
Checkin ID $currckid to $branch by $user on $date |
|
63
|
Comment: $comment |
|
64
|
|
|
65
|
$patch |
|
66
|
|
|
67
|
OUT |
|
68
|
} |
|
69
|
|
|
70
|
$lastckid = $currckid; |
|
71
|
} |
|
72
|
} |
|
73
|
|