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