/[webwml]/webwml/check_trans.pl
ViewVC logotype

Diff of /webwml/check_trans.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.13 by french, Thu Dec 21 08:15:07 2000 UTC revision 1.43 by barbier, Thu Sep 27 19:46:48 2001 UTC
# Line 1  Line 1 
1  #!/usr/bin/perl -w  #!/usr/bin/perl -w
2    
3  # This is GPL'ed code, copyright 1998 Paolo Molaro <lupus@debian.org>.  # This is a little utility designed to keep track of translations
4  # Copyright 2000 Martin Quinson <mquinson@ens-lyon.fr>  # in the Debian web site CVS repository.
5    
6  # Little utility to keep track of translations in the debian CVS repo.  # For information about translation revisions please see
7  # Invoke as check_trans.pl [-v] [-d] [-l] [-q] [-s subtree] [language]  # http://www.debian.org/devel/website/uptodate
8  # from the webwml directory, eg:  
9  # $ check_trans.pl -v italian  # This is GPL'ed code.
10    # Copyright 1998 Paolo Molaro <lupus@debian.org>.
11    # Copyright 2000,2001 Martin Quinson <mquinson@ens-lyon.fr>.
12    
13    # Invocation:
14    #   check_trans.pl [-vqdlM] [-C dir] [-p pattern] [-s subtree]
15    #                  [-m email -n N] [-g] [-t outputtype]
16    #                  [language]
17    
18    # It needs to be run from the top level webwml directory.
19    # If you don't specify a language on the command line, the language name
20    # will be loaded from a file called language.conf, if such a file exists.
21    
22    # For example:
23    #   $ check_trans.pl -v italian
24  # You may also check only some subtrees as in:  # You may also check only some subtrees as in:
25  # $ check_trans.pl -s devel italian  #   $ check_trans.pl -s devel italian
26    
27  # Option:  # Options:
28  #       -v      enable verbose mode  #       -v              enable verbose mode
29  #       -Q      enable quiet mode  #       -q              just don't whine about missing files
30  #       -d      output diff  #       -Q              enable really quiet mode
31  #       -l      output log messages  #       -C <dir>        go to <dir> directory before running this script
32  #       -q      don't whine about missing files  #       -d              output CVS diffs
33  #       -p      include only files matching <value>  #       -l              output CVS log messages
34  #       -s      check only subtree <value>  #       -T              output translated diffs
35    #       -p <pattern>    include only files matching <pattern>,
36  # Options usefull when sending mails:  #                       default is *.html|*.wml
37  #       -g      debuG  #       -s <subtree>    check only that subtree
38  #       -m      makes mails to translation maintainers  #       -t <type>       choose output type  (default is `text')
39  #               PLEASE READ CARFULLY THE TEXT BELOW ABOUT MAKING MAILS !!  #       -M              display differences for all 'Makefile's
40  #               (if -m is given, it must be followed by the default recipient)  
41  #               (it should be the list used for organisation)  # Options useful when sending mails:
42  #               (I sent it to debian-l10n-french@lists.debian.org)  #       -m <email>      sends mails to translation maintainers
43  #       -n      send mails of priority upper or equal to <value>  #                       PLEASE CAREFULLY READ THE BELOW TEXT ABOUT MAKING MAILS!
44  #               (ie, <value> must be 1 (monthly), 2 (weekly) or 3 (daily)  #                       <email> is the default recipient
45    #                       (it should be the list used for organisation,
46    #                       e.g. debian-l10n-french@lists.debian.org)
47    #       -g              debuG
48    #       -n <1|2|3>      send mails of priority upper or equal to
49    #                       1 (monthly), 2 (weekly) or 3 (daily)
50    
51  # Making Mails  # Making Mails
52  #  If you want to, this script send mails to the maintainer of the mails.  #  If you want to, this script send mails to the maintainer of the mails.
53  #  BEWARE, SOME PEOPLE DO NOT LIKE TO RECEIVE AUTOMATIC MAILS !!  #  BEWARE, SOME PEOPLE DO NOT LIKE TO RECEIVE AUTOMATIC MAILS!
54  #  PREQUESITE:  
55  #  o To do so, you need two databases:  #  PREREQUISITES:
56  #     - one to see which translator maintains which file  #   You will need two databases:
57    #     - one in which to see which translator maintains which file
58  #       it must be named "./$langto/international/$langto/current_status.pl"  #       it must be named "./$langto/international/$langto/current_status.pl"
59  #         with $langto equal to "french", "italian" or so  #       (where $langto equals "french", "italian" or so)
60  #       Please refer to "webwml/french/international/french/current_status.pl"  #       See webwml/french/international/french/current_status.pl" for example.
61  #        to have an example  #     - one in which to get info about translators and the frequency at
62  #     - one to get info about translators and the frequency at which they want to get  #       which they want to get mails. It must be named
63  #       mails. It must be named "webwml/$langto/international/$langto/translator.db.pl"  #       webwml/$langto/international/$langto/translator.db.pl
64  #       Please refer to the french one for more info  #       Please refer to the French one for more info.
 #  o You must also have the perl module called "MIME::Lite", which is not yet packaged.  
 #      You can download it from your favorite CPAN...  
 #  USAGE:  
 #   - If you give the "-g" option, all mails are sent to the "default addressee"  
 #     (ie, the one given as value to the -m option), without respect to their  
 #      normal addressee. It is usefull if you want to run it for your own,  
 #      and for debugging.  
 #   - With out it, it sends real mails to real addresses.  
 #     BE SURE THE ADDRESSEES REALLY WANT TO GET THESE MAILS  
   
 # If you do not specify a language on the command line, it will try to load  
 # one from a file called language.conf, if such a file exists. That file  
 # should contain one line naming the language subdirectory to check.  
   
 # Translators need to embed in the files they translate a comment  
 # in its own line with the revision of the file they translated such as:  
 # #use wml::debian::translation-check translation="revision"  
 # (Old form <!--translation revision--> works too.)  
 # The revision can be obtained from the CVS/Entries files or from  
 # the command "cvs status filename".  
