diff options
| author | Steve McIntyre <93sam> | 2018-05-30 02:26:19 +0000 |
|---|---|---|
| committer | Steve McIntyre <93sam> | 2018-05-30 02:26:19 +0000 |
| commit | afdb29732ca24242f1a2e94f98e90034f9925f46 (patch) | |
| tree | e7fd6434eca8cdc6b4d1f8b917290cc45af5b374 | |
| parent | 85831e64ab93ed694a25e2e6ccaaff73d9fddeea (diff) | |
Major updates to perl scripts
Add new git backend in VCS_git.pm
Switch from an old-style set of function calls to an OO API. This
allows for initialisation and some state to be kept in the VCS_git.pm
module - namely a per-file cache of commit hashes for a massive
performance boost when doing lots of lookups.
Extend the API with 2 new utility functions:
* get_oldest_revision()
* next_revision()
Extended the vcs_cmp_rev() function to take a filename too.
Add a test harness to validate the git and cvs backends.
Add switch_to_git_translations.pl to walk the tree and switch from cvs
revisions to git commit hashes in translation-check headers.
Change all of our local scripts to use the new Local::VCS frontend
*where it makes sense*. Some scripts will behave slightly differently,
as the new world can't exactly match the old behaviour.
CVS version numbers
check_desc_trans.pl: 1.9 -> 1.10
check_trans.pl: 1.93 -> 1.94
copypage.pl: 1.42 -> 1.43
karma.pl: 1.6 -> 1.7
remove_stale.pl: 1.22 -> 1.23
smart_change.pl: 1.8 -> 1.9
stattrans.pl: 1.127 -> 1.128
switch_to_git_translations.pl: INITIAL -> 1.1
touch_translations.pl: 1.9 -> 1.10
vcs-test.pl: INITIAL -> 1.1
Perl/Local/Util.pm: 1.4 -> 1.5
Perl/Local/VCS.pm: 1.3 -> 1.4
Perl/Local/VCS_CVS.pm: 1.13 -> 1.14
Perl/Local/VCS_git.pm: 1.12 -> 1.13
Perl/Webwml/Langs.pm: 1.5 -> 1.6
Perl/Webwml/TransIgnore.pm: 1.3 -> 1.4
| -rw-r--r-- | Perl/Local/Util.pm | 3 | ||||
| -rw-r--r-- | Perl/Local/VCS.pm | 15 | ||||
| -rw-r--r-- | Perl/Local/VCS_CVS.pm | 439 | ||||
| -rw-r--r-- | Perl/Local/VCS_git.pm | 780 | ||||
| -rw-r--r-- | Perl/Webwml/Langs.pm | 7 | ||||
| -rw-r--r-- | Perl/Webwml/TransIgnore.pm | 5 | ||||
| -rwxr-xr-x | check_desc_trans.pl | 13 | ||||
| -rwxr-xr-x | check_trans.pl | 39 | ||||
| -rwxr-xr-x | copypage.pl | 86 | ||||
| -rwxr-xr-x | karma.pl | 12 | ||||
| -rwxr-xr-x | remove_stale.pl | 8 | ||||
| -rwxr-xr-x | smart_change.pl | 49 | ||||
| -rwxr-xr-x | stattrans.pl | 222 | ||||
| -rwxr-xr-x | switch_to_git_translations.pl | 226 | ||||
| -rwxr-xr-x | touch_translations.pl | 28 | ||||
| -rwxr-xr-x | vcs-test.pl | 341 |
16 files changed, 1521 insertions, 752 deletions
diff --git a/Perl/Local/Util.pm b/Perl/Local/Util.pm index 8b11106e8d1..4277ef78964 100644 --- a/Perl/Local/Util.pm +++ b/Perl/Local/Util.pm @@ -29,8 +29,7 @@ use warnings; BEGIN { use base qw( Exporter ); - - our $VERSION = sprintf "%s", q$Revision$ =~ /([0-9.]+)/; + our $VERSION = "1.2.3"; our @EXPORT_OK = qw( uniq read_file ); our %EXPORT_TAGS = ( 'all' => [@EXPORT_OK] ); } diff --git a/Perl/Local/VCS.pm b/Perl/Local/VCS.pm index 59cd609bef1..802688525a4 100644 --- a/Perl/Local/VCS.pm +++ b/Perl/Local/VCS.pm @@ -39,4 +39,19 @@ sub import } } +sub new +{ + if ( -d 'CVS' ) + { + require Local::VCS_CVS; + return Local::VCS_CVS->new(@_); + } + # fall back to git + else + { + require Local::VCS_git; + return Local::VCS_git->new(@_); + } +} + 42; diff --git a/Perl/Local/VCS_CVS.pm b/Perl/Local/VCS_CVS.pm index ef93c482947..890f544c3a6 100644 --- a/Perl/Local/VCS_CVS.pm +++ b/Perl/Local/VCS_CVS.pm @@ -15,7 +15,8 @@ Local::VCS_CVS - generic wrapper around version control systems -- CVS version use Local::VCS_CVS; use Data::Dumper; - my %info = vcs_path_info( '.', recursive => 1, verbose => 1 ); + my $VCS = Local::VCS->new(); + my %info = $VCS->path_info( '.', recursive => 1, verbose => 1 ); print Dumper($info{'foo.wml'}); my %info2 = svn_file_info( 'foo.wml' ); @@ -52,18 +53,50 @@ use warnings; BEGIN { use base qw( Exporter ); - our $VERSION = sprintf "%s", q$Revision$ =~ /([0-9.]+)/; + our $VERSION = "1.14"; our @EXPORT_OK = qw( - &vcs_cmp_rev &vcs_count_changes - &vcs_get_topdir - &vcs_path_info &vcs_file_info - &vcs_get_log &vcs_get_diff - &vcs_get_file + &new ); our %EXPORT_TAGS = ( 'all' => [@EXPORT_OK] ); } +=item new + +This is the constructor. + + my $VCS = Local::VCS->new(); + +=cut + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = { + CACHE => {}, + }; + bless ($self, $class); + return $self; +} + +sub cache_file { + my $self = shift; + my $file = shift; + + if ($self->{CACHE}{"$file"}) { + print "$file is already cached...\n"; + return; + } + print "Adding $file to cache\n"; + $self->{CACHE}{"$file"} = 1; + return; +} + +sub cache_repo { + my $self = shift; + # Does nothing here... +} + # handling debugging my $DEBUG = 0; sub _debug @@ -78,17 +111,19 @@ sub _debug sub _typeoffile; -=item vcs_cmp_rev +=item cmp_rev -Compare two revision strings. +Compare two revision strings for a given file -Takes two revision strings as arguments, and -returns 1 if the first one is largest, --1 if the second one is largest, +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 vcs_cmp_rev +sub cmp_rev { + my $self = shift; + my $file = shift || ""; # unused here my $a = shift || '0'; my $b = shift || '0'; @@ -117,7 +152,7 @@ sub vcs_cmp_rev croak "Internal error: this should never be executed"; } -=item vcs_count_changes +=item count_changes Return the number of changes to particular file between two revisions @@ -131,8 +166,9 @@ Example use: =cut -sub vcs_count_changes +sub count_changes { + my $self = shift; my $file = shift or return undef; my $rev1 = shift || '1.1'; my $rev2 = shift || 'HEAD'; @@ -142,7 +178,7 @@ sub vcs_count_changes # find the version number of HEAD, if it was specified if ( $rev2 eq 'HEAD' ) { - my %info = vcs_file_info( $file ); + my %info = $self->file_info( $file ); return -1 if not %info; $rev2 = $info{'cmt_rev'}; } @@ -167,7 +203,7 @@ sub vcs_count_changes } -=item vcs_path_info +=item path_info Return CVS information and status about a tree of files. @@ -190,7 +226,7 @@ Optional remaining arguments are a hash array with options: Example uses: - my %info1 = $vcs_path_info( 'src' ); + my %info1 = $path_info( 'src' ); my %info2 = $readinfo( 'src', recursive => 1 ); my %info3 = $readinfo( 'src', recursive => 1, match_pat => '\.c$' ); @@ -198,8 +234,9 @@ Example uses: # todo: verbose -sub vcs_path_info +sub path_info { + my $self = shift; my ($dir,%options) = @_; croak("No file or directory specified") unless $dir; @@ -245,7 +282,7 @@ sub vcs_path_info return %data; } -=item vcs_file_info +=item file_info Return VCS information and status about a single file @@ -260,12 +297,13 @@ the specified file: Example use: - my %info = $vcs_file_info( 'foo.wml' ); + my %info = $file_info( 'foo.wml' ); =cut -sub vcs_file_info +sub file_info { + my $self = shift; my $file = shift or carp("No file specified"); my %options = @_; @@ -274,7 +312,7 @@ sub vcs_file_info my ($basename,$dirname) = fileparse( rel2abs $file ); # note: for some weird reason, the file is returned as '.' - my %info = vcs_path_info( $dirname, 'recursive' => 0 ); + my %info = $self->path_info( $dirname, 'recursive' => 0 ); if ( not ( exists $info{$basename} and $info{$basename} ) ) { @@ -285,7 +323,7 @@ sub vcs_file_info return %{ $info{$basename} }; } -=item vcs_get_log +=item get_log Return the log info about a specified file @@ -295,12 +333,13 @@ of the log entries Example use: - my @log_entries = vcs_get_log( 'foo.wml' ); + my @log_entries = get_log( 'foo.wml' ); =cut -sub vcs_get_log +sub get_log { + my $self = shift; my $file = shift or return; my $rev1 = shift || '0'; my $rev2 = shift || ''; @@ -353,7 +392,7 @@ sub vcs_get_log return reverse @logdata; } -=item vcs_get_diff +=item get_diff Returns a hash of (filename,diff) pairs containing the unified diff between two version of a (number of) files. @@ -365,14 +404,15 @@ modified) version is diffed against the latest checked in version. Example use: - my %diffs = vcs_get_diff( 'foo.wml', '1.4', '1.17' ); - my %diffs = vcs_get_diff( 'bla.wml', '1.8' ); - my %diffs = vcs_get_diff( 'bas.wml' ); + 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 vcs_get_diff +sub get_diff { + my $self = shift; my $file = shift or return; my $rev1 = shift; my $rev2 = shift; @@ -388,6 +428,7 @@ sub vcs_get_diff # set the record separator for cvs diff output local $/ = "\n" . ('=' x 67) . "\n"; +# print "$command\n"; open( my $cvs, '-|', $command ) or croak("Couldn't run `$command': $!"); @@ -401,17 +442,17 @@ sub vcs_get_diff $record =~ s{ $/ \n? \Z }{}msx; # remove the "Index:" line from the end of the record - $record =~ s{ ^Index: [^\n]+ \n+ \Z }{}msx; +# $record =~ s{ ^Index: [^\n]+ \n+ \Z }{}msx; - # remove the first four lines - $record =~ s{ \A (?: .*? \n ){4} }{}msx; + # remove the first three lines + $record =~ s{ \A (?: .*? \n ){3} }{}msx; - # get the file name - if ( not $record =~ m{ \A --- \s+ ([^\t]+) \t }msx ) - { - croak("Parse error in output of `$command'"); - } - my $file = $1; +# # get the file name +# if ( not $record =~ m{ \A --- \s+ ([^\t]+) \t }msx ) +# { +# croak("Parse error in output of `$command'"); +# } +# my $file = $1; $data{$file} = $record; } @@ -433,7 +474,7 @@ sub _get_repository return $repo; } -=item vcs_get_file +=item get_file Return a particular revision of a file @@ -445,12 +486,13 @@ and returns it (without writing anything in the current checked-out tree) Example use: - my $text = vcs_get_file( 'foo.c', '1.12' ); + my $text = get_file( 'foo.c', '1.12' ); =cut -sub vcs_get_file +sub get_file { + my $self = shift; my $file = shift or croak("No file specified"); my $rev = shift or croak("No revision specified"); @@ -478,7 +520,67 @@ sub vcs_get_file return $text; } -=item vcs_get_topdir +=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"); + + croak( "No such file: $file" ) unless -f $file; + + return '1.1'; # earliest possible revision of any file, easy! +} + +=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. + # + # FIXME: Only deals with simple moves backwards/forwards along the trunk + + my $self = shift; + my $file = shift or return undef; + my $rev1 = shift or return undef; + my $move = shift or return undef; + + my $newrev = $rev1; + $newrev =~ s/(\d+)$/($1 + $move)/e; + return $newrev; +} + +=item get_topdir Return the top dir of the webwml repository @@ -487,12 +589,13 @@ If it is not specified, by default the current directory is used. Example use: - my $dir = vcs_get_topdir( 'foo.c' ); + my $dir = get_topdir( 'foo.c' ); =cut -sub vcs_get_topdir +sub get_topdir { + my $self = shift; my $file = shift || '.'; my $cvs = Local::Cvsinfo->new(); @@ -552,247 +655,3 @@ Free Software Foundation. # ignore for now, I will get rid of it as the rewrite progresses # -- Bas. __END__ - - - -=item svn_diff - -Return diff for the specified file - -The first argument is a name of a file. -The second argument is the revision against which to take the diff (use undef for HEAD) -If a thrird argument is present, it signifies that hte use want a diff between -the version specified in the second agument and the one in the third argument - -Example use: - - # get diff of local changes against head - my $diff1 = $svn_diff( 'foo.c' ); - # get diff of local changes against revision 12 - my $diff2 = $svn_diff( 'foo.c', 'r12' ); - # get diff between version 11 and 12 of the file - my $diff1 = $svn_diff( 'foo.c', 'r11', 'r12' ); - -=cut - -sub svn_diff -{ - my $file = shift or carp("No file specified"); - my $rev1 = shift or carp("No orig revision specified"); - my $rev2 = shift or carp("No target revision specified"); - - carp( "No such file: $file" ) unless -e $file; - - # intitalize SVN client - my $ctx = SVN::Client->new(); - - # create twoo filehandles for output and error streams - - # TODO: this doesn't work (bug in SVN::Client?) - my ($out,$err); - #open ( my $fd_out, '>', \$out ) or croak("Couldn't open \\\$out"); - #open ( my $fd_err, '>', \$err ) or croak("Couldn't open \\\$err"); - - open ( my $fd_out, '+>', undef ) or croak("Couldn't open anonymous output"); - open ( my $fd_err, '+>', undef ) or croak("Couldn't open anonymous error"); - - $ctx->diff( - [], # options to diff (-u is default) - $file, $rev1, # first file - $file, $rev2, # second file - 1, # recursiveness - 1, # don't bother with ancestors - 0, # do diff deleted files - $fd_out, # output file - $fd_err, # error output file - ); - - # read the stuff from the files - seek( $fd_out, 0, SEEK_SET ); - seek( $fd_err, 0, SEEK_SET ); - { - local $/; - $out = <$fd_out>; - $err = <$fd_err>; - } - - # done with the files - close( $fd_out ); - close( $fd_err ); - - # croak on error - croak( $err ) if $err; - - # return the diff - return $out; -} - - -=item svn_log - -Return the log entries of a particular file - -The first argument is a name of a file. -The (optional) second and third argument specify the revision range - -This function retrieves the log entry/entries of the specified revision(s) for -the specified file. If only a file name is given, the entire history is -returned; if only 1 revision is specified, the log entrie of that particular -revision is returned; if two revisions are specified, all log entries in -between are returned. - -Example use: - - my @log = svn_log( 'foo.c' ); - my @log = svn_log( 'foo.c', 'r42' ); - my @log = svn_log( 'foo.c', 'r42', 'r112' ); - my @log = svn_log( 'foo.c', 'r42', 'HEAD' ); - -=cut - -my @_log_collection; - -sub _log_receiver -{ - my $paths = shift; # NOTE: not used - my $rev = shift; - my $author = shift; - my $date = str2time( shift ); - my $msg = shift; - - push @_log_collection, { - 'rev' => $rev, - 'author' => $author, - 'date' => $date, - 'message' => $msg, - }; - -} - -sub svn_log -{ - my $file = shift or carp("No file specified"); - my $rev1 = shift || '0'; - my $rev2 = shift || 'HEAD'; - - carp( "No such file: $file" ) unless -e $file; - - # clear log - @_log_collection = (); - - # intitialize SVN client - my $ctx = SVN::Client->new(); - - eval { - $ctx->log( - $file, - $rev1, - $rev2, - 0, # determine which files were changed on each revision? - 0, # don't traverse history of copies? - \&_log_receiver - ); - }; - carp($@) if $@; - - - # return a copy of the logs - return @_log_collection; -} - -=item svn_get_info - -Return info about the (local) Subversion repository - -The first argument is a name of a checked-out file or directory. - -Example use: - - my %info = svn_info( 'foo.c' ); - -=cut - -my %_info_data; - -sub _info_receiver -{ - my( $path, $info, $pool ) = @_; - - # return if the info is already known - return if %_info_data; - - %_info_data = ( - 'url' => $info->URL(), - 'rev' => $info->rev(), - 'kind' => $info->kind(), - 'root' => $info->repos_root_URL(), - 'uuid' => $info->repos_UUID(), - 'last_changed_rev' => $info->last_changed_rev(), - 'last_changed_date' => $info->last_changed_date(), - 'last_changed_author' => $info->last_changed_author(), - ); -}; - -sub svn_get_info -{ - my $file = shift or carp("No file specified"); - - $file = rel2abs( $file ); - - # intitialize SVN client - my $ctx = SVN::Client->new(); - - # reset the info hash - %_info_data = (); - - eval { - $ctx->info( - $file, - undef, # no revision info, so... - undef, # ...only use local info - \&_info_receiver, - 0, # no, don't recurse - ); - }; - carp($@) if $@; - - return %_info_data; -} - - -=item svn_get_depth - -Find how deep we are inside the repository - -The first argument is a name of a checked-out file or directory. - -Example use: - - my $depth = svn_get_topdir( 'foo.c' ); - -=cut - -sub svn_get_depth -{ - my $file = shift or carp("No file specified"); - - - my %info = svn_get_info( $file ); - my $top = $info{'url'}; - my $root = $info{'root'}; - - # if $file really is a file (not a dir), only look at the directory part of - # the filename - $top = dirname( $top ) if $info{'kind'} == 1; - - # remove the root from the start of url to get a top dir - $top =~ s{^\Q$root\E}{}; - $top =~ s{/+}{/}; - - # count the number of elements in the path - my $num = scalar splitdir( $top ); - - # minus 1, because $top starts with a '/', and thus splitdir adds an empty - # field at the beginning - return $num - 1; -} diff --git a/Perl/Local/VCS_git.pm b/Perl/Local/VCS_git.pm index cfa5affef03..410bf81c785 100644 --- a/Perl/Local/VCS_git.pm +++ b/Perl/Local/VCS_git.pm @@ -1,10 +1,10 @@ #!/usr/bin/perl -## Copyright (C) 2008 Bas Zoetekouw <bas@debian.org> +## 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. +## 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 @@ -15,7 +15,8 @@ Local::VCS_git - generic wrapper around version control systems -- git version use Local::VCS_git; use Data::Dumper; - my %info = vcs_path_info( '.', recursive => 1, verbose => 1 ); + my $VCS = Local::VCS->new(); + my %info = $VCS->path_info( '.', recursive => 1, verbose => 1 ); print Dumper($info{'foo.wml'}); =head1 DESCRIPTION @@ -33,8 +34,8 @@ package Local::VCS_git; use 5.008; -use Local::Gitinfo; use File::Basename; +use File::Find; use File::Spec::Functions qw( rel2abs splitdir catfile rootdir catdir ); use File::stat; use Carp; @@ -42,6 +43,10 @@ use Fcntl qw/ SEEK_SET /; use Data::Dumper; use Date::Parse; use POSIX qw/ WIFEXITED /; +use List::MoreUtils 'first_index'; +use Cwd qw(cwd); +use Time::HiRes qw/gettimeofday/; +use Data::Dumper; use strict; use warnings; @@ -49,75 +54,226 @@ use warnings; BEGIN { use base qw( Exporter ); - our $VERSION = sprintf "%s", q$Revision$ =~ /([0-9.]+)/; + our $VERSION = "1.13"; our @EXPORT_OK = qw( - &vcs_cmp_rev &vcs_count_changes - &vcs_get_topdir - &vcs_path_info &vcs_file_info - &vcs_get_log &vcs_get_diff - &vcs_get_file + &new ); our %EXPORT_TAGS = ( 'all' => [@EXPORT_OK] ); } +=item new + +This is the constructor. + + my $VCS = Local::VCS->new(); + +=cut + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = { + CACHE => {}, + REPO_CACHED => 0, + }; + bless ($self, $class); + return $self; +} # handling debugging my $DEBUG = 0; + +sub _get_time() +{ + my @tm; + my $text; + my ($seconds, $microseconds) = gettimeofday; + + @tm = gmtime(); + $text = sprintf("%4d-%02d-%02d %02d:%02d:%02d.%6d UTC", + (1900 + $tm[5]),(1 + $tm[4]),$tm[3],$tm[2],$tm[1],$tm[0], $microseconds); + return $text; +} + sub _debug { my @text = @_; return unless $DEBUG; - print STDERR "=> ", @text, "\n"; + my $timestamp = _get_time(); + print STDERR "=> ", $timestamp, " ", @text, "\n"; + return; +} + +sub _add_cache_entry { + my $self = shift; + my $file = shift; + my %entry; + $entry{'cmt_date'} = shift; + $entry{'cmt_rev'} = shift; + my $tmp; + my @list; + 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; + + _debug "cache_file($file)"; + if ($self->{CACHE}{"$file"}) { +# print "$file is already cached...\n"; + _debug "cache_file($file) returning early"; return; + } +# print "Adding $file to cache\n"; + my (@commits); + open (GITLOG, "git log -p -m --first-parent --name-only --numstat --format=format:\"%H %ct\" -- $file |") or die "Can't fork git log: $!\n"; + my ($cmt_date, $cmt_rev); + while (my $line = <GITLOG>) { + 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; + _debug "cache_file($file) done"; + return; } -# return the type of the specified file -sub _typeoffile; +sub cache_repo { + my $self = shift; + _debug "cache_repo()"; + # If we've already read the commit history into our cache, return + # immediately + if ($self->{REPO_CACHED}) { + _debug "cache_repo() returning early"; + return; + } + + # If not, clear the cache and rebuild from scratch. We might havs + # some files cached individually, and that would confuse things + # now. + $self->{CACHE} = {}; + + # Store the current directory so we can return there + my $start_dir = cwd; + my $topdir = $self->get_topdir(); + chdir ($topdir) or die "Can't chdir to $topdir: $!\n"; + + my (@commits); + my $count = 0; + open (GITLOG, "git log -p -m --first-parent --name-only --numstat --format=format:\"%H %ct\" |") or die "Can't fork git log: $!\n"; + my ($cmt_date, $cmt_rev); + while (my $line = <GITLOG>) { + 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; + chdir ($start_dir); + $self->{REPO_CACHED} = 1; +# print Dumper($self->{CACHE}); + my $tmp = $self->{CACHE}; + my $num_files = scalar(keys %$tmp); + _debug "cache_repo() done, $count file commits, $num_files files"; +} + +# Internal helper function - grab a list of all the commits to a given +# file +sub _grab_commits +{ + my $self = shift; + my $file = shift or return undef; + $self->cache_file($file); + my $tmp = $self->{CACHE}{"$file"}; + if (defined $tmp) { + my @commits = @$tmp; +# print Dumper(@commits); + return @commits; + } + return undef; +} -=item vcs_cmp_rev +=item cmp_rev -Compare two revision strings. +Compare two revision strings for a given file. -Takes two revision strings as arguments, and -returns 1 if the first one is largest, --1 if the second one is largest, +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 -FIXME: this needs to be "translated" into git and hashes - =cut -sub vcs_cmp_rev +sub cmp_rev { - my $a = shift || '0'; - my $b = shift || '0'; - - my @a = split( /\./, $a ); - my @b = split( /\./, $b ); - - # compare the two revision string term by term - my $i = 0; - while (1) - { - # first check if there are terms left in both revisions - if ( $i > $#a and $i>$#b ) { return 0 }; - if ( $i > $#a ) { return -1 }; - if ( $i > $#b ) { return 1 }; - - # then check this term - if ( $a[$i] < $b[$i] ) { return -1; } - if ( $a[$i] > $b[$i] ) { return 1; } - - # terms are equal, look at the next one - - $i++; + # 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 @commits = $self->_grab_commits($file); +# 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 "ERROR: commit $rev1 not found in revisions of $file\n"; + return undef; + } + if ($pos2 == -1) { + # Not found + print "ERROR: commit $rev2 not found in revisions of $file\n"; + return undef; + } + if ($pos1 == $pos2) { + return 0; + } elsif ($pos1 < $pos2) { + return 1; + } else { + return -1; } # should never be reached croak "Internal error: this should never be executed"; } -=item vcs_count_changes +=item count_changes Return the number of changes to particular file between two revisions @@ -126,48 +282,83 @@ The second and third argument specify the revision range Example use: - my $num1 = vcs_count_changes( 'foo.c', 'r42', 'r70' ); - my $num2 = vcs_count_changes( 'foo.c', 'r42', 'HEAD' ); + my $num1 = count_changes( 'foo.c', 'r42', 'r70' ); + my $num2 = count_changes( 'foo.c', 'r42', 'HEAD' ); -FIXME: converted into git and hashes, needs review and test - =cut -sub vcs_count_changes +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 + # but just in case + my $self = shift; my $file = shift or return undef; my $rev1 = shift || ''; - my $rev2 = shift || 'HEAD'; + my $rev2 = shift || ''; - $rev1 = '' if $rev1 eq 'n/a'; + if ($rev1 =~ m/^\Q$rev2\E$/) { # same revisions + return 0; + } - # for git, this is pretty easy: we simply compare the two version numbers - # note: we don't support branches (aren't used in the webwml repo anyway) + my @commits = $self->_grab_commits($file); - my $command = sprintf( 'git rev-list --count %s..%s %s', $rev1, $rev2, $file ); - - open ( my $git, '-|', $command ) - or croak("Error while executing `$command': $!"); - my $text; - while ( my $line = <$git> ) - { - $text .= $line; + # If unset, go for the last revision + if (length($rev2) == 0) { + $rev2 = $commits[$#commits]; } - close( $git ); - croak("Error while executing `$command': $!") unless WIFEXITED($?); - # return the number of changes (or error text) - - return $text; + 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 "ERROR: commit $rev1 not found in revisions of $file\n"; + return undef; + } + if ($pos2 == -1) { + # Not found + print "ERROR: commit $rev2 not found in revisions of $file\n"; + return undef; + } + return $pos2 - $pos1; } +# return the type of the input argument (file, dir, symlink, etc) +sub _typeoffile +{ + my $file = shift or return; -=item vcs_path_info + 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. @@ -190,20 +381,41 @@ Optional remaining arguments are a hash array with options: Example uses: - my %info1 = $vcs_path_info( 'src' ); - my %info2 = $readinfo( 'src', recursive => 1 ); - my %info3 = $readinfo( 'src', recursive => 1, match_pat => '\.c$' ); + 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 vcs_path_info +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! + + my $self = shift; my ($dir,%options) = @_; + my %files_wanted; croak("No file or directory specified") unless $dir; - _debug "Called with $dir"; + _debug "path_info ($dir)"; my $recurse = $options{recursive} || $options{recurse} || 0; my $match_pat = $options{match_pat} || undef; @@ -213,39 +425,74 @@ sub vcs_path_info _debug "Match pattern is '$match_pat'" if defined $match_pat; _debug "Skip pattern is '$skip_pat'" if defined $skip_pat; - # $git->readinfo expects a matchfile input; if nothing is specified, we - # pass a pattern that matches everything - $match_pat ||= '.'; - - $dir = rel2abs( $dir ); - - # use Local::Gitinfo to do the actual work in git - my $git = Local::Gitinfo->new(); - $git->readinfo( $dir, recursive => $recurse, matchfile => [$match_pat] ); - my $files = $git->files; - - # construct a nice hash from the data we received from Gitinfo - my %data; - for my $file (keys %{$git->{FILES}}) - { - # we return relative paths, so strip off the dir name - my $file_rel = $file; - $file_rel =~ s{^$dir/?}{}; - - # skip files that match the skip pattern - next if $skip_pat and $file_rel =~ m{$skip_pat}; - - $data{$file_rel} = { - 'cmt_rev' => $git->{FILES}->{$file}->{'REV'}, - 'cmt_date' => str2time( $git->{FILES}->{$file}->{'DATE'} ), - 'type' => _typeoffile $file, - }; + 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 ); } - return %data; + # 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 { + _debug "Ignoring file $file"; + } + } + } else { + # We don't, so we need to talk to git. (2a above) + open (GITLOG, "git log -p -m --first-parent --name-only --numstat --format=format:\"%H %ct\" $dir|") + or die "Failed to fork git log: $!\n"; + my $cmt_date; + my $cmt_rev; + my $file; + while (my $line = <GITLOG>) { + 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; + } + _debug "path_info ($dir) returning"; + return %pathinfo; } -=item vcs_file_info +=item file_info Return VCS information and status about a single file @@ -260,32 +507,30 @@ the specified file: Example use: - my %info = $vcs_file_info( 'foo.wml' ); + my %info = $VCS->file_info( 'foo.wml' ); =cut -sub vcs_file_info +sub file_info { + my $self = shift; my $file = shift or carp("No file specified"); my %options = @_; - my $quiet = $options{quiet} || undef; - - my ($basename,$dirname) = fileparse( rel2abs $file ); - - # note: for some weird reason, the file is returned as '.' - my %info = vcs_path_info( $dirname, 'recursive' => 0 ); - - if ( not ( exists $info{$basename} and $info{$basename} ) ) - { - carp("No info found about `$file' (does the file exist?)") if ( ! $quiet ); - return; + my %pathinfo; + my @commits = $self->_grab_commits($file); + 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'}; } - return %{ $info{$basename} }; + return %pathinfo; } -=item vcs_get_log +=item get_log Return the log info about a specified file @@ -295,66 +540,91 @@ of the log entries Example use: - my @log_entries = vcs_get_log( 'foo.wml' ); + my @log_entries = get_log( 'foo.wml' ); -FIXME: converted into git and hashes, needs review and test - =cut -sub vcs_get_log +sub get_log { + my $self = shift; my $file = shift or return; my $rev1 = shift || ''; my $rev2 = shift || ''; - my @logdata; + my $command; + if ($rev1 eq '' and $rev2 eq '') { + $command = sprintf( 'git log --date=unix %s', $file ); + } elsif ($rev2 eq '') { + $command = sprintf( 'git log --date=unix %s^..%s %s', $rev1, $rev1, $file ); + } elsif ($rev1 eq '') { + $command = sprintf( 'git log --date=unix ..%s %s', $rev2, $file ); + } else { + $command = sprintf( 'git log --date=unix %s..%s %s', $rev1, $rev2, $file ); + } + + _debug "get_log: running $command"; - # set the record separator for git log output - local $/ = "\n----------------------------\n"; - - my $command = sprintf( 'git log %s..%s %s', $rev1, $rev2, $file ); open( my $git, '-|', $command ) or croak("Couldn't run `$command': $!"); - # read the consequetive records - while ( my $record = <$git> ) + my $revision; + my $author; + my $date; + my $message; + my $first_record_done = 0; + + # read and parse the log records + while ( my $line = <$git> ) { - #print "==> $record\n"; - - # the first 3 lines of a record contain metadata that looks like this: - # commit abcdefg435768938de - # Author: Jane Doe <email@example.com> - # Date: Tue Nov 7 11:47:24 2017 +0100 - - # first split off the record - my ($metadata1,$metadata2,$metadata3,$logmessage) = split( /\n/, $record, 4 ); - - my ($revision) = $metadata1 =~ m{^commit (.+)}; - my ($author) = $metadata2 =~ m{^Author: (.+)}; - my ($date) = $metadata3 =~ m{^Date: (.+)}; - - croak( "Couldn't parse output of `$command'" ) - unless $revision and $date and $author; - - # convert date to unixtime - $date = str2time( $date ); - - # last line of the log message is still the record separator - $logmessage =~ s{\n[^\n]+\n$}{}ms; - - push @logdata, { + # the first 3 lines of a record contain metadata that looks like this: + # commit abcdefg435768938de + # Author: Jane Doe <email@example.com> + # Date: 1504881409 + + if ($line =~ m{^commit (.+)}) { + # Second and subsequent record, push a result + if ($first_record_done) { + _debug "pushing a record (rev $revision)"; + push @logdata, { 'rev' => $revision, - 'author' => $author, - 'date' => $date, - 'message' => $logmessage, - }; + '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 ); - return reverse @logdata; + if ($first_record_done) { + # _debug "pushing last record (rev $revision)"; + # Last record, push a result + push @logdata, { + 'rev' => $revision, + 'author' => $author, + 'date' => $date, + 'message' => $message, + }; + return reverse @logdata; + } + return undef; } -=item vcs_get_diff +=item get_diff Returns a hash of (filename,diff) pairs containing the unified diff between two version of a (number of) files. @@ -366,17 +636,16 @@ modified) version is diffed against the latest checked in version. Example use: - my %diffs = vcs_get_diff( 'foo.wml', '1.4', '1.17' ); - my %diffs = vcs_get_diff( 'bla.wml', '1.8' ); - my %diffs = vcs_get_diff( 'bas.wml' ); + my %diffs = get_diff( 'foo.wml', '1.4', '1.17' ); + my %diffs = get_diff( 'bla.wml', '1.8' ); + my %diffs = get_diff( 'bas.wml' ); -FIXME: converted using git log format, probably does not work. Needs review and test - =cut -sub vcs_get_diff +sub get_diff { + my $self = shift; my $file = shift or return; my $rev1 = shift; my $rev2 = shift; @@ -389,36 +658,25 @@ sub vcs_get_diff defined $rev2 ? "$rev2" : '', $file ); - # set the record separator for git diff output - # not sure if the below expression is correct - local $/ = "\n" . 'diff --git' . (.+) . "\n"; +# print "$command\n"; open( my $git, '-|', $command ) or croak("Couldn't run `$command': $!"); - # the first "record" is bogus - <$git>; - # read the consecutive records while ( my $record = <$git> ) { # remove the record separator from the end of the record - $record =~ s{ $/ \n? \Z }{}msx; +# $record =~ s{ $/ \n? \Z }{}msx; # remove the "index" line from the beginning of the record - $record =~ s{ ^index [^\n] }{}msx; +# $record =~ s{ ^index [^\n] }{}msx; # remove the first 2 lines - $record =~ s{ \A (?: .*? \n ){2} }{}msx; + $record =~ s{^diff\s+--git.*}{}msx; + $record =~ s{^index\s+.*}{}msx; - # get the file name - if ( not $record =~ m{ \A --- \s+ ([^\t]+) \t }msx ) - { - croak("Parse error in output of `$command'"); - } - my $file = $1; - - $data{$file} = $record; + $data{$file} .= $record; } close( $git ); @@ -426,7 +684,7 @@ sub vcs_get_diff } -=item vcs_get_file +=item get_file Return a particular revision of a file @@ -438,14 +696,13 @@ and returns it (without writing anything in the current checked-out tree) Example use: - my $text = vcs_get_file( 'foo.c', '1.12' ); - -FIXME: converted to use git show <commit>:<pathname>. Assumes we provide in $file the complete path. Needs review and test + my $text = get_file( 'foo.c', '1.12' ); =cut -sub vcs_get_file +sub get_file { + my $self = shift; my $file = shift or croak("No file specified"); my $rev = shift or croak("No revision specified"); @@ -456,8 +713,8 @@ sub vcs_get_file $rev, $file ); my $text; - open ( my $git, '-|', $command1 ) - or croak("Error while executing `$command1': $!"); + open ( my $git, '-|', $command ) + or croak("Error while executing `$command': $!"); while ( my $line = <$git> ) { $text .= $line; @@ -469,70 +726,147 @@ sub vcs_get_file return $text; } -=item vcs_get_topdir +=item get_oldest_revision -Return the top dir of the webwml repository +Return the version of the oldest version of a file -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. +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 $dir = vcs_get_topdir( 'foo.c' ); + my $rev = get_oldest_revision( 'foo.c'); =cut -sub vcs_get_topdir +sub get_oldest_revision { - my $file = shift || '.'; - - my $git = Local::Gitinfo->new(); - $git->readinfo( $file ); - my $root = $git->topdir() - or croak ("Unable to determine top-level directory"); + my $self = shift; + my $file = shift or croak("No file specified"); - # TODO: add some check that this really is the top level dir + croak( "No such file: $file" ) unless -f $file; - return $root; + my @commits = $self->_grab_commits($file); + if (@commits) { + # Simply return the last revision in our list + return $commits[$#commits]{'cmt_rev'}; + } + # Should hopefully never get here! + croak(" Could not find any revisions for $file"); } +=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: -###################################### -## internal functions -###################################### + my $rev = next_revision( 'foo.c', '72f6700577c79e6d284fbeac44366f6aa357d56d', -1); +Returns the requested revision if it exists, otherwise *undef* -# return the type of the input argument (file, dir, symlink, etc) -sub _typeoffile +=cut +sub next_revision { - my $file = shift or return; + # 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 @commits = $self->_grab_commits($file); +# 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++; + } - stat $file or croak("Couldn't stat file `$file'"); + if ($pos1 == -1) { + # Can't find the specified revision + return undef; + } - 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 _ ); + # API specifies -ve as older, but out list is sorted the other + # way... + $pos2 = $pos1 - $move; - return ''; + if ($pos2 < 0 or $pos2 >= $#commits) { + # Out of range when looking for the new revision + return undef; + } + + return $commits[$pos2]{'cmt_rev'}; } +=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") { + return "."; + } + + # Otherwise, walk up the tree until we find a .git or hit the + # root directory + my $dir = ".."; + my ($root_dev, $root_ino) = stat("/"); + + while (1 == 1) { + if (-d "$dir/.git") { + return "$dir"; + } + my ($dev, $ino) = stat("$dir"); + if ($root_dev == $dev and $root_ino == $ino) { + croak ("Unable to determine top-level directory"); + } + $dir = "../$dir"; + } +} =back =head1 AUTHOR -Copyright (C) 2008 Bas Zoetekouw <bas@debian.org> +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 version2 of the GNU General Public License as published by the -Free Software Foundation. +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 diff --git a/Perl/Webwml/Langs.pm b/Perl/Webwml/Langs.pm index 4df3ecb6631..16857146ff2 100644 --- a/Perl/Webwml/Langs.pm +++ b/Perl/Webwml/Langs.pm @@ -34,7 +34,7 @@ the list of languages in which Debian web site is translated. package Webwml::Langs; use Carp; -use Local::VCS 'vcs_get_topdir'; +use Local::VCS; use strict; use warnings; @@ -52,13 +52,14 @@ determined from VCS meta-info. sub new { my $proto = shift; my $class = ref($proto) || $proto; + my $VCS = Local::VCS->new(); my $root; if (@_) { $root = shift; } else { - $root = vcs_get_topdir; + $root = $VCS->get_topdir(); } my $self = _read($root); bless ($self, $class); @@ -72,7 +73,7 @@ sub new { # TODO: or rather define the lnaguages in a module, and include those in # languages.wml sub _read { - my $root = shift || vcs_get_topdir; + my $root = shift || Local::VCS->get_topdir(); open( my $file, '<', "$root/english/template/debian/languages.wml") or croak ("Unable to read $root/english/template/debian/languages.wml"); diff --git a/Perl/Webwml/TransIgnore.pm b/Perl/Webwml/TransIgnore.pm index d3f6b7e9234..a06f987ff87 100644 --- a/Perl/Webwml/TransIgnore.pm +++ b/Perl/Webwml/TransIgnore.pm @@ -33,7 +33,7 @@ package Webwml::TransIgnore; use Carp; use File::Spec::Functions; -use Local::VCS qw{ vcs_get_topdir }; +use Local::VCS; use strict; use warnings; @@ -64,7 +64,8 @@ sub new bless ($self, $class); # determine the root dir - my $root = shift || vcs_get_topdir('.'); + my $VCS = Local::VCS->new(); + my $root = shift || $VCS->get_topdir('.'); # Read global .transignore file $self->_read($root); diff --git a/check_desc_trans.pl b/check_desc_trans.pl index 4311458ec64..0215caf08fa 100755 --- a/check_desc_trans.pl +++ b/check_desc_trans.pl @@ -90,15 +90,17 @@ my $directory = catdir( 'MailingLists' , 'desc' ); my $srcdir = catdir( 'english', $directory ); my $destdir = catdir( $language, $directory ); -# read svn info about files in source dir -my %revision_info = vcs_path_info( $srcdir, 'recursive' => 1 ); +my $VCS = Local::VCS->new(); + +# read VCS info about files in source dir +my %revision_info = $VCS->path_info( $srcdir, 'recursive' => 1 ); # read the translation-check files in dest dir my %transcheck = read_transcheck( $destdir ); # check all files my ($nr_uptodate,$nr_old,$nr_needtrans,$nr_obsolete,$nr_error) = - check_all( $language, $directory, \%transcheck, \%revision_info ); + check_all( $VCS, $language, $directory, \%transcheck, \%revision_info ); # print results print "\nResults:\n"; @@ -160,6 +162,7 @@ sub read_transcheck # check all translations sub check_all { + my $VCS = shift; my $lang = shift or die("No language specified"); my $dir = shift or die("No directory specified"); my $files = shift or die("No transcheck files specified"); @@ -202,7 +205,7 @@ sub check_all if ( -e $file_english and -e $file_transl ) { # needs update - if ( vcs_cmp_rev( $files->{$file}, $revinfo->{$file}->{'cmt_rev'} ) == -1 ) + if ( $VCS->cmp_rev( $file_english, $files->{$file}, $revinfo->{$file}->{'cmt_rev'} ) == -1 ) { $nr_old++; print color('blue'), $file_transl, color('reset'); @@ -210,7 +213,7 @@ sub check_all $files->{$file}, $revinfo->{$file}->{'cmt_rev'}; } # translated file is too new - elsif ( vcs_cmp_rev( $files->{$file}, $revinfo->{$file}->{'cmt_rev'} ) == -1 ) + elsif ( $VCS->cmp_rev( $file_english, $files->{$file}, $revinfo->{$file}->{'cmt_rev'} ) == -1 ) { $nr_error++; print color('blue'), $file_transl, color('reset'); diff --git a/check_trans.pl b/check_trans.pl index a4e14e52d33..3a3980e7e9c 100755 --- a/check_trans.pl +++ b/check_trans.pl @@ -175,17 +175,19 @@ sub verbose; # -s allows the user to restrict processing to a subtree my $subdir = $OPT{'s'} || undef; + my $VCS = Local::VCS->new(); + # Global .transignore - my $transignore = Webwml::TransIgnore->new( vcs_get_topdir ); + my $transignore = Webwml::TransIgnore->new($VCS->get_topdir()); # first get a list with revision information from all files in english... - my %english_revs = vcs_path_info( $english_path, + my %english_revs = $VCS->path_info( $english_path, 'recursive' => 1, 'match_pat' => $file_pattern, 'skip_pat' => '^template/' ); # ... and in the translation - my %translation_revs = vcs_path_info( $language_path, + my %translation_revs = $VCS->path_info( $language_path, 'recursive' => 1, 'match_pat' => $file_pattern, 'skip_pat' => '^template/' @@ -234,7 +236,7 @@ sub verbose; $file_orig = catfile( $original_lang, $file ); # and find the correct revision info for this file - $revinfo_orig = { vcs_file_info( $file_orig ) }; + $revinfo_orig = { $VCS->file_info( $file_orig ) }; } } @@ -277,6 +279,7 @@ sub verbose; # determine the status of the file my ($status,$str,$rev_transl,$maintainer,$maxdelta) = check_file( + $VCS, $file, $orig, $transl, $revinfo_orig, $revinfo_transl, @@ -314,6 +317,7 @@ sub verbose; if ( $OPT{'l'} and $status == ST_NEEDSUPDATE ) { my $log = get_log( + $VCS, $file_orig, $rev_transl, $revinfo_orig->{'cmt_rev'}, @@ -325,6 +329,7 @@ sub verbose; if ( $OPT{'d'} and $status == ST_NEEDSUPDATE ) { my $diff = get_diff( + $VCS, $file_orig, $rev_transl, $revinfo_orig->{'cmt_rev'}, @@ -336,6 +341,7 @@ sub verbose; if ( $OPT{'T'} and $status == ST_NEEDSUPDATE ) { my $diff = get_diff_txt( + $VCS, $file_orig, $rev_transl, $revinfo_orig->{'cmt_rev'}, @@ -383,7 +389,7 @@ sub verbose; $maxdelta ||= $translators{maxdelta}{maxdelta} || 5; my $delta; - $delta = vcs_count_changes( $file_orig, $rev_transl, 'HEAD' ); + $delta = $VCS->count_changes( $file_orig, $rev_transl, 'HEAD' ); if ( $delta >= $maxdelta ) { @@ -401,7 +407,7 @@ sub verbose; } - send_email( \%emails_to_send, \%translators, $language, + send_email( $VCS, \%emails_to_send, \%translators, $language, $OPT{'n'}, $OPT{'M'}, $OPT{'g'} ); exit 0; @@ -447,6 +453,7 @@ sub handle_INT #== sub send_email { + my $VCS = shift; my $emails = shift or die("No emails specified"); my $translators = shift or die("No translators specified"); my $lang = shift or die("No language specified"); @@ -582,7 +589,7 @@ sub send_email my $filename = catfile( 'english', $file->{'file'} ); my $rev = $file->{'last_trans_rev'}; - my $diff = get_diff( $filename, $rev, 'HEAD' ); + my $diff = get_diff( $VCS, $filename, $rev, 'HEAD' ); $msg->attach( 'Type' => 'TEXT', 'Filename' => "$filename.diff", @@ -609,7 +616,7 @@ sub send_email my $filename = catfile( 'english', $file->{'file'} ); my $filename2 = catfile( $lang, $file->{'file'} ); my $rev = $file->{'last_trans_rev'}; - my $tdiff = get_diff_txt( $filename, $rev, 'HEAD', + my $tdiff = get_diff_txt( $VCS, $filename, $rev, 'HEAD', $filename2 ); $msg->attach( 'Type' => 'TEXT', @@ -637,7 +644,7 @@ sub send_email my $filename = catfile( 'english', $file->{'file'} ); my $rev = $file->{'last_trans_rev'}; - my $log = get_log( $filename, $rev, 'HEAD' ); + my $log = get_log( $VCS, $filename, $rev, 'HEAD' ); my $part = MIME::Lite->new( 'Type' => 'TEXT', 'Filename' => "$filename.log", @@ -732,13 +739,14 @@ sub get_revision_age #== sub get_log { + my $VCS = shift; my $file = shift or die("No file specified for diff"); my $rev1 = shift; my $rev2 = shift; die("NO such file `$file'") unless -e $file; - my @log = vcs_get_log( $file, $rev1, $rev2 ); + my @log = $VCS->get_log( $file, $rev1, $rev2 ); # remove the first item of the log, because we only want # to see when changed in the (left-open) range (rev1,rev2] @@ -769,13 +777,14 @@ sub get_log #== sub get_diff { + my $VCS = shift; my $file = shift or die("No file specified for diff"); my $rev1 = shift; my $rev2 = shift; die("NO such file `$file'") unless -e $file; - my %diffs = vcs_get_diff( $file, $rev1, $rev2 ); + my %diffs = $VCS->get_diff( $file, $rev1, $rev2 ); # just glue all diffs together and return it as a big string my $difftxt = join( '', values %diffs ); @@ -788,6 +797,7 @@ sub get_diff #== sub get_diff_txt { + my $VCS = shift; my $english_file = shift or die("No file specified"); my $rev1 = shift or die("No revision specified"); my $rev2 = shift or die("No revision specified"); @@ -797,7 +807,7 @@ sub get_diff_txt die("No such file $transl_file") unless -e $transl_file; # Get old revision file - my @english_txt = split( "\n", vcs_get_file( $english_file, $rev1 ) ); + my @english_txt = split( "\n", $VCS->get_file( $english_file, $rev1 ) ); # Get translation file my $transl_txt = read_file( $transl_file ) @@ -805,7 +815,7 @@ sub get_diff_txt my @transl_txt = split( "\n", $transl_txt ); # Get diff lines - my @diff_txt = split( "\n", get_diff( $english_file, $rev1, $rev2 ) ); + my @diff_txt = split( "\n", get_diff( $VCS, $english_file, $rev1, $rev2 ) ); # do the matching my $txt = Local::WmlDiffTrans::find_trans_parts( @@ -1041,6 +1051,7 @@ sub read_translators #== sub check_file { + my $VCS = shift; my $file = shift; my $orig = shift; my $lang = shift; @@ -1104,7 +1115,7 @@ sub check_file else { # check the revisions to see if they're up to date - my $cmp = vcs_cmp_rev( $translation_last_change, + my $cmp = $VCS->cmp_rev( $file_orig, $translation_last_change, $orig_last_change ); if ( $cmp == 0 ) # revisions equal diff --git a/copypage.pl b/copypage.pl index 982fe168ea7..8394ad44750 100755 --- a/copypage.pl +++ b/copypage.pl @@ -21,7 +21,7 @@ FindBin::again(); use lib "$FindBin::Bin/Perl"; use File::Path; -use Local::VCS qw(vcs_file_info); +use Local::VCS; use File::Temp qw/tempfile/; use Getopt::Std; @@ -53,6 +53,8 @@ if (exists $ENV{DWWW_MAINT}) $maintainer = $ENV{DWWW_MAINT}; } +my $VCS = Local::VCS->new(); + # Options our ($opt_n, $opt_t, $opt_l); getopts('nm:l:'); @@ -85,7 +87,6 @@ if ($#ARGV == -1) print "\t\t(overwrites language.conf definition\n"; print "\tDWWW_MAINT\tSets maintainer for the translation\n"; print "Options:\n"; - print "\t-n\tDoes not check status of target files in CVS\n"; print "\t-m\tSets the maintainer for the translation (overwrites environment)\n"; print "\t-l\tSets the language for the translation (overwrites environment)\n"; print "\n"; @@ -190,9 +191,7 @@ sub copy } # Retrieve VCS revision number - my %vcsinfo = vcs_file_info( $srcfile ); - - find_files_attic ( $dstfile ) if ! $opt_n; + my %vcsinfo = $VCS->file_info( $srcfile ); if ( not %vcsinfo or not exists $vcsinfo{'cmt_rev'} ) { @@ -247,80 +246,3 @@ sub copy print "and to remove $dsttitle when finished\n" if defined $dsttitle; } - -# Find for old translations in the CVS Attic -sub find_files_attic -{ - my ($file) = @_; - $file =~ s/'//; - print "Checking CVS information for $file...\n"; - - # Create a temporary file for the cvs results - my ($tempfh, $tmpfile) = tempfile("cvsinfo.XXXXXX", DIR => File::Spec->tmpdir, UNLINK => 0) ; - close $tempfh; - - # Run 'cvs status'. Unfortunately, this is the only way - # to look for files in the Attic - system "LC_ALL=C cvs status '$file' >$tmpfile 2>&1"; - - if ( $? != 0 ) - { - # CVS returns an error, then cleanup and return - # Do not complain because this might happen just because we - # have no network access, just cleanup the temporary file - unlink $tmpfile; - return 0; - } - - # If CVS does not return an error then there is a file in CVS - # even if $dstfile is not in the filesystem - # There could be two reasons for this: - # - The user has removed it but somebody else put it in CVS - # - It resides in the Attic - my $deleted_version = "<latest_version>"; - my $previous_version = "<version_before_deletion>"; - my $cvs_location = ""; - - # Parse the result of cvs status - open(TF, $tmpfile) || die ("Cannot open temporary file: $?"); - while ($line = <TF>) { - chomp $line; - if ( $line =~ /Repository revision:\s+(\d+)\.(\d+)\s+(.*)$/ ) { - $cvs_location = $3; - $deleted_version = $1.".".$2 ; - $previous_version = $1.".".($2-1); - } - } - close TF; - unlink $tmpfile; # File is not used from here on, delete it - - # Now determine in which situation we are in: - - if ( $cvs_location eq "" ) - { -# Situation 0 - This happens when the return text is -# "Repository revision: No revision control file" - return 0; # Nothing to do here - - } - - if ( $cvs_location =~ /Attic\// ) - { -# Situation 1 - There is a translation in the Attic -# Give information on how to restore - - print STDERR "ERROR: An old translation exists in the Attic, you should restore it using:\n"; - print STDERR "\tcvs update -j $deleted_version -j $previous_version $dstfile\n"; - print STDERR "\t[Edit and update the file]\n"; - print STDERR "\tcvs ci $dstfile\n"; - die ("Old translation found\n"); - } - - # Situation 2 - There is already a file in CVS with this - # name, since it does not exist in the local copy maybe - # the local copy is not up to date - print STDERR "ERROR: A translation already exist in CVS for this file.\n"; - print STDERR "\tPlease update your CVS copy using 'cvs update'.\n"; - die ("Translation already exists\n"); - -} @@ -1,7 +1,6 @@ #!/usr/bin/perl # This is a toy to compute the karma of translators in the Debian web site -# CVS repository. # It use information about translation revisions please see # https://www.debian.org/devel/website/uptodate @@ -27,7 +26,7 @@ use FindBin; # These modules reside under webwml/Perl use lib "$FindBin::Bin/Perl"; -use Local::VCS ':all'; +use Local::VCS; use Local::WmlDiffTrans; use Webwml::TransCheck; use Webwml::TransIgnore; @@ -56,7 +55,8 @@ foreach my $d (@DIRS) print "Reading data..."; my $lang_from = 'english'; -my %info_from = vcs_path_info( $lang_from, +my $VCS = Local::VCS->new(); +my %info_from = $VCS->path_info( $lang_from, match_pat => $MATCH, skip_pat => $SKIP, recursive => 1, @@ -80,7 +80,7 @@ foreach my $subdir (@DIRS) # TODO: transignore # fetch a list of all (translated) files in this subdir - my %info_to = vcs_path_info( catfile($lang_to,$subdir), + my %info_to = $VCS->path_info( catfile($lang_to,$subdir), match_pat => $MATCH, skip_pat => $SKIP, recursive => 1, @@ -151,9 +151,9 @@ sub check_file $translator =~ s/^\s+ |\s+$//; # calculate the number of revision the original english file has has - my $numrev = vcs_count_changes( $file_trans, undef, $revision ); + my $numrev = $VCS->count_changes( $file_trans, undef, $revision ); # calculate the age of the translated file - my $age = vcs_count_changes( $file_orig, $oldr, $revision ); + my $age = $VCS->count_changes( $file_orig, $oldr, $revision ); $karma->{$translator} += $numrev; # page translated. GOOD $karma->{$translator} -= $numrev*$age/4; #out of date page; Bad diff --git a/remove_stale.pl b/remove_stale.pl index 7d9a0bd6070..4a7589164e3 100755 --- a/remove_stale.pl +++ b/remove_stale.pl @@ -26,12 +26,14 @@ FindBin::again(); use lib "$FindBin::Bin/Perl"; use Webwml::Langs; -use Local::VCS 'vcs_file_info'; +use Local::VCS; # directory where "make install" installs the website use constant INSTALLDIR => '../www'; +my $VCS = Local::VCS->new(); + ############################################################### # "main" { @@ -128,7 +130,7 @@ sub find_stale_files my %wmlfiles = map { $_ => 1 } find_files_ext( $dir, 'wml' ); # Locate all HTML files, and find out which ones do not correspond - # to a WML file, and does not live in the CVS by itself. + # to a WML file, and does not live in the VCS by itself. my @toremove; foreach my $htmlfile (sort @htmlfiles) { @@ -151,7 +153,7 @@ sub find_stale_files my $haswml = exists( $wmlfiles{$source} ) || -f $source || 0; # is the html file checked in the VCS? - my $checkedin = vcs_file_info($htmlfile , quiet => 1 ) ? 1 : 0; + my $checkedin = $VCS->file_info($htmlfile , quiet => 1 ) ? 1 : 0; #if ($checkedin) #{ print "==> `$htmlfile' : `$source' : $haswml : $checkedin\n"; } diff --git a/smart_change.pl b/smart_change.pl index dcf2ce53527..c81df65ba10 100755 --- a/smart_change.pl +++ b/smart_change.pl @@ -12,11 +12,11 @@ use Getopt::Long; # These modules reside under webwml/Perl use lib ($0 =~ m|(.*)/|, $1 or ".") ."/Perl"; -use Local::Cvsinfo; +use Local::VCS; use Webwml::TransCheck; use Webwml::Langs; -our ($opt_h, $opt_v, $opt_n, $opt_p, @opt_l, @opt_s); +our ($opt_h, $opt_v, $opt_n, @opt_l, @opt_s); sub usage { print <<'EOT'; @@ -25,11 +25,23 @@ Options: -h, --help display this message -v, --verbose run verbosely -n, --no-bump do not bump translation-check headers - -p, --previous get previous CVS revision -l, --lang=STRING process this language (may be used more than once) -s, --substitute=REGEXP Perl regexp applied to source files (may be used more than once) + +This is a *NEW* implementation of smart_change.pl which is limited to +supporting git commit hashes. To use this: + + 1. Make the changes to the original file(s), and commit + 2. Update translations + 3. Run smart_change.pl - it will pick up the changes and update + headers in the translation files + 4. Commit the translation changes + +This is more involved than previously (needing two commits), but +unavoidable... + EOT exit(0); } @@ -53,8 +65,7 @@ sub verbose { print STDERR $_[0] . "\n" if $opt_v; } -# We call constructor without argument. It means there must be a -# CVS/Repository file or program will abort. +# We call constructor without argument. if (not @opt_l) { my $l = Webwml::Langs->new(); @opt_l = $l->names(); @@ -71,21 +82,15 @@ die "Invalid -s option" if $@; foreach my $argfile (@ARGV) { $argfile =~ m+^(english.*)/(.*\.(wml|src))+ or die "unknown path '$argfile'"; - my ($path, $file) = ($1, $2); verbose("File: $argfile"); - my $cvs = Local::Cvsinfo->new(); - $cvs->options(matchfile => [ $file ]); - $cvs->readinfo($path); - my $origrev = $cvs->revision($argfile) || "1.0"; - if ($opt_p) { - $origrev =~ s/(\d+)$/($1 - 1)/e; - } + my $VCS = Local::VCS->new(); + my %file_info = $VCS->file_info($argfile); + my $origrev = $file_info{'cmt_rev'} or die "Can't find revision information for original file $argfile\n"; verbose("Original revision: $origrev"); - my $nextrev = $origrev; - $nextrev =~ s/(\d+)$/(1+$1)/e; - verbose("Next revision: $nextrev"); + my $prevrev = $VCS->next_revision($argfile, $origrev, -1); + verbose("Previous revision: $prevrev"); foreach my $lang (@opt_l) { my $transfile = $argfile; @@ -98,17 +103,19 @@ foreach my $argfile (@ARGV) { next unless $transcheck->revision() || $lang eq 'english'; my $langrev = $transcheck->revision(); + if (defined $langrev and $langrev =~ m/^$origrev$/) { + print " $transfile already claims to be a translation for $argfile rev $origrev\n"; + } + my $origtext = ''; my $transtext = ''; open (TRANS, "< $transfile"); while (<TRANS>) { $origtext .= $_; if (m/^#use wml::debian::translation-check/ && !$opt_n && - ($langrev eq $origrev || $langrev eq $nextrev)) { - # Also check for $nextrev in case this script - # is run several times - s/(translation="?)($origrev|$nextrev)("?)/$1$nextrev$3/; - verbose("Bump version number to $nextrev"); + ($langrev eq $prevrev)) { + s/(translation="?)($prevrev)("?)/$1$origrev$3/; + verbose("Bump version number to $origrev"); } $transtext .= $_; } diff --git a/stattrans.pl b/stattrans.pl index a321ad54f75..de43989822f 100755 --- a/stattrans.pl +++ b/stattrans.pl @@ -22,15 +22,16 @@ use Getopt::Std; # These modules reside under webwml/Perl use lib ($0 =~ m|(.*)/|, $1 or ".") ."/Perl"; -use Local::Cvsinfo; +#use Local::Cvsinfo; +use Local::VCS ':all'; use Webwml::Langs; use Webwml::TransCheck; use Webwml::TransIgnore; use Debian::L10n::Db ('%LanguageList'); use Net::Domain qw(hostfqdn); +use Data::Dumper; use JSON; - $| = 1; $opt_h = "/srv/www.debian.org/webwml/english/devel/website/stats"; @@ -59,33 +60,52 @@ $opt_p =~ s/$/\$/g; 'hit_file'=> $opt_f, ); +my $VCSHOST = "salsa"; +my $VCSBASE = "https://salsa.debian.org/webmaster-team/webwml/test_webwml_cvs2git"; +if (-d "$config{'wmldir'}/CVS") { + $VCSHOST = "alioth"; + $VCSBASE = "https://anonscm.debian.org/viewvc/webwml/webwml"; +} + my $l = Webwml::Langs->new($opt_w); my %langs = $l->name_iso(); +my $VCS = Local::VCS->new(); +$VCS->cache_repo(); my $transignore = Webwml::TransIgnore->new($opt_w); -my $cvs = Local::Cvsinfo->new(); -$cvs->options( - recursive => 1, - matchfile => [ $config{'wmlpat'} ], - skipdir => [ "template" ], -); -$cvs->readinfo("$config{'wmldir'}/english"); +chdir($config{'wmldir'}) or die "Can't chdir to $config{'wmldir'}: $!\n"; + +#my $cvs = Local::Cvsinfo->new(); +#$cvs->options( +# recursive => 1, +# matchfile => [ $config{'wmlpat'} ], +# skipdir => [ "template" ], +#); +#$cvs->readinfo("$config{'wmldir'}/english"); +my %rev_info = $VCS->path_info("english", + 'recursive' => 1, + 'match_pat' => $config{'wmlpat'}, + 'skip_pat' => "(template|/devel/website/stats/)"); +my $cnt = scalar(keys %rev_info); +#print "found $cnt english files using wmlpat $config{'wmlpat'}\n"; foreach (@{$transignore->global()}) { - $cvs->removefile("$config{'wmldir'}/english/$_"); +# $cvs->removefile("$config{'wmldir'}/english/$_"); + delete $rev_info{"english/$_"}; } -my $altcvs = Local::Cvsinfo->new(); -$altcvs->options( - recursive => 1, - matchfile => [ $config{'wmlpat'} ], - skipdir => [ "template" ], -); +#print "found $cnt english files\n"; + +#y $altcvs = Local::Cvsinfo->new(); +#altcvs->options( +# recursive => 1, +# matchfile => [ $config{'wmlpat'} ], +# skipdir => [ "template" ], +#; $max_versions = 5; $min_versions = 1; - $date = strftime "%a %b %e %H:%M:%S %Y %z", localtime; my %original; @@ -96,16 +116,16 @@ my %sizes; print "Loading the coordination status databases\n" if ($config{verbose}); my %status_db = (); -opendir (DATADIR, "$opt_w/english/international/l10n/data") - or die "Cannot open directory $opt_w/english/international/l10n/data: $!\n"; +opendir (DATADIR, "english/international/l10n/data") + or die "Cannot open directory english/international/l10n/data: $!\n"; foreach (readdir (DATADIR)) { # Only check the status files next unless ($_ =~ m/^status\.(.*)$/); my $l = $1; next if (!defined $LanguageList{uc $l}); - if (-r "$opt_w/english/international/l10n/data/status.$l") { + if (-r "english/international/l10n/data/status.$l") { $status_db{$LanguageList{uc $l}} = Debian::L10n::Db->new(); - $status_db{$LanguageList{uc $l}}->read("$opt_w/english/international/l10n/data/status.$l", 0); + $status_db{$LanguageList{uc $l}}->read("english/international/l10n/data/status.$l", 0); } } closedir (DATADIR); @@ -134,28 +154,40 @@ sub linklist { sub getwmlfiles { my $lang = shift; - my $dir = "$config{'wmldir'}/$lang"; - my $cutfrom = length ($config{'wmldir'})+length($lang)+2; + my $dir = "$lang"; +# my $cutfrom = length ($config{'wmldir'})+length($lang)+2; my $count = 0; my $size = 0; my $is_english = ($lang eq "english")?1:0; my ( $file, $v ); my @listfiles; + my %altrev_info; - print "$lang " if ($config{verbose}); if (! -d "$dir") { print "$0: can't find $dir! Skipping ...\n"; return; } if ($is_english) { - @listfiles = @{$cvs->files()}; +# @listfiles = @{$cvs->files()}; + @listfiles = sort keys(%rev_info); } else { - $altcvs->reset(); - $altcvs->readinfo($dir); - @listfiles = @{$altcvs->files()}; + %altrev_info = $VCS->path_info($dir, + 'recursive' => 1, + 'match_pat' => $config{'wmlpat'}, + 'skip_pat' => "template"); + @listfiles = sort keys(%altrev_info); +# $altcvs->reset(); +# $altcvs->readinfo($dir); +# @listfiles = @{$altcvs->files()}; } - foreach my $f (@listfiles) { - $file = substr ($f, $cutfrom); +# print "cutfrom is $cutfrom\n"; +# print "Looking at @listfiles\n"; +# open (LIST, ">$config{'htmldir'}/$lang.list") +# || die "Can't open $config{'htmldir'}/$lang.list"; + foreach my $file (@listfiles) { +# print LIST "$file\n"; +# $file = substr ($f, $cutfrom); +# print "looking at $file\n"; next if $transignore->is_global($file); $files{$file} = 1; $wmlfiles{$lang} .= " " . $file; @@ -165,17 +197,19 @@ sub getwmlfiles $original{"$lang/$file"} ||= $transcheck->original(); } if ($is_english) { - $version{"$lang/$file"} = $cvs->revision($f); + #$version{"$lang/$file"} = $cvs->revision($f); + $version{"$lang/$file"} = $rev_info{"$file"}{'cmt_rev'}; } else { - $version{"$lang/$file"} = $altcvs->revision($f); + $version{"$lang/$file"} = $altrev_info{"$file"}{'cmt_rev'}; +# $version{"$lang/$file"} = $altcvs->revision($f); if (!$transcheck->revision()) { $transcheckenglish = Webwml::TransCheck->new("english/$file"); if (!$transcheckenglish->revision() and (-e "english/$file")) { - $transversion{"$lang/$file"} = "1.1"; + $transversion{"$lang/$file"} = $VCS->get_oldest_revision("english/$file"); $original{"$lang/$file"} = "english"; } else { $original{"english/$file"} = $lang; - $transversion{"english/$file"} ||= "1.1"; + $transversion{"english/$file"} = $VCS->get_oldest_revision("$lang/$file"); } } } @@ -196,9 +230,13 @@ sub getwmlfiles $sizes{$file} = (stat "".($original{"english/$file"}||"english")."/".$file)[7]; $size += $sizes{$file}; } +# close LIST; $wmlfiles{$lang} .= " "; $wml{$lang} = $count; $wml_s{$lang} = $size; + if ($config{verbose}) { + print " $lang: $count wml files, $size bytes\n"; + } } sub get_color @@ -214,35 +252,26 @@ sub get_color sub check_translation { - my ($translation, $version, $file) = @_; + my ($translation, $version, $file, $orig_file) = @_; + my ( @version_numbers, $major_number, $last_number ); - my ( @translation_numbers, $major_translated_number, $last_translated_number ); +# print " check_translation: looking at translation $translation, english version $version, file $file, orig_file $orig_file\n"; if ( $version && $translation ) { - @version_numbers = split /\./,$version; - $major_number = $version_numbers[0]; - $last_number = pop @version_numbers; - die "Invalid CVS revision for $file: $version\n" - unless ($major_number =~ /\d+/ && $last_number =~ /\d+/); - - @translation_numbers = split /\./,$translation; - $major_translated_number = $translation_numbers[0]; - $last_translated_number = pop @translation_numbers; - die "Invalid translation revision for $file: $translation\n" - unless ($major_translated_number =~ /\d+/ && $last_translated_number =~ /\d+/); - # Here we compare the original version with the translated one and print # a note for the user if their first or last numbers are too far apart # From translation-check.wml - - if ( $major_number != $major_translated_number ) { - return '<gettext domain="stats">This translation is too out of date</gettext>'; - } elsif ( $last_number - $last_translated_number < 0 ) { - return '<gettext domain="stats">Wrong translation version</gettext>'; - } elsif ( $last_number - $last_translated_number >= $max_versions ) { - return '<gettext domain="stats">This translation is too out of date</gettext>'; - } elsif ( $last_number - $last_translated_number >= $min_versions ) { - return '<gettext domain="stats">The original is newer than this translation</gettext>'; + my $version_diff = $VCS->count_changes($orig_file, $version, $translation); + if (!defined $version_diff) { + print "check_translation: error from count_changes for orig_file $orig_file, file $file\n"; + } else { + if ($version_diff < 0) { + return '<gettext domain="stats">Wrong translation version</gettext>'; + } elsif ( $version_diff >= $max_versions ) { + return '<gettext domain="stats">This translation is too out of date</gettext>'; + } elsif ( $version_diff >= $min_versions ) { + return '<gettext domain="stats">The original is newer than this translation</gettext>'; + } } } elsif ( !$version && $translation) { return '<gettext domain="stats">The original no longer exists</gettext>'; @@ -250,12 +279,12 @@ sub check_translation return ""; } -print "Collecting data in: " if ($config{'verbose'}); +print "Collecting data:\n" if ($config{'verbose'}); if ($opt_l) { getwmlfiles ($opt_l); getwmlfiles ('english'); } else { - foreach $lang (keys %langs) { + foreach $lang (sort keys %langs) { getwmlfiles ($lang); } } @@ -278,11 +307,11 @@ foreach $lang (@search_in) { $percent_po_t{'total'}{$lang} = 0; $percent_po_f{'total'}{$lang} = 0; $percent_po_u{'total'}{$lang} = 100; - if (! -d "$opt_w/$lang/po") { - print "$0: can't find $opt_w/$lang/po! Skipping ...\n"; + if (! -d "$lang/po") { + print "$0: can't find $lang/po! Skipping ...\n"; next; } - my @status = qx,LC_ALL=C make -C $opt_w/$lang/po stats 2>&1,; + my @status = qx,LC_ALL=C make -C $lang/po stats 2>&1,; foreach $line (@status) { chomp $line; next if($line =~ /make: (Enter|Leav)ing directory/); @@ -355,6 +384,7 @@ my @filenames = sort $file_sorter keys %files; my $nfiles = scalar @filenames; $nsize += $sizes{$_} foreach (@filenames); +# 'u' == 'unidiff', 'h' == 'colored diff' my $firstdifftype; my $seconddifftype; if ($config{'difftype'} eq 'u') { @@ -365,36 +395,52 @@ if ($config{'difftype'} eq 'u') { $seconddifftype = 'u'; } -sub alioth_cvs_file_url { +sub vcs_log_url { my ($path) = @_; - return - sprintf( 'https://anonscm.debian.org/viewvc/webwml/webwml/%s', $path ); -} - -sub alioth_cvs_log_url { - my ($path) = @_; - - return alioth_cvs_file_url($path); + if ($VCSHOST == "alioth") { + return "$VCSBASE/$path"; + } elsif ($VCSHOST == "salsa") { + return "$VCSBASE/commits/master/$path"; + } else { + die "Unknown/unsupported VCSHOST $VCSHOST - ABORT\n"; + } } -sub alioth_cvs_diff_url { +sub vcs_diff_url { my ( $path, $r1, $r2, $diff_format ) = @_; - return alioth_cvs_file_url($path) - . sprintf( '?r1=%s&r2=%s&diff_format=%s', $r1, $r2, $diff_format ); + if ($VCSHOST == "alioth") { + return "$VCSBASE/$path/?r1=$r1&r2=$r2&diff_format=$diff_format"; + } elsif ($VCSHOST == "salsa") { + return "$VCSBASE/BROKEN_DIFF_SUPPORT_FIXME/$path"; + } else { + die "Unknown/unsupported VCSHOST $VCSHOST - ABORT\n"; + } } -sub alioth_cvs_view_url { +sub vcs_view_url { my ($path) = @_; - return alioth_cvs_file_url($path) . '?view=markup'; + if ($VCSHOST == "alioth") { + return "$VCSBASE/$path?view=markup"; + } elsif ($VCSHOST == "salsa") { + return "$VCSBASE/blob/master/$path"; + } else { + die "Unknown/unsupported VCSHOST $VCSHOST - ABORT\n"; + } } -sub alioth_cvs_raw_url { +sub vcs_raw_url { my ($path) = @_; - return alioth_cvs_file_url($path) . '?view=co'; + if ($VCSHOST == "alioth") { + return "$VCSBASE/$path?view=co"; + } elsif ($VCSHOST == "salsa") { + return "$VCSBASE/raw/master/$path"; + } else { + die "Unknown/unsupported VCSHOST $VCSHOST - ABORT\n"; + } } print "Creating files: " if ($config{'verbose'}); @@ -419,7 +465,7 @@ foreach $lang (@search_in) { $translated_s{$lang} += $sizes{$file}; $orig = $original{"$lang/$file"} || "english"; # Outdated translations - $msg = check_translation ($transversion{"$lang/$file"}, $version{"$orig/$file"}, "$lang/$file"); + $msg = check_translation ($transversion{"$lang/$file"}, $version{"$orig/$file"}, "$lang/$file", "$orig/$file"); if (length ($msg) or (($todo ne '<td></td><td></td><td></td>') and ($transversion{"$lang/$file"} ne $version{"$orig/$file"}))) { $o_body .= "<tr>"; if (($file !~ /\.wml$/) @@ -444,10 +490,10 @@ foreach $lang (@search_in) { if (defined $status_db{$lang}) { if ($transversion{"$lang/$file"} ne ''){ $o_body .= sprintf '<td><a title=\'<gettext domain="stats">Unified diff</gettext>\' href="%s">%s → %s</a> ', - alioth_cvs_diff_url( "$orig/$file", $transversion{"$lang/$file"}, $version{"$orig/$file"}, 'u' ), + vcs_diff_url( "$orig/$file", $transversion{"$lang/$file"}, $version{"$orig/$file"}, 'u' ), $transversion{"$lang/$file"}, $version{"$orig/$file"}; $o_body .= sprintf '<a title=\'<gettext domain="stats">Colored diff</gettext>\' href="%s">%s → %s</a> ', - alioth_cvs_diff_url( "$orig/$file", $transversion{"$lang/$file"}, $version{"$orig/$file"}, 'h' ), + vcs_diff_url( "$orig/$file", $transversion{"$lang/$file"}, $version{"$orig/$file"}, 'h' ), $transversion{"$lang/$file"}, $version{"$orig/$file"}; $o_body .= "$statspan</td>"; } else { @@ -455,16 +501,16 @@ foreach $lang (@search_in) { } } else { $o_body .= sprintf "<td><a href=\"%s\">%s\ ->\ %s</a></td>", - alioth_cvs_diff_url( "$orig/$file", $transversion{"$lang/$file"}, $version{"$orig/$file"}, $firstdifftype ), + vcs_diff_url( "$orig/$file", $transversion{"$lang/$file"}, $version{"$orig/$file"}, $firstdifftype ), $transversion{"$lang/$file"}, $version{"$orig/$file"}; $o_body .= sprintf "<td><a href=\"%s\">%s\ ->\ %s</a></td>", - alioth_cvs_diff_url( "$orig/$file", $transversion{"$lang/$file"}, $version{"$orig/$file"}, $seconddifftype ), + vcs_diff_url( "$orig/$file", $transversion{"$lang/$file"}, $version{"$orig/$file"}, $seconddifftype ), $transversion{"$lang/$file"}, $version{"$orig/$file"}; } } - $o_body .= sprintf "<td><a title=\"%s\" href=\"%s#rev%s\">[L]</a></td>", $msg, alioth_cvs_log_url("$orig/$file"), $version{"$orig/$file"}; - $o_body .= sprintf "<td><a href=\"%s\">[V]</a>\ ", alioth_cvs_view_url("$lang/$file"); - $o_body .= sprintf "<a href=\"%s\">[F]</a></td>", alioth_cvs_raw_url("$lang/$file"); + $o_body .= sprintf "<td><a title=\"%s\" href=\"%s#rev%s\">[L]</a></td>", $msg, vcs_log_url("$orig/$file"), $version{"$orig/$file"}; + $o_body .= sprintf "<td><a href=\"%s\">[V]</a>\ ", vcs_view_url("$lang/$file"); + $o_body .= sprintf "<a href=\"%s\">[F]</a></td>", vcs_raw_url("$lang/$file"); $o_body .= sprintf "<td align=center>%s</td>", $maintainer{"$lang/$file"} || ""; $o_body .= $todo if (defined $status_db{$lang}); $o_body .= "</tr>\n"; @@ -546,7 +592,7 @@ foreach $lang (@search_in) { printf HTML "#use wml::debian::template title=\"<:=\$trans{\$CUR_ISO_LANG}{%s}:>\"\n", $lang; print HTML "#use wml::debian::toc\n"; printf HTML qq|<define-tag transstatslink><a href="%s">webwml-stattrans</a></define-tag>\n|, - alioth_cvs_view_url('stattrans.pl'); + vcs_view_url('stattrans.pl'); print HTML "<define-tag createdwith><address>\n"; print HTML '<gettext domain="stats">Created with <transstatslink></gettext>'; print HTML "</address></define-tag>\n"; @@ -688,7 +734,7 @@ open (HTMLI, ">$config{'htmldir'}/index.wml") print HTMLI "#use wml::debian::stats_tags\n"; printf HTMLI "#use wml::debian::template title=\"%s\"\n\n", $config{'title'}; printf HTMLI qq|<define-tag transstatslink><a href="%s">webwml-stattrans</a></define-tag>\n|, - alioth_cvs_view_url('stattrans.pl'); + vcs_view_url('stattrans.pl'); print HTMLI "<define-tag createdwith><address>\n"; print HTMLI '<gettext domain="stats">Created with <transstatslink></gettext>'; print HTMLI "</address></define-tag>\n"; diff --git a/switch_to_git_translations.pl b/switch_to_git_translations.pl new file mode 100755 index 00000000000..76e32b92c2e --- /dev/null +++ b/switch_to_git_translations.pl @@ -0,0 +1,226 @@ +#!/usr/bin/perl + +# This script walks the webwml tree to look for translated files. It +# looks for the wml::debian::translation-check header to see if a file +# is a stranslation of an original, then checks for the revision +# status of the master document. +# +# Part of the effort to switch from CVS to Git +# +# Originally written 2018 by Steve McIntyre <93sam@debian.org> +# © Copyright 2018 Software in the public interest, Inc. +# This program is released under the GNU General Public License, v2. + +use strict; +use warnings; + +use Getopt::Long; +use Data::Dumper; +use File::Spec::Functions; +use File::Find; +use lib ($0 =~ m|(.*)/|, $1 or ".") ."/Perl"; +use Webwml::TransCheck; + +my $help = 0; +my $verbose = 0; +my $dry_run = 0; +my $revs_file = ""; +my %rev_map; + +sub usage { + print <<'EOT'; +Usage: switch_to_git_translations.pl [options] +Options: + --help display this message + --verbose run verbosely + --dry-run do not modify translation-check headers + --revisions=REVISIONS location of the cvs2git revisions map file + +Find all wml/src/etc. files under the current directory, updating revisions for +translations. +EOT + exit(0); +} + +# log very verbose messages +sub vvlog { + if ($verbose >= 2) { + print STDOUT $_[0] . "\n"; + } +} + +# log verbose messages +sub vlog { + if ($verbose >= 1) { + print STDOUT $_[0] . "\n"; + } +} + +# Parse the revisions file for use, building a hash of the git and cvs versions for each file +sub parse_revisions +{ + my $revs_file = shift; + open(IN, "<", "$revs_file") or die "Can't open revisions file \$revs_file\" for reading: $!\n"; + while (my $line = <IN>) { + chomp $line; + my ($file, $cvs_ver, $commit_hash); + if ($line =~ m,^(\S+) ([.\d]+) ([[:xdigit:]]+)$,) + { + $file = $1; + $cvs_ver = $2; + $commit_hash = $3; + $rev_map{"$file"}{"$cvs_ver"}{"commit_hash"} = $commit_hash; + } else { + die "Failed to parse revisions file at line $.\n"; + } + vvlog("Found file $file with CVS version $cvs_ver in commit hash $commit_hash"); + } + close IN; + vlog("Parsed revisions file \"$revs_file\", found revisions for " . scalar(keys %rev_map) . " files"); +} + +# return a list of filenames with the given extension +sub find_files_ext +{ + my $dir = shift or die('Internal error: No dir specified'); + my $ext = shift or die('Internal error: No ext specified'); + + my @files; + find( sub { if (-f and m/\.$ext$/) { my $filename = $File::Find::name; $filename =~ s,\.\/,,; push @files, $filename }}, $dir ); + return @files; +} + +# Update the translation-check metadata header in a wml file +sub update_file_metadata +{ + my $file = shift; + my $revision = shift; + my $hash = shift; + my $text = ""; + + open (IN, "< $file") or die "Can't open $file for reading: $!\n"; + while (<IN>) { + if (m/^#use wml::debian::translation-check/) { + s/(translation="?)($revision)("?)/$1$hash$3/; + } + $text .= $_; + } + close(IN); + open(OUT, "> $file") or die "Can't open $file for writing: $!\n"; + print OUT $text; + close OUT; +} + +# Parse a file, and see if there's a translation-check header. If so, +# use the rev_map data to switch the translation information from the +# cvs version to the git hash *if available*. If it's not available, +# report an error. +sub parse_file +{ + my $file = shift; + my $info = 0; # Do we have any translation header info at all? + my $tc = Webwml::TransCheck->new("$file") or die "Failed transcheck: $!\n"; + vlog("Looking at wml file $file"); + my $target_lang = "english"; + my $maint = $tc->maintainer(); + if (defined($maint)) { + vvlog(" Maintainer: $maint"); + $info += 1; + } + my $revision = $tc->revision(); + if (defined($revision)) { + vvlog(" Revision: $revision"); + $info += 1; + } + my $original = $tc->original(); + if (defined($original)) { + vvlog(" Original: $original"); + $info += 1; + $target_lang = $original; + } + my $mindelta = $tc->mindelta(); + if (defined($mindelta)) { + vvlog(" Mindelta: $mindelta"); + $info += 1; + } + my $maxdelta = $tc->maxdelta(); + if (defined($maxdelta)) { + vvlog(" Maxdelta: $maxdelta"); + $info += 1; + } + if ($info > 0) { + my $targetfile = $file; + $targetfile =~ s,^[^/]+,$target_lang,; + vvlog(" Depends on $targetfile"); + if (defined($revision)) { + # Do we have a cvs->git map for that file and revision? + my $hash = $rev_map{"$targetfile"}{"$revision"}{"commit_hash"}; +# my $file_hash = $rev_map{"$targetfile"}{"$revision"}{"file_hash"}; + if (defined $hash) { +# if (!defined $file_hash) { +# $file_hash = `git ls-tree -r $hash $targetfile`; +# if ($file_hash =~ m/^\s*\d+\s*blob\s+([[:xdigit:]]+)\s+\S+$/) { +# $file_hash = $1; +# } +# # Cache the result +# $rev_map{"$targetfile"}{"$revision"}{"file_hash"} = $file_hash; +# } + vlog(" Depends on $targetfile with cvs rev $revision, commit hash $hash"); + } else { + vlog(" Looking up $targetfile with cvs rev $revision, no mapping found"); + return 1; + } + if (!$dry_run) { + vlog (" Updating the file data"); + + update_file_metadata($file, $revision, $hash); + } + } else { + vlog(" But no revision data!"); + return 1; + } + } +} + +# open(IN, "<", "$file") or die "Can't open file \$wml_file\" for reading: $!#\n"; +# while (my $line = <IN>) { +# chomp $line; +# if ($line =~ m/^#use wml::debian::translation-check/) { +# my $original="english"; # default +# } +# } +#} + +# "main" + +if (not GetOptions ("help" => \$help, + "verbose=i" => \$verbose, + "dry-run" => \$dry_run, + "revisions=s" => \$revs_file)) +{ + warn "Try `$0 --help' for more information.\n"; + exit(1); +} + +if ($help) { + usage(); +} + +if (! -f $revs_file) { + die "Can't open revisions file, abort!\n"; +} +parse_revisions($revs_file); + +my @wmlfiles = sort(find_files_ext(".", 'wml')); +my @incfiles = sort(find_files_ext(".", 'inc')); +my @pofiles = sort(find_files_ext(".", 'po')); +my @srcfiles = sort(find_files_ext(".", 'src')); +my @files; +push @files, @wmlfiles; +push @files, @incfiles; +push @files, @pofiles; +push @files, @srcfiles; +vlog("Found " . scalar(@files) . " files to work on\n"); +for my $file (@files) { + parse_file($file); +} diff --git a/touch_translations.pl b/touch_translations.pl index 125bcfc692f..c72592c04a4 100755 --- a/touch_translations.pl +++ b/touch_translations.pl @@ -21,14 +21,21 @@ # - think of a better way to check when the file has been rebuilt last # These modules reside under webwml/Perl +# +# FIXME 93sam 2018-05-17: Converted to use Local::VCS to allow for +# usage with git, but not tested much. It's not clear at all if this +# script is still used or not. + use lib ($0 =~ m|(.*)/|, $1 or ".") ."/Perl"; -use Local::Cvsinfo; +use Local::VCS; use Webwml::Langs; use Webwml::TransCheck; # Set this to 1 for debugging $debug = 0; +my $VCS = Local::VCS->new(); + sub rebuild { my $file = shift; $now = time; @@ -72,8 +79,6 @@ sub when_forced { } } -# We call constructor without argument. It means there must be a -# CVS/Repository file or program will abort. my $l = Webwml::Langs->new(); my %langs = $l->iso_name(); my @langs = $l->names(); @@ -84,10 +89,12 @@ $arglang = $langs{$ARGV[1]} or die "Invalid lang argument: $ARGV[1]"; $argfile =~ m+(.*)/(.*\.wml)+ or die "pattern does not match"; my ($path, $file) = ($1, $2); -my $cvs = Local::Cvsinfo->new(); -$cvs->options(matchfile => [ $file ]); -$cvs->readinfo($path); -my $origrev = $cvs->revision($argfile) || "1.0"; +my %file_info = $VCS->file_info($argfile); +my $origrev = $file_info{'cmt_rev'}; +unless ($origrev) +{ + die "Could not get revision number for $argfile - bug in script?\n"; +} foreach $lang (@langs) { next if ($lang eq $arglang); @@ -104,15 +111,10 @@ foreach $lang (@langs) { $original = $transcheck->original(); $maxdelta = $transcheck->maxdelta() if $transcheck->maxdelta(); $mindelta = $transcheck->mindelta() if $transcheck->mindelta(); - # TODO - would cause unspecified results if 1. changed to 2. - $origrev =~ s/1\.//; - $langrev =~ s/1\.//; next unless not defined $original or $original eq $arglang; - # Compare the revisions - print "Orig: $origrev, lang: $langrev\n" if $debug; - $difference = $origrev-$langrev; + $difference = $VCS->count_changes($argfile, $langrev, $origrev); if ($difference < $mindelta) { next unless was_forced($transfile); print "unlinking $transfile.forced\n" if $debug; diff --git a/vcs-test.pl b/vcs-test.pl new file mode 100755 index 00000000000..62e6b0c9afd --- /dev/null +++ b/vcs-test.pl @@ -0,0 +1,341 @@ +#!/usr/bin/perl -w + +# Quick test harness for the VCS helper modules + +use strict; +use Getopt::Long; +use Data::Dumper; +use Digest::MD5 'md5_hex'; + +# These modules reside under webwml/Perl +use lib ($0 =~ m|(.*)/|, $1 or ".") ."/Perl"; +use Local::Cvsinfo; +use Local::VCS; +use Webwml::TransCheck; +use Webwml::Langs; + +my $file = "english/CD/faq/index.wml"; +my $rev1; +my $rev2; +my $rev3; +my $rev4; +if (-d "CVS") { + # Known working revs + $rev1 = "1.138"; + $rev2 = "1.137"; + $rev3 = "1.136"; + # And one that doesn't exist + $rev4 = "2.57768"; +} else { + # Known working revs + $rev1 = "da8b98a6a6cb82188f7b0fd6204d083ad292dea4"; + $rev2 = "4d758459f82173693d9a754fe57b2680b415da3c"; + $rev3 = "f759936a7330f7e7309322658381d1277e6c922c"; + # And one that doesn't exist + $rev4 = "5653875687436536574367564356874365783465"; +} +my $ret; + +my $VCS = Local::VCS->new(); +print "Initialising VCS cache for performance\n"; +$VCS->cache_file($file); +$VCS->cache_file($file); +$VCS->cache_repo(); +$VCS->cache_repo(); +print " ... done!\n"; + +######## +# Startup check - we depend on there being a change in $file above, +# for diff outputs to actually show something. Check if diff shows +# anything, and abort if not. +my %test_diff = $VCS->get_diff($file); +if (!$test_diff{$file}) { + print "Need a diff to work with. Run the following and try again:\n"; + print "\n"; + print "echo foo >> $file\n"; + print "\n"; + die "ABORT\n"; +} + +######## +# main +# +# Quickly check all the functionality we know about: +# $VCS->cmp_rev +# $VCS->count_changes +# $VCS->path_info +# $VCS->file_info +# $VCS->get_log +# $VCS->get_diff +# $VCS->get_file +# $VCS->get_oldest_revision +# $VCS->get_topdir +########################################################## + +########################################################## +print "#############################\n"; +print "VCS->cmp_rev:::\n"; +$ret = $VCS->cmp_rev($file, , ,); +if (!defined $ret) { + $ret = "<undef>"; +} +print "1. (no revs specified) returned $ret\n"; +$ret = $VCS->cmp_rev("english/CD/faq/index.wml", $rev1, $rev1); +if (!defined $ret) { + $ret = "<undef>"; +} +print "2. (equal revs) returned $ret\n"; +$ret = $VCS->cmp_rev("english/CD/faq/index.wml", $rev1, $rev2); +if (!defined $ret) { + $ret = "<undef>"; +} +print "3. (new, old) returned $ret\n"; +$ret = $VCS->cmp_rev("english/CD/faq/index.wml", $rev2, $rev1); +if (!defined $ret) { + $ret = "<undef>"; +} +print "4. (old, new) returned $ret\n"; + +########################################################## +print "#############################\n"; +print "VCS->count_changes:::\n"; +$ret = $VCS->count_changes("english/CD/faq/index.wml", , ,); +if (!defined $ret) { + $ret = "<undef>"; +} +print "1. (no revs specified) returned $ret\n"; +$ret = $VCS->count_changes("english/CD/faq/index.wml", $rev1, $rev1); +if (!defined $ret) { + $ret = "<undef>"; +} +print "2. (equal revs) returned $ret\n"; +$ret = $VCS->count_changes("english/CD/faq/index.wml", $rev1, $rev2); +if (!defined $ret) { + $ret = "<undef>"; +} +print "3. (new, old) returned $ret\n"; +$ret = $VCS->count_changes("english/CD/faq/index.wml", $rev2, $rev1); +if (!defined $ret) { + $ret = "<undef>"; +} +print "4. (old, new) returned $ret\n"; + +########################################################## +my $srcdir = "english/MailingLists/desc"; +print "#############################\n"; +print "VCS->path_info on $srcdir :::\n"; +my %revision_info = $VCS->path_info($srcdir, 'recursive' => 1); +my $i = 0; +foreach my $file (keys %revision_info) { + print "$i: file $file:\n"; + print " type: $revision_info{$file}{'type'}\n"; + print " cmt_date: $revision_info{$file}{'cmt_date'}\n"; + print " cmt_rev: $revision_info{$file}{'cmt_rev'}\n"; + $i++; + if ($i > 2) { + last; + } +} +%revision_info = $VCS->path_info($srcdir, 'recursive' => 0); +$i = 0; +foreach my $file (keys %revision_info) { + print "$i: file $file:\n"; + print " type: $revision_info{$file}{'type'}\n"; + print " cmt_date: $revision_info{$file}{'cmt_date'}\n"; + print " cmt_rev: $revision_info{$file}{'cmt_rev'}\n"; + $i++; + if ($i > 2) { + last; + } +} + +########################################################## +print "#############################\n"; +print "VCS->file_info on $file :::\n"; +%revision_info = $VCS->file_info($file); +print "file $file:\n"; +print " type: $revision_info{'type'}\n"; +print " cmt_date: $revision_info{'cmt_date'}\n"; +print " cmt_rev: $revision_info{'cmt_rev'}\n"; + +sub print_log_info { + my $file = shift; + my $counter = shift; + my $info = shift; + my %tmp = %$info; + print "$counter: file $file:\n"; + print " rev: $tmp{'rev'}\n"; + print " date: $tmp{'date'}\n"; + print " author: $tmp{'author'}\n"; + print " message: $tmp{'message'}\n"; +} + +########################################################## +print "#############################\n"; +print "VCS->get_log on $file :::\n"; +my @log_info; +my $num_logs; +print "1. full range of VCS->get_log on file $file :::\n"; +@log_info = $VCS->get_log($file); +if (@log_info and defined($log_info[0])) { + $num_logs = scalar(@log_info); + print " returns $num_logs log entries\n"; + $i = 0; + foreach my $log (@log_info) { + print_log_info($file, $i, $log); + $i++; + if ($i > 4) { + last; + } + } +} else { + print " returns no data\n"; +} +print "2. single rev of VCS->get_log on $file :::\n"; +@log_info = $VCS->get_log($file, $rev1); +if (@log_info and defined($log_info[0])) { + $num_logs = scalar(@log_info); + print " returns $num_logs log entries\n"; + $i = 0; + foreach my $log (@log_info) { + print_log_info($file, $i, $log); + $i++; + if ($i > 4) { + last; + } + } +} else { + print " returns no data\n"; +} +print "3. single rev of VCS->get_log on $file :::\n"; +@log_info = $VCS->get_log($file, , $rev1); +if (@log_info and defined($log_info[0])) { + $num_logs = scalar(@log_info); + print " returns $num_logs log entries\n"; + $i = 0; + foreach my $log (@log_info) { + print_log_info($file, $i, $log); + $i++; + if ($i > 4) { + last; + } + } +} else { + print " returns no data\n"; +} +print "4. two revs of VCS->get_log on $file :::\n"; +@log_info = $VCS->get_log($file, $rev3,$rev1); +if (@log_info and defined($log_info[0])) { + $num_logs = scalar(@log_info); + print " returns $num_logs log entries\n"; + $i = 0; + foreach my $log (@log_info) { + print_log_info($file, $i, $log); + $i++; + if ($i > 4) { + last; + } + } +} else { + print " returns no data\n"; +} +print "5. two revs reversed of VCS->get_log on $file :::\n"; +@log_info = $VCS->get_log($file, $rev1,$rev3); +if (@log_info and defined($log_info[0])) { + $num_logs = scalar(@log_info); + print " returns $num_logs log entries\n"; + $i = 0; + foreach my $log (@log_info) { + print_log_info($file, $i, $log); + $i++; + if ($i > 4) { + last; + } + } +} else { + print " returns no data\n"; +} +@log_info = $VCS->get_log($file, $rev1,$rev3); +print "6. two revs if VCS->get_log on file, one non-existent on $file :::\n"; +if (@log_info and defined($log_info[0])) { + $num_logs = scalar(@log_info); + print " returns $num_logs log entries\n"; + $i = 0; + foreach my $log (@log_info) { + print_log_info($file, $i, $log); + $i++; + if ($i > 4) { + last; + } + } +} else { + print " returns no data\n"; +} + +########################################################## +print "#############################\n"; +print "VCS->get_diff on $file :::\n"; +my %diffs = $VCS->get_diff($file, $rev2, $rev1); +print "1. diff with two revs on $file:\n"; +print "file: $file\n"; +print "$diffs{$file}\n"; +%diffs = $VCS->get_diff($file, $rev2); +print "2. diff with one older rev on $file:\n"; +print "file: $file\n"; +print "$diffs{$file}\n"; +%diffs = $VCS->get_diff($file); +print "3. diff with no revs on $file:\n"; +print "file: $file\n"; +print "$diffs{$file}\n"; + +########################################################## +print "#############################\n"; +print "VCS->get_file on $file :::\n"; +$ret = $VCS->get_file($file, $rev2); +print "first 120 chars:\n"; +print "#############################\n"; +print substr $ret, 0, 120; +print "\n"; +print "#############################\n"; +my $digest = md5_hex($ret); +print "md5 = $digest\n"; +if ($digest !~ /^\Q11cbcdde3c0121caaed105435adbf902\E$/) { + print "FAIL: didn't get the expected checksum\n"; +} + +########################################################## +print "#############################\n"; +print "VCS->get_oldest_revision on $file :::\n"; +$ret = $VCS->get_oldest_revision($file); +print "Got \"$ret\"\n"; + +########################################################## +print "#############################\n"; +print "VCS->next_revision (-1) on $file :::\n"; +$ret = $VCS->next_revision($file, $rev1, -1); +print "Got \"$ret\", expecting \"$rev2\"\n"; +if ($ret !~ m/$rev2/) { + print " FAIL\n"; +} +print "VCS->next_revision (1) on $file :::\n"; +$ret = $VCS->next_revision($file, $rev2, 1); +print "Got \"$ret\", expecting \"$rev1\"\n"; +if ($ret !~ m/$rev1/) { + print " FAIL\n"; +} + +########################################################## +print "#############################\n"; +print "VCS->get_topdir in topdir:::\n"; +$ret = $VCS->get_topdir(); +print "topdir is $ret\n"; + +chdir("english"); +print "VCS->get_topdir in english:::\n"; +$ret = $VCS->get_topdir(); +print "topdir is $ret\n"; + +chdir("CD"); +print "VCS->get_topdir in english/CD:::\n"; +$ret = $VCS->get_topdir(); +print "topdir is $ret\n"; |