Locating Git commit graph cycles

git-commit-cycles.pl

#!/usr/bin/perl
use strict;
use warnings;
use Graph;
use List::MoreUtils qw( any );

my $g = Graph->new;
open my $git, '-|', q{git log --all --format='%H;%P'} or die;
print "Building commit graph ...\n";
while ( my $line = <$git> ) {
    chomp $line;
    my ($commit, $parents) = split /;/, $line;
    next if not $parents;
    for my $parent (split / /, $parents ) {
        $g->add_edge( $commit, $parent );
    }
}

print "Looking for commit cycles ...\n";
my @commits = $g->find_a_cycle;
if (@commits) {
    print "Found a cycle:\n";
    print " - $_\n" for @commits;

    print "\nLocating grafts that might have caused the cycle...\n";
    open my $grafts, '<', '.git/info/grafts' or die;
    while ( my $graft = <$grafts> ) {
        chomp $graft;
        my ($commit) = split / /, $graft;
        print "(line $.) $graft\n" if any { $_ eq $commit } @commits;
    }
}
else {
    print "No cycles found\n";
}