65    
66  # TODO:  #  USAGE:
67  # need to quote dirnames?  #   If you give the "-g" option, all mails are sent to the default addressee
68  # use a file to bind a file to a translator?  #     (i.e. the one given as value to the -m option), without respect to their
69    #     normal addressee. It is useful if you want to run it for yourself,
70    #     and for debugging.
71    #   Without that option, it sends real mails to real addresses.
72    #   MAKE SURE THE ADDRESSEES REALLY WANT TO GET THESE MAILS
73    
74    use strict;
75  use Getopt::Std;  use Getopt::Std;
76  use IO::Handle;  use IO::Handle;
77  use strict;  use Date::Parse;
78    
79  # options  #    These modules reside under webwml/Perl
80  our $opt_d = 0;  use lib ($0 =~ m|(.*)/|, $1 or ".") ."/Perl";
81  our $opt_s = '';  use Local::Cvsinfo;
82  our $opt_p = undef;  use Local::WmlDiffTrans;
83  our $opt_l = 0;  use Webwml::TransCheck;
84  our $opt_g = 0;  use Webwml::TransIgnore;
 our $opt_m = '';  
 our $opt_n = 5;  
 our $opt_v;  
 our $opt_q;  
 our $opt_Q;  
   
 # languages  
 my $defaultlanguage;  
 my $from;  
 my $to;  
 my $langto;  
