#!/usr/bin/perl ## Copyright (C) 2018 Steve McIntyre <93sam@debian.org> ## ## This program is free software; you can redistribute it and/or modify it ## under the terms of version 2 of the GNU General Public License as published ## by the Free Software Foundation. =head1 NAME Local::VCS_git - generic wrapper around version control systems -- git version =head1 SYNOPSIS use Local::VCS_git; use Data::Dumper; my $VCS = Local::VCS->new(); my %info = $VCS->path_info( '.', recursive => 1, verbose => 1 ); print Dumper($info{'foo.wml'}); =head1 DESCRIPTION This module retrieves git info (such as revision of latest change, date of latest change, author, etc) for checked-out object in a working directory. For *best* performance if you're making lots of calls here, call $VCS->(cache_repo) before you start. It will take a few seconds to build a hash cache of all the git revisions for each file. If you're only making a few calls, don't bother. Another option (ideal for lots of separate programs all making a small number of calls like a big "make" on the website) is to build a shared cache on disk first. See the "build_vcs_cache.pl" script. If the on-disk cache is initialised before the start, then all callers into this module will benefit from a speedup almost as large as each having a separate in-memory cache. =head1 METHODS =over 4 =cut package Local::VCS_git; use 5.008; use File::Basename; use File::Find; use File::Spec::Functions qw( abs2rel rel2abs splitdir catfile rootdir catdir ); use File::stat; use File::Path qw(make_path remove_tree); use Carp; use Fcntl qw/:flock/; use POSIX qw/ WIFEXITED /; use Cwd qw/cwd/; use Time::HiRes qw/gettimeofday/; use Data::Dumper; use Digest::MD5 qw(md5 md5_hex md5_base64); my $cache_db = ".git-revs-cache.db"; my $cache_lock = ".git-revs-cache.lock"; my $git_index = ".git/index"; # The timestamp where we finished the CVS to git transition. Before # this date, we need to include merge commits in our output (due to # the way the transition code worked). After this date, we do *not* # want to include merge commits. Ugh... :-/ my $timestamp_cvs2git = 1527734365; my $git_log_common = 'git log --no-renames --name-only --numstat --format=format:"%H %ct"'; my $git_log_old = "$git_log_common --before $timestamp_cvs2git -m --first-parent"; my $git_log_new = "$git_log_common --since $timestamp_cvs2git --no-merges"; use strict; use warnings; BEGIN { use base qw( Exporter ); our $VERSION = "1.13"; our @EXPORT_OK = qw( &new ); our %EXPORT_TAGS = ( 'all' => [@EXPORT_OK] ); } =item new This is the constructor. my $VCS = Local::VCS->new(); =cut sub new { my $class = shift; my %params = @_; my $self = { CACHE => {}, # Possible REPO_CACHED values: # 0 == not all cached (slowest) # 1 == cached in a valid db (disk files) # 2 == cached in a hash in RAM (fastest) REPO_CACHED => 0, DEBUG => 0, }; bless ($self, $class); if ($params{"DEBUG"}) { $self->{DEBUG} = $params{"DEBUG"}; } if ($self->db_cache_valid()) { $self->{REPO_CACHED} = 1; } return $self; } sub _get_time() { my @tm; my $text; my ($seconds, $microseconds) = gettimeofday; @tm = gmtime(); $text = sprintf("%4d-%02d-%02d %02d:%02d:%02d.%06d UTC", (1900 + $tm[5]),(1 + $tm[4]),$tm[3],$tm[2],$tm[1],$tm[0], $microseconds); return $text; } sub _debug { my $self = shift; my @text = @_; return unless $self->{DEBUG}; my $timestamp = _get_time(); print STDERR "=> ", $timestamp, " ", @text, "\n"; return; } # Internal helper function. Try to change to the target directory. If # we can't for some reason (e.g. it doesn't exist), print an error # *and* change to the fallback directory instead, then return false.. # # Useful in a number of places in this code where we're in a nested # set of chdir() calls and we want to exit cleanly on error sub _safe_chdir { my $target = shift; my $fallback = shift; if (!chdir($target)) { print STDERR "ERROR: Can't chdir to $target: $!\n"; chdir($fallback) or die "Can't chdir to fallback dir $fallback: $!\n"; return 0; } return 1; } sub _add_cache_entry { my $self = shift; my $file = shift; my %entry; $entry{'cmt_date'} = shift; $entry{'cmt_rev'} = shift; my $tmp; my @list; # print __LINE__ . ": adding $file, " . Dumper(%cache); if ($self->{CACHE}{"$file"}) { $tmp = $self->{CACHE}{"$file"}; @list = @$tmp; } push(@list, \%entry); $self->{CACHE}{"$file"} = \@list; } sub cache_file { my $self = shift; my $file = shift; $self->_debug( "cache_file($file)"); if ($self->{REPO_CACHED}) { $self->_debug( "cache_file() returning early - whole repo already cached"); return; } if ($self->{CACHE}{"$file"}) { $self->_debug( "$file is already cached..."); $self->_debug( "cache_file($file) returning early"); return; } $self->_debug( "Adding $file to cache\n"); # Store the current directory so we can return there my $startdir = cwd; my $topdir = $self->get_topdir(); _safe_chdir($topdir, $startdir) or die "Can't chdir to $topdir: $!\n"; my (@commits); # Complication of the cvs2git transition. We want merges from before that, but not since. open (GITLOG, "($git_log_new -- $file ; $git_log_old -- $file) |") or die "Can't fork git log: $!\n"; my ($cmt_date, $cmt_rev); while (my $line = ) { chomp $line; if ($line =~ m/^([[:xdigit:]]+) (\d+)$/) { $cmt_rev = $1; $cmt_date = $2; next; } elsif ($line =~ m{^$file$}) { $self->_add_cache_entry($file, $cmt_date, $cmt_rev); } } close GITLOG; $self->_debug( "cache_file($file) done"); chdir ($startdir); return; } sub db_cache_valid { my $self = shift; my $valid = 0; # If we can't find the right dir, it can't be valid! my $topdir = $self->get_topdir() or return 0; $self->_debug( "db_cache_valid"); # Check to see if an existing cache DB file is up to date # compared to the git index. if (-d "$topdir/$cache_db") { $self->_debug( "db_cache_valid: file $topdir/$cache_db exists ok"); my $dbs = stat("$topdir/$cache_db"); my $ids = stat("$topdir/$git_index"); my $mtime1 = $dbs->mtime; my $mtime2 = $ids->mtime; $self->_debug( "dbs has mtime $mtime1, ids has mtime $mtime2"); if ($dbs->mtime < $ids->mtime) { $self->_debug( "db_cache_valid: but is out of date, rebuild needed"); $valid = 0; } else { $valid = 1; } } else { # We don't have a cache file, we have to rebuild it $valid = 0; $self->_debug( "db_cache_valid: dir does not exist, so not valid"); } return $valid; } # Internal helper string - (md5) hash a string and return the hash sub _hash_string { my $string = shift; return md5_hex($string); } # Dump our hashed cache out to disk so we can share it with other # processes sub save_cache_to_database { my $self = shift; my %args = @_; my $tmp_cache_db = "$cache_db.tmp"; my $query; print Dumper(%args); $self->_debug( "save_cache_to_database starting"); # Now we're locked, see if the db s valid - somebody else might # have updated it for us! if (! $args{"FORCE"} and $self->db_cache_valid()) { $self->_debug( "save_cache_to_database: Not rebuilding cache, it's already valid now"); return; } remove_tree($cache_db); make_path($tmp_cache_db); my $tmp = $self->{CACHE}; my $table_count = 0; my $row_count = 0; foreach my $key(sort keys %$tmp) { my $file = $key; my $tmp1 = $self->{CACHE}{"$file"}; my @list = @$tmp1; my $tablename = _hash_string($file); open (OUT, "> $tmp_cache_db/$tablename") or die "Can't create file $tmp_cache_db/$tablename: $!\n"; $table_count++; foreach my $tmp2 (@list) { my %entry = %$tmp2; printf OUT "%s %s\n", $entry{"cmt_date"}, $entry{"cmt_rev"}; $row_count++; } if (0 == $table_count % 1000 or $table_count == scalar(keys %$tmp)) { $self->_debug( "$row_count rows, $table_count tables done"); } close OUT; } rename $tmp_cache_db, $cache_db; $self->_debug( "save_cache_to_database done"); } sub cache_repo { my $self = shift; $self->_debug( "cache_repo()"); # If we've already read the commit history into our cache, return # immediately if ($self->{REPO_CACHED} == 2) { $self->_debug( "cache_repo() returning early"); return; } # Store the current directory so we can return there my $startdir = cwd; my $topdir = $self->get_topdir(); _safe_chdir($topdir, $startdir) or die "Can't chdir to $topdir: $!\n"; # Clear the cache and rebuild from scratch. We might havs # some files cached individually, and that would confuse # things now. $self->{CACHE} = {}; # print __LINE__ . ": " . Dumper(%cache); my (@commits); my $count = 0; open (GITLOG, "($git_log_new ; $git_log_old) |") or die "Can't fork git log: $!\n"; my ($cmt_date, $cmt_rev); while (my $line = ) { chomp $line; if ($line =~ m/^([[:xdigit:]]+) (\d+)$/) { $cmt_rev = $1; $cmt_date = $2; next; } elsif ($line =~ m{^(\S+)$}) { my $file = $1; $self->_add_cache_entry($file, $cmt_date, $cmt_rev); $count++; } } close GITLOG; $self->{REPO_CACHED} = 2; my $tmp = $self->{CACHE}; my $num_files = scalar(keys %$tmp); $self->_debug( "cache_repo() done, $count file commits, $num_files files"); chdir ($startdir); } # Internal helper function - grab a list of all the commits to a given # file. This mist be relative to the top level of the repository. The # caller must deal with this sub _grab_commits { my $self = shift; my $file = shift or return undef; $self->cache_file($file); if ($self->{REPO_CACHED} == 1) { # Grab from the on-disk files my $tablename = _hash_string($file); my $commits; # Take a shared lock to stop somebody taking the cache out # from underneath us open (my $lock, "+> $cache_lock") or die "Can't create lock file $cache_lock: $!\n"; flock ($lock, LOCK_SH); $self->_debug("Reading $cache_db/$tablename for file $file"); open (IN, "< $cache_db/$tablename") or die "Can't open file $cache_db/$tablename for file $file: $!\n"; my @commits; while(my $line = ) { if ($line =~ m/^(\d+)\s+([[:alnum:]]+)$/) { my %entry = ( 'cmt_date' => $1, 'cmt_rev' => $2, ); push (@commits, \%entry); } else { print STDERR "ERROR: Can't parse $line in $cache_db/$tablename for file $file\n"; } } close IN; flock ($lock, LOCK_UN); close ($lock); # print Dumper(@commits); return @commits; } else { # Return directly from the in-memory cache $self->_debug("Reading hash cache for file $file"); my $tmp = $self->{CACHE}{"$file"}; if (defined $tmp) { my @commits = @$tmp; # print Dumper(@commits); return @commits; } return undef; } } =item cmp_rev Compare two revision strings for a given file. Takes the file path and two revision strings as arguments, and returns 1 if the first one is newer, -1 if the second one is newer, 0 if they are equal =cut sub cmp_rev { # For the file we're looking at, we can easily generate an # array (list) of all the commit hashes. Then we can see where # in that list the specified revisions lie (from newest to # oldest) - that's what we're going to compare. my $self = shift; my $file = shift or return undef; my $rev1 = shift or return undef; my $rev2 = shift or return undef; my $ret = undef; # remove both leading and trailing whitespace, in case $rev1 =~ s/^\s+|\s+$//g; $rev2 =~ s/^\s+|\s+$//g; # Work out where we need to be. This can be quite hairy if the # user has given us a mix of relative and absolute paths from # their program. Do this cleanly, somehow...! # First of all, store the current directory so we can return # there my $startdir = cwd; my $indir = dirname($file); my $basefile = basename($file); # Change to the directory of the file we've been asked about _safe_chdir($indir, $startdir) or return undef; $indir = cwd; # That should be inside the repo, so now we can change to the # repo root my $topdir = $self->get_topdir(); _safe_chdir($topdir, $startdir) or return undef; # Now calculate where the file is, relative to the repo root my $reldir = abs2rel($indir, cwd); my $relfile = catdir($reldir, $basefile); $self->_debug( "cmp_rev(): looking for details of file $relfile, indir $indir"); my @commits = $self->_grab_commits($relfile); # print Dumper(@commits); my $pos1 = -1; my $pos2 = -1; my $count = 0; foreach my $tmp(@commits) { my %entry = %$tmp; if ($entry{'cmt_rev'} =~ /\Q$rev1\E/) { $pos1 = $count; } if ($entry{'cmt_rev'} =~ /\Q$rev2\E/) { $pos2 = $count; } if ($pos1 != -1 and $pos2 != -1) { last; } $count++; } if ($pos1 == -1) { # Not found print STDERR "ERROR: commit rev1 $rev1 not found in revisions of $file\n"; $ret = undef; } elsif ($pos2 == -1) { # Not found print STDERR "ERROR: commit rev2 $rev2 not found in revisions of $file\n"; $ret = undef; } elsif ($pos1 == $pos2) { $ret = 0; } elsif ($pos1 < $pos2) { $ret = 1; } else { $ret = -1; } # Now return to the directory where we started chdir($startdir); return $ret; } =item count_changes Return the number of changes to particular file between two revisions The first argument is a name of a file. The second and third argument specify the revision range Example use: my $num1 = count_changes( 'foo.c', 'r42', 'r70' ); my $num2 = count_changes( 'foo.c', 'r42', 'HEAD' ); =cut sub count_changes { # FIXME: not sure if we need to handle the issue of wrong $rev1/$rev2 here # or the caller function will care. # Not sure if this function makes sense in a git context, either, # but just in case my $self = shift; my $file = shift or return undef; my $rev1 = shift || ''; my $rev2 = shift || ''; my $ret = 0; # remove both leading and trailing whitespace, in case $rev1 =~ s/^\s+|\s+$//g; $rev2 =~ s/^\s+|\s+$//g; if ($rev1 =~ m/^\Q$rev2\E$/) { # same revisions return 0; } # Work out where we need to be. This can be quite hairy if the # user has given us a mix of relative and absolute paths from # their program. Do this cleanly, somehow...! # First of all, store the current directory so we can return # there my $startdir = cwd; my $indir = dirname($file); my $basefile = basename($file); # Change to the directory of the file we've been asked about _safe_chdir($indir, $startdir) or return undef; $indir = cwd; # That should be inside the repo, so now we can change to the # repo root my $topdir = $self->get_topdir(); _safe_chdir($topdir, $startdir) or return undef; # Now calculate where the file is, relative to the repo root my $reldir = abs2rel($indir, cwd); my $relfile = catdir($reldir, $basefile); $self->_debug( "count_changes(): looking for details of file $relfile, indir $indir"); my @commits = $self->_grab_commits($relfile); # If unset, go for the last revision if (length($rev2) == 0) { $rev2 = $commits[$#commits]; } my $pos1 = -1; my $pos2 = -1; my $count = 0; foreach my $tmp(@commits) { my %entry = %$tmp; if ($entry{'cmt_rev'} =~ /\Q$rev1\E/) { $pos1 = $count; } if ($entry{'cmt_rev'} =~ /\Q$rev2\E/) { $pos2 = $count; } if ($pos1 != -1 and $pos2 != -1) { last; } $count++; } if ($pos1 == -1) { # Not found print STDERR "count_changes() ERROR: commit rev1 $rev1 not found in revisions of $file\n"; $ret = undef; } elsif ($pos2 == -1) { # Not found print STDERR "count_changes() ERROR: commit rev2 $rev2 not found in revisions of $file\n"; $ret = undef; } else { $ret = $pos1 - $pos2; } # Now return to the directory where we started chdir($startdir); return $ret; } # return the type of the input argument (file, dir, symlink, etc) sub _typeoffile { my $file = shift or return; stat $file or return 'f'; # File is not here now; assume it # was a file! return 'f' if ( -f _ ); return 'd' if ( -d _ ); return 'l' if ( -l _ ); return 'S' if ( -S _ ); return 'p' if ( -p _ ); return 'b' if ( -b _ ); return 'c' if ( -c _ ); return ''; } =item path_info Return git information and status about a tree of files. The first argument is a name of a file or directory, and subsequent arguments form a hash of named options (see below). The function returns a hash, which for each filename contains git status information: 'type' => type of the file ('d' directory, 'f' regular file, etc) 'cmt_rev' => revision in which latest change was made to this file 'cmt_date' => date on which latest change to this file was committed Optional remaining arguments are a hash array with options: recursive: if set to a true value (and the specified file is a directory), recurse into subdirectories match_pat: only files/dirs that match this pattern are processed skip_pat: files/dirs that match this pattern are skipped Example uses: my %info1 = $VCS->path_info( 'src' ); my %info2 = $VCS->path_info( 'src', recursive => 1 ); my %info3 = $VCS->path_info( 'src', recursive => 1, match_pat => '\.c$' ); =cut # todo: verbose sub path_info { # Two parts: # # (1) Build a hash of all the files we want to know about # # (2a) Ask git about all the files it has, and pull out # information for ones in the hash from (1) # # OR # # (2b) Grab that information from our cache of all the commit data, # if we have already been told to generate that cache. # *Don't* generate that cache automatically - for just a few # files it's quicker to just look up the data directly. If the # user is going to do a lot of lookups, let them populate the # cache up-front themselves if performance matters. # # This may not sound very quick, but it's much better than asking git # about all the details individually! # FIXME! path_info will not work unless you start at the root # of the repository. my $self = shift; my ($dir,%options) = @_; my %files_wanted; croak("No file or directory specified") unless $dir; $self->_debug( "path_info ($dir)"); if ($self->get_topdir() !~ /^\.$/) { croak "path_info() needs to be called in the root of the webwml repo\n"; } my $recurse = $options{recursive} || $options{recurse} || 0; my $match_pat = $options{match_pat} || undef; my $skip_pat = $options{skip_pat} || undef; $self->_debug( "Recurse is $recurse"); $self->_debug( "Match pattern is '$match_pat'") if defined $match_pat; $self->_debug( "Skip pattern is '$skip_pat'") if defined $skip_pat; if ($recurse) { find( sub { $files_wanted{$File::Find::name} = 1 if -f and (!defined $match_pat or m/$match_pat/) and (!defined $skip_pat or not ($File::Find::name =~ m/$skip_pat/))}, $dir ); } else { find( sub { $files_wanted{$File::Find::name} = 1 if -f and ($File::Find::dir eq $dir) and (!defined $match_pat or m/$match_pat/) and (!defined $skip_pat or not ($File::Find::name =~ m/$skip_pat/))}, $dir ); } # Calling "git log" for each file individually is hatefully # slow. Better option: call it once with appropriate options # for the directory we're targeting, and parse the # output. Gross, but it works. my %pathinfo; # Do we have the repo commit history cached? if ($self->{REPO_CACHED}) { # We do, use it! (2b above) foreach my $file (keys %files_wanted) { my @commits = $self->_grab_commits($file); if (@commits) { my $outfile = $file; $outfile =~ s,^$dir/,,; # Grab the data we want from the first entry in the # commits list, i.e. the most recent commit. $pathinfo{$outfile}{'type'} = _typeoffile("$file"); $pathinfo{$outfile}{'cmt_date'} = $commits[0]{'cmt_date'}; $pathinfo{$outfile}{'cmt_rev'} = $commits[0]{'cmt_rev'}; } else { $self->_debug( "Ignoring file $file"); } } } else { # We don't, so we need to talk to git. (2a above) open (GITLOG, "($git_log_new $dir; $git_log_old $dir) |") or die "Can't fork git log: $!\n"; my $cmt_date; my $cmt_rev; my $file; while (my $line = ) { chomp $line; if ($line =~ m/^([[:xdigit:]]+) (\d+)$/) { $cmt_rev = $1; $cmt_date = $2; next; } elsif ($line =~ m{^$dir/(\S+)$}) { $file = $1; # Only store information if: # We want this file, and # We don't have data for it yet (i.e. only show # the most recent version of a file) if ($files_wanted{"$dir/$file"} and not defined $pathinfo{$file}) { $pathinfo{$file}{'type'} = _typeoffile("$dir/$file"); $pathinfo{$file}{'cmt_date'} = $cmt_date; $pathinfo{$file}{'cmt_rev'} = $cmt_rev; } } } close GITLOG; } $self->_debug( "path_info ($dir) returning"); return %pathinfo; } =item file_info Return VCS information and status about a single file The single argument is a name of a file. The function returns a hash, which contains VCS status information for the specified file: 'type' => type of the file ('d' directory, 'f' regular file, etc) 'cmt_rev' => revision in which latest change was made to this file 'cmt_date' => date on which latest change to this file was committed Example use: my %info = $VCS->file_info( 'foo.wml' ); =cut sub file_info { my $self = shift; my $file = shift or carp("No file specified"); my %options = @_; my $quiet = $options{quiet} || undef; my %pathinfo; # Work out where we need to be. This can be quite hairy if the # user has given us a mix of relative and absolute paths from # their program. Do this cleanly, somehow...! # First of all, store the current directory so we can return # there my $startdir = cwd; my $indir = dirname($file); my $basefile = basename($file); # Change to the directory of the file we've been asked about _safe_chdir($indir, $startdir) or return undef; $indir = cwd; # That should be inside the repo, so now we can change to the # repo root my $topdir = $self->get_topdir(); _safe_chdir($topdir, $startdir) or return undef; # Now calculate where the file is, relative to the repo root my $reldir = abs2rel($indir, cwd); my $relfile = catdir($reldir, $basefile); $self->_debug( "file_info(): looking for details of file $relfile, indir $indir"); my @commits = $self->_grab_commits($relfile); if (@commits) { # Grab the data we want from the first entry in the # commits list, i.e. the most recent commit. $pathinfo{'type'} = _typeoffile("$file"); $pathinfo{'cmt_date'} = $commits[0]{'cmt_date'}; $pathinfo{'cmt_rev'} = $commits[0]{'cmt_rev'}; } # Now return to the directory where we started chdir($startdir); return %pathinfo; } =item get_log Return the log info about a specified file The first argument is a name of a checked-out file. The (optional) second and third argument specify the starting and end revision of the log entries Example use: my @log_entries = get_log( 'foo.wml' ); =cut sub get_log { my $self = shift; my $file = shift or return; my $rev1 = shift || ''; my $rev2 = shift || ''; my @logdata; my $command; # remove both leading and trailing whitespace, in case $rev1 =~ s/^\s+|\s+$//g; $rev2 =~ s/^\s+|\s+$//g; # Work out where we need to be. This can be quite hairy if the # user has given us a mix of relative and absolute paths from # their program. Do this cleanly, somehow...! # First of all, store the current directory so we can return # there my $startdir = cwd; my $indir = dirname($file); my $basefile = basename($file); # Change to the directory of the file we've been asked about _safe_chdir($indir, $startdir) or return undef; $indir = cwd; # That should be inside the repo, so now we can change to the # repo root my $topdir = $self->get_topdir(); _safe_chdir($topdir, $startdir) or return undef; # Now calculate where the file is, relative to the repo root my $reldir = abs2rel($indir, cwd); my $relfile = catdir($reldir, $basefile); $self->_debug( "get_log(): looking for details of file $relfile, indir $indir"); if ($rev1 eq '' and $rev2 eq '') { $command = sprintf( 'git log --date=unix %s', $relfile ); } elsif ($rev2 eq '') { $command = sprintf( 'git log --date=unix %s^..%s %s', $rev1, $rev1, $relfile ); } elsif ($rev1 eq '') { $command = sprintf( 'git log --date=unix ..%s %s', $rev2, $relfile ); } else { $command = sprintf( 'git log --date=unix %s..%s %s', $rev1, $rev2, $relfile ); } $self->_debug( "get_log: running $command"); open( my $git, '-|', $command ) or croak("Couldn't run `$command': $!"); my $revision; my $author; my $date; my $message; my $first_record_done = 0; # read and parse the log records while ( my $line = <$git> ) { # the first 3 lines of a record contain metadata that looks like this: # commit abcdefg435768938de # Author: Jane Doe # Date: 1504881409 if ($line =~ m{^commit (.+)}) { # Second and subsequent record, push a result if ($first_record_done) { $self->_debug( "pushing a record (rev $revision)"); push @logdata, { 'rev' => $revision, 'author' => $author, 'date' => $date, 'message' => $message, }; $message = ""; } $first_record_done = 1; $revision = $1; } elsif ($line =~ m{^Author: (.+)}) { $author = $1; } elsif ($line =~ m{^Date: (.+)}) { $date = $1; } else { # Lose leading whitespace, but retain blank lines if ($line =~ m{\S}) { $line =~ s{^\s+}{}; } $message .= $line; } } close( $git ); if ($first_record_done) { # $self->_debug( "pushing last record (rev $revision)"); # Last record, push a result push @logdata, { 'rev' => $revision, 'author' => $author, 'date' => $date, 'message' => $message, }; chdir($startdir); return reverse @logdata; } chdir($startdir); return undef; } =item get_diff Returns a hash of (filename,diff) pairs containing the unified diff between two version of a (number of) files. The first argument is a name of a checked-out file. The second and third argument specify the starting and end revision of the log entries. If the third argument is not specified, the current (possibly modified) version is used. If the second argument is also not specified, the current (possibly modified) version is diffed against the latest checked in version. Example use: my %diffs = get_diff( 'foo.wml', '1.4', '1.17' ); my %diffs = get_diff( 'bla.wml', '1.8' ); my %diffs = get_diff( 'bas.wml' ); =cut sub get_diff { my $self = shift; my $file = shift or return; my $rev1 = shift; my $rev2 = shift; # remove both leading and trailing whitespace, in case $rev1 =~ s/^\s+|\s+$//g; $rev2 =~ s/^\s+|\s+$//g; # hash to store the output my %data; # Work out where we need to be. This can be quite hairy if the # user has given us a mix of relative and absolute paths from # their program. Do this cleanly, somehow...! # First of all, store the current directory so we can return # there my $startdir = cwd; my $indir = dirname($file); my $basefile = basename($file); # Change to the directory of the file we've been asked about _safe_chdir($indir, $startdir) or return undef; $indir = cwd; # That should be inside the repo, so now we can change to the # repo root my $topdir = $self->get_topdir(); _safe_chdir($topdir, $startdir) or return undef; # Now calculate where the file is, relative to the repo root my $reldir = abs2rel($indir, cwd); my $relfile = catdir($reldir, $basefile); $self->_debug( "get_diff(): looking for details of file $relfile, indir $indir"); my $command = sprintf( 'git diff %s %s -u %s 2> /dev/null', defined $rev1 ? "$rev1" : '', defined $rev2 ? "$rev2" : '', $relfile ); # print "$command\n"; open( my $git, '-|', $command ) or croak("Couldn't run `$command': $!"); # read the consecutive records while ( my $record = <$git> ) { # remove the record separator from the end of the record # $record =~ s{ $/ \n? \Z }{}msx; # remove the "index" line from the beginning of the record # $record =~ s{ ^index [^\n] }{}msx; # remove the first 2 lines $record =~ s{^diff\s+--git.*}{}msx; $record =~ s{^index\s+.*}{}msx; $data{$file} .= $record; } close( $git ); # Now return to the directory where we started chdir($startdir); return %data; } =item get_file Return a particular revision of a file The first argument is a name of a file. The second argument is the revision. This function retrieves the specified revision fo the file from the repository and returns it (without writing anything in the current checked-out tree) Example use: my $text = get_file( 'foo.c', '1.12' ); =cut sub get_file { my $self = shift; my $file = shift or croak("No file specified"); my $rev = shift or croak("No revision specified"); croak( "No such file: $file" ) unless -f $file; # Work out where we need to be. This can be quite hairy if the # user has given us a mix of relative and absolute paths from # their program. Do this cleanly, somehow...! # First of all, store the current directory so we can return # there my $startdir = cwd; my $indir = dirname($file); my $basefile = basename($file); # Change to the directory of the file we've been asked about _safe_chdir($indir, $startdir) or return undef; $indir = cwd; # That should be inside the repo, so now we can change to the # repo root my $topdir = $self->get_topdir(); _safe_chdir($topdir, $startdir) or return undef; # Now calculate where the file is, relative to the repo root my $reldir = abs2rel($indir, cwd); my $relfile = catdir($reldir, $basefile); $self->_debug( "get_file(): looking for details of file $relfile, indir $indir"); my $command = sprintf( 'git show %s:%s', $rev, $relfile ); my $text; open ( my $git, '-|', $command ) or croak("Error while executing `$command': $!"); while ( my $line = <$git> ) { $text .= $line; } close( $git ); croak("Error while executing `$command': $!") unless WIFEXITED($?); # Now return to the directory where we started chdir($startdir); # return the file return $text; } =item get_oldest_revision Return the version of the oldest version of a file The first argument is a name of a file. This function finds the oldest revision of a file that is known in the repository and returns it. Example use: my $rev = get_oldest_revision( 'foo.c'); =cut sub get_oldest_revision { my $self = shift; my $file = shift or croak("No file specified"); my $ret = undef; croak( "No such file: $file" ) unless -f $file; # Work out where we need to be. This can be quite hairy if the # user has given us a mix of relative and absolute paths from # their program. Do this cleanly, somehow...! # First of all, store the current directory so we can return # there my $startdir = cwd; my $indir = dirname($file); my $basefile = basename($file); # Change to the directory of the file we've been asked about _safe_chdir($indir, $startdir) or return undef; $indir = cwd; # That should be inside the repo, so now we can change to the # repo root my $topdir = $self->get_topdir(); _safe_chdir($topdir, $startdir) or return undef; # Now calculate where the file is, relative to the repo root my $reldir = abs2rel($indir, cwd); my $relfile = catdir($reldir, $basefile); $self->_debug( "get_oldest_revision(): looking for details of file $relfile, indir $indir"); my @commits = $self->_grab_commits($relfile); if (@commits) { # Simply return the last revision in our list $ret = $commits[$#commits]{'cmt_rev'}; } else { # Should hopefully never get here! croak(" Could not find any revisions for $file"); } # Now return to the directory where we started chdir($startdir); # return the information return $ret; } =item get_newest_revision Return the version of the newest version of a file The first argument is a name of a file. This function finds the newest revision of a file that is known in the repository and returns it. Example use: my $rev = get_newest_revision( 'foo.c'); =cut sub get_newest_revision { my $self = shift; my $file = shift or croak("No file specified"); my $ret = undef; croak( "No such file: $file" ) unless -f $file; # Work out where we need to be. This can be quite hairy if the # user has given us a mix of relative and absolute paths from # their program. Do this cleanly, somehow...! # First of all, store the current directory so we can return # there my $startdir = cwd; my $indir = dirname($file); my $basefile = basename($file); # Change to the directory of the file we've been asked about _safe_chdir($indir, $startdir) or return undef; $indir = cwd; # That should be inside the repo, so now we can change to the # repo root my $topdir = $self->get_topdir(); _safe_chdir($topdir, $startdir) or return undef; # Now calculate where the file is, relative to the repo root my $reldir = abs2rel($indir, cwd); my $relfile = catdir($reldir, $basefile); $self->_debug( "get_newest_revision(): looking for details of file $relfile, indir $indir"); my @commits = $self->_grab_commits($relfile); if (@commits) { # Simply return the first revision in our list $ret = $commits[0]{'cmt_rev'}; } else { # Should hopefully never get here! croak(" Could not find any revisions for $file"); } # Now return to the directory where we started chdir($startdir); # return the information return $ret; } =item next_revision Given a file path and a current revision of that file, move backwards or forwards through the commit history and return a related revision. Takes three arguments: the file path, the start revision and an integer to specify which direction to move *and* how far. A negative number specifies backwards in history, a positive number specifies forwards. Example use: my $rev = next_revision( 'foo.c', '72f6700577c79e6d284fbeac44366f6aa357d56d', -1); Returns the requested revision if it exists, otherwise *undef* =cut sub next_revision { # For the file we're looking at, we can easily generate an # array (list) of all the commit hashes. Then we can see where # in that list the specified revision lies. my $self = shift; my $file = shift or return undef; my $rev1 = shift or return undef; my $move = shift or return undef; my $ret = undef; # remove both leading and trailing whitespace, in case $rev1 =~ s/^\s+|\s+$//g; croak( "No such file: $file" ) unless -f $file; # Work out where we need to be. This can be quite hairy if the # user has given us a mix of relative and absolute paths from # their program. Do this cleanly, somehow...! # First of all, store the current directory so we can return # there my $startdir = cwd; my $indir = dirname($file); my $basefile = basename($file); # Change to the directory of the file we've been asked about _safe_chdir($indir, $startdir) or return undef; $indir = cwd; # That should be inside the repo, so now we can change to the # repo root my $topdir = $self->get_topdir(); _safe_chdir($topdir, $startdir) or return undef; # Now calculate where the file is, relative to the repo root my $reldir = abs2rel($indir, cwd); my $relfile = catdir($reldir, $basefile); $self->_debug( "next_revision(): looking for details of file $relfile, indir $indir"); $self->_debug( "rev1 $rev1, move $move"); my @commits = $self->_grab_commits($relfile); # print Dumper(@commits); my $pos1 = -1; my $pos2 = -1; my $count = 0; my %entry; foreach my $tmp(@commits) { %entry = %$tmp; if ($entry{'cmt_rev'} =~ /\Q$rev1\E/) { $pos1 = $count; } if ($pos1 != -1) { last; } $count++; } if ($pos1 == -1) { # Can't find the specified revision $ret = undef; } else { # API specifies -ve as older, but out list is sorted the other # way... $pos2 = $pos1 - $move; if ($pos2 < 0 or $pos2 > $#commits) { # Out of range when looking for the new revision $ret = undef; } else { $ret = $commits[$pos2]{'cmt_rev'}; } } # Now return to the directory where we started chdir($startdir); # return the information return $ret; } =item @files = get_modified_files_from_worktree() Returns a list of modified files in the current worktree. =cut sub get_modified_files_from_worktree { my $self = shift; my (@files) = qx(git ls-files -m); chomp @files; return @files; } =item @files = get_modified_files_from_revision($revid) Returns a list of modified files in $revid. =cut sub get_modified_files_from_revision { my ($self, $rev) = @_; my (@files) = qx(git diff-tree --no-commit-id --name-only --diff-filter=M -r $rev); chomp @files; return @files; } =item get_topdir Return the top dir of the webwml repository The first argument is a name of a checked-out file or directory. If it is not specified, by default the current directory is used. Example use: my $dir = get_topdir( 'foo.c' ); =cut sub get_topdir { my $self = shift; my $file = shift || '.'; # Are we in topdir? Easy! if (-d ".git" and -d "english") { return "."; } # Otherwise, walk up the tree until we find a .git or hit the # root directory my $dir = ".."; my $root = stat("/"); while (1 == 1) { $self->_debug( "Looking at $dir"); if (-d "$dir/.git" and -d "$dir/english") { return "$dir"; } my $sb = stat("$dir"); $self->_debug( "Comparing ($sb->dev, $sb->ino) to ($root->dev, $root->ino)"); if ($root->dev == $sb->dev and $root->ino == $sb->ino) { croak ("Unable to find the top-level webwml directory"); } $dir = "../$dir"; } } =back =head1 AUTHOR Copyright (C) 2018 Steve McIntyre <93sam@debian.org> This program is free software; you can redistribute it and/or modify it under the terms of version 2 of the GNU General Public License as published by the Free Software Foundation. =cut 42; __END__