| 1 |
#!/usr/bin/perl -w
|
| 2 |
|
| 3 |
# This script perform changes in WML source files and bump version
|
| 4 |
# number when translated files are up to date.
|
| 5 |
|
| 6 |
use strict;
|
| 7 |
use Getopt::Long;
|
| 8 |
|
| 9 |
# These modules reside under webwml/Perl
|
| 10 |
use lib ($0 =~ m|(.*)/|, $1 or ".") ."/Perl";
|
| 11 |
use Local::Cvsinfo;
|
| 12 |
use Webwml::TransCheck;
|
| 13 |
use Webwml::Langs;
|
| 14 |
|
| 15 |
our ($opt_h, $opt_v, @opt_l, @opt_s);
|
| 16 |
|
| 17 |
sub usage {
|
| 18 |
print <<'EOT';
|
| 19 |
Usage: smart_change.pl [options] origfile
|
| 20 |
Options:
|
| 21 |
-h, --help display this message
|
| 22 |
-v, --verbose run verbosely
|
| 23 |
-l, --lang=STRING process this language (may be used more than once)
|
| 24 |
-s, --substitute=REGEXP
|
| 25 |
Perl regexp applied to source files
|
| 26 |
(may be used more than once)
|
| 27 |
EOT
|
| 28 |
exit(0);
|
| 29 |
}
|
| 30 |
|
| 31 |
if (not Getopt::Long::GetOptions(qw(
|
| 32 |
h|help
|
| 33 |
v|verbose
|
| 34 |
l|lang=s@
|
| 35 |
s|substitute=s@
|
| 36 |
))) {
|
| 37 |
warn "Try `$0 --help' for more information.\n";
|
| 38 |
exit(1);
|
| 39 |
}
|
| 40 |
|
| 41 |
$opt_h && usage;
|
| 42 |
|
| 43 |
sub verbose {
|
| 44 |
print STDERR $_[0] . "\n" if $opt_v;
|
| 45 |
}
|
| 46 |
|
| 47 |
# We call constructor without argument. It means there must be a
|
| 48 |
# CVS/Repository file or program will abort.
|
| 49 |
if (not @opt_l) {
|
| 50 |
my $l = Webwml::Langs->new();
|
| 51 |
@opt_l = $l->names();
|
| 52 |
}
|
| 53 |
|
| 54 |
my $argfile = $ARGV[0] or die "Invalid number of arguments";
|
| 55 |
$argfile =~ m+^(english.*)/(.*\.wml)+ or die "pattern does not match";
|
| 56 |
my ($path, $file) = ($1, $2);
|
| 57 |
|
| 58 |
my $eval_opt_s = '1';
|
| 59 |
foreach (@opt_s) {
|
| 60 |
$eval_opt_s .= "; $_";
|
| 61 |
}
|
| 62 |
verbose("-s flags: $eval_opt_s");
|
| 63 |
my $substitute = eval "sub { \$_ = shift; $eval_opt_s; die \$@ if \$@; return \$_}";
|
| 64 |
die "Invalid -s option" if $@;
|
| 65 |
|
| 66 |
my $cvs = Local::Cvsinfo->new();
|
| 67 |
$cvs->options(matchfile => [ $file ]);
|
| 68 |
$cvs->readinfo($path);
|
| 69 |
my $origrev = $cvs->revision($argfile) || "1.0";
|
| 70 |
verbose("Original revision: $origrev");
|
| 71 |
|
| 72 |
my $nextrev = $origrev;
|
| 73 |
$nextrev =~ s/(\d+)$/(1+$1)/e;
|
| 74 |
verbose("Next revision: $nextrev");
|
| 75 |
|
| 76 |
foreach my $lang (@opt_l) {
|
| 77 |
my $transfile = $argfile;
|
| 78 |
$transfile =~ s/^english/$lang/ || next;
|
| 79 |
next unless -f $transfile;
|
| 80 |
verbose("Now checking $transfile");
|
| 81 |
|
| 82 |
# Parse the translated file
|
| 83 |
my $transcheck = Webwml::TransCheck->new($transfile);
|
| 84 |
next unless $transcheck->revision();
|
| 85 |
my $langrev = $transcheck->revision();
|
| 86 |
|
| 87 |
my $origtext = '';
|
| 88 |
my $transtext = '';
|
| 89 |
open (TRANS, "< $transfile");
|
| 90 |
while (<TRANS>) {
|
| 91 |
$origtext .= $_;
|
| 92 |
if (m/^#use wml::debian::translation-check/ &&
|
| 93 |
($langrev eq $origrev || $langrev eq $nextrev)) {
|
| 94 |
# Also check for $nextrev in case this script
|
| 95 |
# is run several times
|
| 96 |
s/(translation="?)($origrev|$nextrev)("?)/$1$nextrev$3/;
|
| 97 |
verbose("Bump version number to $nextrev");
|
| 98 |
}
|
| 99 |
$transtext .= &$substitute($_);
|
| 100 |
}
|
| 101 |
close (TRANS);
|
| 102 |
if ($origtext ne $transtext) {
|
| 103 |
open (TRANS, "> $transfile");
|
| 104 |
print TRANS $transtext;
|
| 105 |
close (TRANS);
|
| 106 |
}
|
| 107 |
}
|
Parent Directory
| 
Revision Log