85    
86  # from db  # TODO:
87    # get the revisions from $lang/intl/$lang so diffing works
88    # need to quote dirnames?
89    # use a file to bind a file to a translator?
90    
91    # global db variables
92  my $translations_status;  my $translations_status;
93  my $translators;# the ref resulting of require  my $translators;# the ref resulting of require
94  my %translators;# the real hash  my %translators;# the real hash
95    
96  # misc  # misc hardcoded things
97  my @en; #english files  my $maintainer = "mquinson\@ens-lyon.fr"; # the default e-mail at which to bitch :-)
98  my $showlog; # boolean  
99  #$maintainer = "debian-www\@lists.debian.org"; #adress of maintainer of this script  # options (note: with perl 5.6, this could change to our())
100  my $maintainer = "mquinson\@ens-lyon.fr"; #adress of maintainer of this script  use vars qw($opt_C $opt_M $opt_Q $opt_d $opt_g $opt_l $opt_m $opt_n $opt_p $opt_q $opt_s $opt_t $opt_T $opt_v);
101    $opt_n = 5; # an invalid default
102    $opt_s = '';
103    $opt_C = '.';
104    $opt_t = 'text';
105    
106    unless (getopts('vgdqQC:m:s:Tt:p:ln:M'))
107    {
108            open SELF, "<$0" or die "Unable to display help: $!\n";
109            HELP: while (<SELF>)
110            {
111                    print, next if /^$/;
112                    last HELP if (/^use/);
113                    s/^# ?//;
114                    next if /^!/;
115                    print;
116            }
117            exit;
118    }
119    
120  getopts('vgdqQm:s:p:ln:');  die "you can't have both verbose and quiet, doh!\n" if (($opt_v) && ($opt_Q));
121    
122  warn "Checking subtree $opt_s only\n" if $opt_v;  warn "Checking subtree $opt_s only\n" if (($opt_v) && ($opt_s));
123    
124  # include only files matching $filename  # include only files matching $filename
125  my $filename = $opt_p || '(\.wml$)|(\.html$)';  my $filename = $opt_p || '(\.wml$)|(\.html$)';
126    
127  # get configuration  # Go to desired directory
128    chdir($opt_C) || die "Cannot go to $opt_C\n";
129    
130    my $cvs = Local::Cvsinfo->new();
131    $cvs->options(
132            recursive => 1,
133            matchfile => [ $filename ],
134            skipdir   => [ "template" ],
135    );
136    #   This object is used to retrieve information when original is
137    #   not English
138    my $altcvs = $cvs->new();
139    
140    #   Global .transignore
141    my $globtrans = Webwml::TransIgnore->new(".");
142    
143    # language configuration
144    my $defaultlanguage = 'italian';
145  if (open CONF, "<language.conf")  if (open CONF, "<language.conf")
146  {  {
147          $defaultlanguage = <CONF>;          $defaultlanguage = <CONF>;
148          chomp $defaultlanguage;          chomp $defaultlanguage;
149          close CONF;          close CONF;
150  }  }
 else  
 {  
         $defaultlanguage = 'italian';  
 }  
151    
152  $from = 'english';  my $from = 'english';
153  $to = shift || $defaultlanguage;  my $to = shift || $defaultlanguage;
154    $to =~ s%/$%%; # Remove slash from the end
155    
156  # Remove slash from end  my $langto = $to;
 $to =~ s%/$%%;  
   
 $langto=$to;  
