[LON-CAPA-cvs] cvs: modules /raeburn phrasechecker.pl
raeburn
raeburn at source.lon-capa.org
Thu Feb 18 08:11:00 EST 2021
raeburn Thu Feb 18 13:11:00 2021 EDT
Modified files:
/modules/raeburn phrasechecker.pl
Log:
- Add CVS Id for automatic version numbering
- Add a brief comment to describe what script does and who wrote it.
Index: modules/raeburn/phrasechecker.pl
diff -u modules/raeburn/phrasechecker.pl:1.1 modules/raeburn/phrasechecker.pl:1.2
--- modules/raeburn/phrasechecker.pl:1.1 Tue Jan 13 13:48:04 2009
+++ modules/raeburn/phrasechecker.pl Thu Feb 18 13:11:00 2021
@@ -1,16 +1,35 @@
#!/usr/bin/perl
+# $Id: phrasechecker.pl,v 1.2 2021/02/18 13:11:00 raeburn Exp $
+
+#########################################################
+# phrasechecker.pl
+#
+# Stuart Raeburn, January 13, 2009
+#
+#########################################################
+#
+# Compare two tagged versions to find file which have different revision numbers.
+# Compile lists of localized phrases -- both &mt() and lonlocal::texthash() --
+# which are absent in a language file (e.g., de.pm) tagged for the newer version.
+# Check if "missing" phrases exist in language file in CVS HEAD, and display
+# notification if they do.
+#
+
use strict;
-my $path = '/home/raeburn/LClocalization/raeburn';
-my $newnum = '2_8_0';
+my $path = '/home/raeburn/LClocalization/raeburn_2113_feb16';
+my $newnum = '2_11_3';
my $new = 'version_'.$newnum;
-my $oldnum = '2_7_1';
+my $oldnum = '2_11_2';
my $old = 'version_'.$oldnum;
my $oldtopdir = '/home/loncapa_'.$oldnum.'/loncapa/';
my $newtopdir = '/home/loncapa_'.$newnum.'/loncapa/';
my $headdir = '/home/loncapa/';
+if ($newnum eq 'CVS HEAD') {
+ $newtopdir = $headdir;
+}
my (%oldrevs,%newrevs,%changed);
my @scripts = qw(loncnew lond loncron loncontrol);
@@ -26,25 +45,27 @@
open (my $errorlog,">$path/errors.txt");
# Get revision changes;
my $fh;
-&recurse_CVS_Entries($oldtopdir,'',\%oldrevs,$errorlog);
-&recurse_CVS_Entries($newtopdir,'',\%newrevs,$errorlog);
+&recurse_CVS_Entries($oldtopdir,'',\%oldrevs);
+&recurse_CVS_Entries($newtopdir,'',\%newrevs);
foreach my $file (sort(keys(%newrevs))) {
my ($fname) =~ ($file =~ m{/([^/]+)$/});
next if ($file =~ /Attic/);
next if (!(($file =~ /\.p[lm]$/) || (grep/^\Q$fname\E$/, at scripts)));
- if (-e '/home/loncapa_'.$newnum.'/loncapa/'.$file) {
+ if (-e $newtopdir.$file) {
if ($newrevs{$file} ne $oldrevs{$file}) {
$changed{$file} = 1;
}
}
}
+open(my $revchglog,'>',$path.'/revchg_'.$oldnum.'_'.$newnum.'.txt');
open(my $nochglog,'>'.$path.'/unchanged_'.$oldnum.'_'.$newnum.'.txt');
open(my $chglog,'>'.$path.'/changed_'.$oldnum.'_'.$newnum.'.txt');
foreach my $file (sort(keys(%changed))) {
my (%oldmt,%newmt,%oldth,%newth,%oldsplitline,%newsplitline);
next if ($file =~ m{^loncom/localize/localize/});
+ print $revchglog "$file $oldrevs{$file} => $newrevs{$file}\n";
if (open(my $fj, "<$oldtopdir/$file")) {
my $inlt = 0;
my ($openquote,$unterminated);
@@ -115,7 +136,7 @@
if (!defined($newlang{$item})) {
if (defined($headlang{$item})) {
print "$file - ||$item|| in CVS HEAD de.pm\n";
- } else {
+ } elsif ($newnum ne 'CVS HEAD') {
push(@missing,$item);
}
}
@@ -126,7 +147,7 @@
if (!defined($newlang{$item})) {
if (defined($headlang{$item})) {
print "$file - ||$item|| in CVS HEAD de.pm\n";
- } else {
+ } elsif ($newnum ne 'CVS HEAD') {
push(@missing,$item);
}
}
@@ -153,11 +174,15 @@
}
close($chglog);
close($nochglog);
+close($revchglog);
sub recurse_CVS_Entries {
my ($topdir,$path,$revshash) = @_;
my $fh;
- if (open($fh,'<'.$topdir.'/'.$path.'/CVS/Entries')) {
+ my $dirpath = $topdir.'/'.$path;
+ $dirpath =~ s{/+}{/}g;
+ $dirpath =~ s{/$}{};
+ if (open($fh,'<'.$dirpath.'/CVS/Entries')) {
my (@dirs);
while (<$fh>) {
my $line = $_;
@@ -166,8 +191,9 @@
if ($line =~ m{^D/([^/]+)/}) {
push(@dirs,$1);
} elsif ($line =~ m{^/([^/]+)/([^/]+)}) {
+ my ($item,$value) = ($1,$2);
if (ref($revshash) eq 'HASH') {
- $revshash->{$path.'/'.$1} = $2;
+ $revshash->{"$path/$item"} = $value;
}
} else {
print "$path -- $line is unexpected pattern\n";
@@ -178,7 +204,7 @@
&recurse_CVS_Entries($topdir,$path.'/'.$dir,$revshash);
}
} else {
- print "Couldn't open ".$topdir.'/'.$path.'/CVS/Entries'."\n";
+ print "Couldn't open ".$dirpath.'/CVS/Entries'."\n";
}
return;
}
@@ -244,31 +270,33 @@
my ($openquote,$unterminated);
my (undef, at text) = split(/(\&?Apache::lonlocal::|\&)mt\(/,$incoming);
foreach my $item (@text) {
- if ($item =~ /^(['"])([^\1]*?)\1[.,\)]/) {
+ if ($item =~ /^(['"])(?:(?!\1).)+\1[.,\)]/) {
my $sep = $1;
my $other = '"';
if ($sep eq '"') {
$other = "'";
}
- my $phrase = $2;
- if ($phrase =~ /^([^\Q$sep\E]*)([ul]c\()?(\$?[^\Q$sep\E]*)$/) {
- if (ref($strings) eq 'HASH') {
- $strings->{$phrase} = 1;
- }
- } elsif ($item =~ m{\\\Q$sep\E}) {
- my $chgitem = $item;
- $chgitem =~ s/\\\Q$sep\E/<<<<<$other>>>>>/g;
- if ($chgitem =~ /^(\Q$sep\E)([^\Q$sep\E]*?)\Q$sep\E[,\)]/) {
- $phrase = $2;
- $phrase =~ s/<<<<<\Q$other\E>>>>>/\\$sep/g;
+ if ($item =~ /^\Q$sep\E([^$sep]+)\Q$sep\E[.,\)]/) {
+ my $phrase = $1;
+ if ($phrase =~ /^([^\Q$sep\E]*)([ul]c\()?(\$?[^\Q$sep\E]*)$/) {
if (ref($strings) eq 'HASH') {
$strings->{$phrase} = 1;
}
+ } elsif ($item =~ m{\\\Q$sep\E}) {
+ my $chgitem = $item;
+ $chgitem =~ s/\\\Q$sep\E/<<<<<$other>>>>>/g;
+ if ($chgitem =~ /^(\Q$sep\E)([^\Q$sep\E]*?)\Q$sep\E[,\)]/) {
+ $phrase = $2;
+ $phrase =~ s/<<<<<\Q$other\E>>>>>/\\$sep/g;
+ if (ref($strings) eq 'HASH') {
+ $strings->{$phrase} = 1;
+ }
+ }
}
}
- } elsif ($item =~ /^(['"])([^\1]*?)[\r\n\f]$/) {
+ } elsif ($item =~ /^(['"])((?!\1).)*?[\r\n\f]$/) {
$openquote = $1;
- $unterminated = $2;
+ ($unterminated) = ($item =~ /^\Q$openquote\E([^$openquote]*?)[\r\n\f]$/);
}
}
return ($openquote,$unterminated);
More information about the LON-CAPA-cvs
mailing list