157  $langto =~ s,^([^/]*).*$,$1,;  $langto =~ s,^([^/]*).*$,$1,;
158  if (-e "./$langto/international/$langto/current_status.pl" &&  if (-e "./$langto/international/$langto/current_status.pl" &&
159      -e "./$langto/international/$langto/translator.db.pl") {      -e "./$langto/international/$langto/translator.db.pl") {
# Line 142  if (-e "./$langto/international/$langto/ Line 170  if (-e "./$langto/international/$langto/
170  }  }
171    
172  if ($opt_m) {  if ($opt_m) {
     use MIME::Lite;  
173      unless ($opt_n =~ m,[123],) {      unless ($opt_n =~ m,[123],) {
174          die "Invalid priority. Please set -n value to 1, 2 or 3.\n".          die "Invalid priority. Please set -n value to 1, 2 or 3.\n".
175              "(assuming you know what you're doing)\n";              "(assuming you know what you're doing)\n";
# Line 152  if ($opt_m) { Line 179  if ($opt_m) {
179  $from = "$from/$opt_s";  $from = "$from/$opt_s";
180  $to = "$to/$opt_s";  $to = "$to/$opt_s";
181    
182  @en= split(/\n/, `find $from -name Entries -print`);  init_mails();
183    
184  $showlog = $opt_l;  print "\$translations = {\n" if $opt_t eq 'perl';
185    
186  init_mails();  $cvs->readinfo($from);
187  foreach (@en) {  foreach my $path (@{$cvs->dirs()}) {
188          next if $_ =~ "template/debian";          my $tpath = $path;
189          my ($path, $tpath, $d);          $tpath =~ s/^$from/$to/o;
190            my $transignore = Webwml::TransIgnore->new($tpath);
191            next unless $transignore->found();
192            warn "Loading $tpath/.transignore\n" if $opt_v;
193            foreach (@{$transignore->local()}) {
194                    s/^$to/$from/o;
195                    $cvs->removefile($_);
196            }
197    }
198    
199    foreach (sort @{$cvs->files()}) {
200            my ($path, $tpath);
201          $path = $_;          $path = $_;
         $path =~ s,CVS/Entries$,,;  
202          $tpath = $path;          $tpath = $path;
203          $tpath =~ s/^$from/$to/o;          $tpath =~ s/^$from/$to/o;
204          my %d = %{load_entries($_)};          check_file($tpath,
205          my $ignore = load_ignorelist($tpath);                  $cvs->revision($path),
206          foreach my $f (keys %{$d{"rev"}}) {                  str2time($cvs->date($path)),
207              check_file("${tpath}$f",                  get_translators_from_db($tpath));
                        $d{"rev"}->{$f},  
                        get_translators_from_db("$tpath$f"))  
                 unless $$ignore{"${tpath}$f"};  
         }  
208  }  }
209    
210    print "}; 1;\n" if $opt_t eq 'perl';
211    
212  send_mails();  send_mails();
213    
214    if ($opt_M) {
215            foreach my $makefile (split(/\n/, `find $from -name Makefile -print`)) {
216                    my $destination = $makefile;
217                    $destination =~ s/^$from/$to/o;
218                    if (-e $destination) {
219                            STDOUT->flush;
220                            system("diff -u $destination $makefile");
221                            STDOUT->flush;
222                    }
223            }
224    }
225    
226  sub verify_send {  sub verify_send {
227        return 1 unless ($opt_m);
228      # returns true whether we have to send this part to this guy      # returns true whether we have to send this part to this guy
229      my $name=shift;      my $name=shift;
230      my $part=shift;      my $part=shift;
# Line 190  sub verify_send { Line 238  sub verify_send {
238          && ($opt_n <= $translators{$name}{$part}); # check if the frequency is ok          && ($opt_n <= $translators{$name}{$part}); # check if the frequency is ok
239  }  }
240    
   
   
241  sub get_translators_from_db {  sub get_translators_from_db {
242      my $id=shift;      my $id=shift;
243      my $res='';      my $res='';
# Line 211  sub get_translators_from_db { Line 257  sub get_translators_from_db {
257    
258  sub init_mails {  sub init_mails {
259      return unless $opt_m;      return unless $opt_m;
260        eval q{use MIME::Lite};
261      foreach my $name (keys %translators) {      foreach my $name (keys %translators) {
262          return if defined $translators{$name}{"msg"};          return if defined $translators{$name}{"msg"};
263          $translators{$name}{"msg"} = MIME::Lite->new(          $translators{$name}{"msg"} = MIME::Lite->new(
264             From    => "Script watching translation state <$maintainer>",             From    => "Script watching translation state <$maintainer>",
265             To      => ($opt_g ? $opt_m : $translators{$name}{"email"}),             To      => ($opt_g ? $opt_m : $translators{$name}{"email"}),
266             Subject => ($name eq "list" ?             Subject => ($name eq "list" ?
267              "Translations for the debian web site unmaintained" :              "Translations for the Debian web site unmaintained" :
268              "Translations for the debian web site maintained by $name"              "Translations for the Debian web site maintained by $name"
269              ),              ),
270             Type    => 'multipart/mixed');             Type    => 'multipart/mixed');
271          my $str= "Hello,\n".          my $str= "Hello,\n".
272                "This is a automatically generated mail sent to you\n".                "This is an automatically generated mail sent to you\n".
273                "because you are the official translator of some pages\n".                "because you are the official translator of some pages\n".
274                "in $langto of the Debian web site.\n".                "in ".ucfirst($langto)." of the Debian web site.\n".
275                "\n".                "\n".
276                "I send you what I think you want. (ie what is in my DB).\n".                "I sent you what I think you want. (i.e. what is in my DB).\n".
277                " That is to say:\n";                " That is to say:\n";
278          foreach my $n (qw(summary logs diff file)) {          foreach my $n (qw(summary logs diff tdiff file)) {
279              $str.="   ".$n.": ".              $str.="   ".$n.": ".
280              ($translators{$name}{$n} != 0 ?              ($translators{$name}{$n} != 0 ?
281               ($translators{$name}{$n} != 1 ?               ($translators{$name}{$n} != 1 ?
# Line 259  sub init_mails { Line 306  sub init_mails {
306                "    - The list of the work to do in a summarized form\n".                "    - The list of the work to do in a summarized form\n".
307                "    - diff between the version you translated and the current one\n".                "    - diff between the version you translated and the current one\n".
308                "    - log between the version you translated and the current one\n".                "    - log between the version you translated and the current one\n".
309                "    - the file you translated (to avoid to download it before to work)\n".                "    - the file you translated (so that you don't have to download it manually)\n".
310                "  - your email adress\n".                "  - your email address\n".
311                "  - the compression level (none,gzip or bzip2), even if I'll ignore it\n".                "  - the compression level (none, gzip or bzip2), even if I'll ignore it\n".
312                "    because this feature is not implemented yet ;)\n".                "    because this feature is not implemented yet ;)\n".
313                "\n".                "\n".
314                "For more informations, contact your team coordinator, or\n".                "For more information, contact your team coordinator, or\n".
315                "the maintainer of this script ($maintainer).\n".                "the maintainer of this script ($maintainer).\n".
316                "\n".                "\n".
317                "Thanks, and sorry for the annoyance.\n";                "Thanks, and sorry for the annoyance.\n";
# Line 290  sub send_mails { Line 337  sub send_mails {
337                       Filename => 'Missing_summary',                       Filename => 'Missing_summary',
338                       Data     => $translators{$name}{"part_missing"})                       Data     => $translators{$name}{"part_missing"})
339              if defined($translators{$name}{"part_missing"});              if defined($translators{$name}{"part_missing"});
340          foreach my $part (qw (file logs diff)) {          foreach my $part (qw (file logs diff tdiff)) {
341              if (defined($translators{$name}{"part_$part"})) {              if (defined($translators{$name}{"part_$part"})) {
342                  foreach my $file (sort keys %{$translators{$name}{"part_$part"}}) {                  foreach my $file (sort keys %{$translators{$name}{"part_$part"}}) {
343                      $translators{$name}{"msg"}->attach(                      $translators{$name}{"msg"}->attach(
# Line 309  sub send_mails { Line 356  sub send_mails {
356  #           $translators{$name}{"msg"}->print_header;  #           $translators{$name}{"msg"}->print_header;
357              $translators{$name}{"msg"}->send;              $translators{$name}{"msg"}->send;
358          } else {          } else {
359              print "don't send mail to $name : nothing to say to him\n";              print "didn't send mail to $name: nothing to say to him\n";
360          }          }
361      }      }
 }  
   
 sub load_entries {  
         my ($name) = shift;  
         my (%data);  
         warn "Loading $name\n" if ($opt_v && !$opt_q);  
         open(F, $name) || die $!;  
         while(<F>) {  
                 next unless m,^/,;  
                 if ( m,^/([^/]+)/([^/]+)/, ) {  
                         my($name, $rev) =($1, $2);  
                         $data{"rev"}->{$name} = $rev if $name =~ /$filename/o;  
                 }  
         }  
         close (F);  
         return \%data;  
 }  
   
 sub load_ignorelist {  
         my ($dir) = shift;  
         my (%data);  
         open(F, "${dir}.transignore") || return \%data;  
         warn "Loading ${dir}.transignore\n" if $opt_v;  
         while(<F>) {  
                 chomp;  
                 $data{"$dir$_"} = 1;  
         }  
         close (F);  
         return \%data;  
362  }  }
363    
364  sub add_part {  sub add_part {
# Line 354  sub add_part { Line 372  sub add_part {
372          $translators{$name}{"send"}=1;          $translators{$name}{"send"}=1;
373      }      }
374  }  }
375    
376  sub add_sub_part {  sub add_sub_part {
377      my $name = shift;      my $name = shift;
378      my $part = shift;      my $part = shift;
379      my $subpart=shift;      my $subpart=shift;
380      my $cmd = shift;      my $txt = shift;
381      $name =~ s,<.*?>,,;      $name =~ s,<.*?>,,;
382      $name =~ s,^ *(.*?) *$,$1,;      $name =~ s,^ *(.*?) *$,$1,;
383  #    print "add_sub_part($name)(part=$part)($subpart):";  #    print "add_sub_part($name)(part=$part)($subpart):$txt" if $opt_v;
384        STDOUT->flush;
385      if (verify_send($name,$part)) {      if (verify_send($name,$part)) {
386  #       print "YES\n";  #       print "YES\n";
387          $translators{$name}{"part_$part"}{$subpart}.=`$cmd`;          $translators{$name}{"part_$part"}{$subpart}.= "$txt";
388          $translators{$name}{"send"}=1;          $translators{$name}{"send"}=1;
 #       return;  
389      }      }
390  #    print "no\n";  #    print "no\n";
391  }  }
   
392    
393    sub get_diff_txt {
394      my ($oldr, $revision, $oldname, $name) = @_;
395      my $cmd;
396    
397      # Get old revision file
398      $cmd = "cvs -z3 update -r $oldr -p $oldname 2>/dev/null";
399    #  print "!get_diff_txt: cvs -z3 update -r ".$oldr." -p ".$oldname."\n";
400      my @old_rev_file_lines = qx($cmd);
401    
402      # Get translation file
403      open (FILE,"$name") || die ("Can't open `$name' for read");
404      my @translation_file_lines;
405      while (<FILE>) {
406          $translation_file_lines[scalar @translation_file_lines] = $_;
407      }
408      close FILE || die ("Can't close $name after reading");
409    
410      # Get diff lines
411      $cmd = "cvs -z3 diff -u -r$oldr -r $revision $oldname 2>/dev/null";
412    #  print "get_diff_txt: $cmd: cvs -z3 diff -u -r$oldr -r $revision $oldname\n";
413      my @diff_lines = qx($cmd);
414    
415      my $txt = Local::WmlDiffTrans::find_trans_parts(\@old_rev_file_lines,
416                                                      \@translation_file_lines,
417                                                      \@diff_lines);
418    
419      return $txt;
420    }
421    
422  sub check_file {  sub check_file {
423          my ($name, $revision, $translator) = @_;          my ($name, $revision, $mtime, $translator) = @_;
424          my ($oldr, $oldname);          my ($oldr, $oldname, $original);
425          warn "Checking $name english revision $revision\n" if $opt_v;          warn "Checking $name, English revision $revision\n" if $opt_v;
426            my $docname = $name;
427            $docname =~ s#^$langto/##;
428            $docname =~ s#\.wml$##;
429          unless (-r $name) {          unless (-r $name) {
430                  unless ($opt_q) {                  (my $iname = $name) =~ s/^$to\///;
431                       print "Missing $name version $revision\n"                  if (!$globtrans->is_global($iname)) {
432                          unless $opt_Q;                    unless (($opt_q) || ($opt_Q)) {
433                         if ($opt_t eq 'perl') {
434                           print "'$docname' => {\n\t'type' => 'Web',\n";
435                           print "\t'revision' => '$revision',\n";
436                           print "\t'mtime' => '$mtime',\n";
437                           print "\t'status' => 1,\n";
438                           print "},\n";
439                         } else {
440                           print "Missing $name version $revision\n";
441                         }
442                       add_part("list","missing","Missing $name version $revision\n");                       add_part("list","missing","Missing $name version $revision\n");
443                      }
444                    } else {
445                      warn "Ignored $name\n" if $opt_v;
446                  }                  }
447                  return;                  return;
448          }          }
449          open(F, $name) || die $!;          my $transcheck = Webwml::TransCheck->new($name);
450          while(<F>) {          $oldr = $transcheck->revision() || 0;
451                  if (/translation(\s+|=")([.0-9]*)("|\s*-->)/oi) {          if (!$oldr && ($name =~ m#$langto/international/$langto#i)) {
452                          warn "Found revision $2\n" if $opt_v;                  #   This document is original, check for
453                          $oldr = $2;                  #   english/international/$langto...
454                  }                  $name =~ s{^$to}{$from};
455                  if (/wml::debian::translation-check.*?maintainer(\s+|=")(.*)("|\s*-->)/oi) {                  $transcheck = Webwml::TransCheck->new($name);
456                      warn "Translated by $2\n" if $opt_v;                  $oldr       = $transcheck->revision() || 0;
457                      $translator=$2 if ($translator eq "");          }
458                  }          $translator = $transcheck->maintainer() || "";
459                  if (/Translat(.*?): (.*)$/i) {          $original   = $transcheck->original();
460                      warn "Translated by $2\n" if $opt_v;          warn "Found translation for $oldr\n" if $opt_v and $oldr;
461                      $translator=$2 if ($translator eq "");          warn "Translated by $translator\n"   if $opt_v and $translator;
462                  }          warn "Original is $original\n"       if $opt_v and $original;
463            if ($original) {
464                    my ($fromname, $fromdir);
465                    $fromname = $name;
466                    $fromname =~ s{^[^/]+}{$original};
467                    $fromdir  = $fromname;
468                    $fromdir  =~ s{/+[^/]+$}{};
469                    $altcvs->reset();
470                    $altcvs->readinfo($fromdir, matchfile => [$fromname]);
471                    $revision = $altcvs->revision($fromname);
472                    warn "Original is $original, revision $revision\n" if $opt_v;
473          }          }
         close(F);  
         return if (defined($oldr) && ($oldr eq $revision));  
474    
475          $translator =~ s/^\s*(.*?)\s*/$1/;          $translator =~ s/^\s+//;
476            $translator =~ s/\s+$//;
477    
478          $oldr ||= '1.1';          my $str;
479          my $str  = "NeedToUpdate $name from version $oldr to version $revision";          my $status = 8;
480            (my $numrev)  = $revision =~ m/^1\.(\d+)$/; $numrev ||= "0";
481            (my $numoldr) = $oldr =~ m/^1\.(\d+)$/; $numoldr ||= "0";
482            if (!$oldr) {
483              $oldr = '1.1';
484              $str = "Unknown status of $name (revision should be $revision)";
485            } elsif ($oldr eq $revision) {
486              $status = 4;
487            } elsif ($numoldr > $numrev) {
488              $str = "Broken revision number $oldr for $name, it should be $revision";
489            } else {
490              $str = "NeedToUpdate $name from version $oldr to version $revision";
491              $status = 3;
492            }
493          $str .= " (maintainer: $translator)" if $translator;          $str .= " (maintainer: $translator)" if $translator;
494          $str .= "\n";          if ($opt_t eq 'perl') {
495          print $str unless $opt_Q;            print "'$docname' => {\n\t'type' => 'Web',\n";
496              print "\t'revision' => '$revision',\n";
497              print "\t'mtime' => '$mtime',\n";
498              print "\t'base_revision' => '$oldr',\n";
499              print "\t'translation_maintainer' => ['$translator'],\n" if $translator;
500              print "\t'status' => $status,\n";
501              print "},\n";
502            } elsif ($str && $oldr ne $revision) {
503              $str .= "\n";
504              print $str unless ($opt_Q);
505            }
506    
507            return if (defined($oldr) && ($oldr eq $revision));
508    
509          $oldname = $name;          $oldname = $name;
510          $oldname =~ s/^$to/$from/;          $oldname =~ s/^$to/$from/;
511    
512            my @logrev = split(/\./, $oldr);
513            $logrev[$#logrev] ++;
514            my $logoldr = join('.', @logrev);
515    
516          if ($opt_m) {          if ($opt_m) {
517              $translator = "list" if ($translator eq "");              $translator = "list" if ($translator eq "");
518              add_part($translator,"summary",$str);              add_part($translator,"summary",$str);
519              add_sub_part($translator,"diff",$name,              add_sub_part($translator,"diff",$name,
520                           "cvs -z3 diff -u -r'$oldr' -r '$revision' '$oldname'");                   join("",qx(cvs -z3 diff -u -r'$oldr' -r $revision $oldname)));
521                add_sub_part($translator,"tdiff",$name,
522                     get_diff_txt("$oldr","$revision","$oldname","$name"));
523    
524              add_sub_part($translator,"logs",$name,              add_sub_part($translator,"logs",$name,
525                           "cvs -z3 log -r'$oldr:$revision' '$oldname'");                   join("",qx(cvs -z3 log -r$logoldr:$revision $oldname)));
526              add_sub_part($translator,"file",$name,              add_sub_part($translator,"file",$name,
527                           "cat $name");                   join("",qx(cat $name)));
528          }          }
529    
530          if ($opt_d) {          if ($opt_d) {
531                  STDOUT->flush;                  STDOUT->flush;
532                  system("cvs -z3 log -r'$oldr:$revision' '$oldname'") if $showlog;                  my $cvsline = "cvs -z3 log -r'$logoldr:$revision' '$oldname'";
533                  STDOUT->flush if $showlog;                  warn "Running $cvsline\n" if (($opt_v) && ($opt_l));
534                  system("cvs -z3 diff -u -r '$oldr' -r '$revision' '$oldname'");                  system($cvsline) if $opt_l;
535                    STDOUT->flush if $opt_l;
536                    $cvsline = "cvs -z3 diff -u -r '$oldr' -r '$revision' '$oldname'";
537                    warn "Running $cvsline\n" if $opt_v;
538                    system($cvsline);
539                  STDOUT->flush;                  STDOUT->flush;
540          }          }
 }  
   
   
   
541    
542            if ($opt_T) {
543                print get_diff_txt("$oldr", "$revision", "$oldname", "$name")."\n";
544            }
545    }
Legend:
Removed from v.1.13  
changed lines
  Added in v.1.43
  ViewVC Help
Powered by ViewVC 1.1.5