/[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.74 by bas, Wed Oct 1 14:48:53 2008 UTC revision 1.86 by bas, Sun Oct 5 19:50:38 2008 UTC
# Line 23  Line 23 
23  #  #
24  #  #
25  #  Invocation:  #  Invocation:
26  #    check_trans.pl [-vqdlM] [-C dir] [-p pattern] [-s subtree]  #    check_trans.pl [-cdlvqQ] [-C dir] [-p pattern] [-s subtree]
27  #                   [-m email -n N] [-c charset] [-g] [-t outputtype]  #                   [-m { -n <num> | -M <email> } [-g] ]
28    #                   [-t outputtype]
29  #                   [language]  #                   [language]
30  #  #
31  #  It needs to be run from the top level webwml directory.  #  It needs to be run from the top level webwml directory.
# Line 48  Line 49 
49  #                     default is *.src|*.wml  #                     default is *.src|*.wml
50  #       -s <subtree>  check only that subtree  #       -s <subtree>  check only that subtree
51  #       -a            output age of translation (if older than 2 months)  #       -a            output age of translation (if older than 2 months)
52    #       -c            disable use of color in the output
53  #  #
54  #  Options useful when sending mails:  #  Options useful when sending mails:
55  #       -m <email>    sends mails to translation maintainers  #       -m            sends mails to translation maintainers as specified in
56    #                     in database in $lang/international/$lang/translator.db.pl
57  #                     PLEASE CAREFULLY READ THE BELOW TEXT ABOUT MAKING MAILS!  #                     PLEASE CAREFULLY READ THE BELOW TEXT ABOUT MAKING MAILS!
58  #                     <email> is the default recipient  #       -n <1|2|3>    send mails of priority upper or equal to 1 (monthly),
59  #                     (it should be the list used for organisation,  #                     2 (weekly) or 3 (daily), as specified in the translator
60  #                     e.g. debian-l10n-french@lists.debian.org)  #                     database
61  #       -g            debuG mail send process  #       -M <email>    instead of using the translator database, send all email
62  #       -n <1|2|3>    send mails of priority upper or equal to  #                     the specified address.  The translator database is not
63  #                    1 (monthly), 2 (weekly) or 3 (daily)  #                     used.
64    #       -g            instead of sending mails, dump them to the console
65    #                     (no mails will be sent)
66  #  #
67  #  generating emails  #  GENERATING EMAILS
68  #   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.
69  #   BEWARE, SOME PEOPLE DO NOT LIKE TO RECEIVE AUTOMATIC MAILS!  #   BEWARE, SOME PEOPLE DO NOT LIKE TO RECEIVE AUTOMATIC MAILS!
70  #  #
# Line 67  Line 72 
72  #    You will need one database:  #    You will need one database:
73  #      - one in which to get info about translators and the frequency at  #      - one in which to get info about translators and the frequency at
74  #        which they want to get mails. It must be named  #        which they want to get mails. It must be named
75  #        webwml/$langto/international/$langto/translator.db.pl  #        webwml/$lang/international/$lang/translator.db.pl
76  #        Please refer to the French one for more info.  #        Please refer to the French one for more info.
77  #  #
78  #   USAGE:  #   USAGE:
79  #    If you give the "-g" option, all mails are sent to the default addressee  #    If you give the "-g" option, all mails are written to the console.  No
80  #      (i.e. the one given as value to the -m option), without respect to their  #    mails are sent out at all.  This is useful for debugging.
81  #      normal addressee. It is useful if you want to run it for yourself,  #    If you specify an email addres with the "-M" options, all mails are sent
82  #      and for debugging.  #    to the specified addressee.  No mails are sent to any other addresses.  It
83  #    Without that option, it sends real mails to real addresses.  #    is useful if you want to run it for yourself.
84  #    MAKE SURE THE ADDRESSEES REALLY WANT TO GET THESE MAILS  #    Without either of these options, real mails will be sent to real
85    #    addresses.
86    #    MAKE SURE THE ADDRESSEES REALLY WANT TO GET THESE MAILS!
87    
88  use Getopt::Std;  use Getopt::Std;
89  use File::Basename;  use File::Basename;
# Line 87  use Encode; Line 94  use Encode;
94  use FindBin;  use FindBin;
95  FindBin::again();  FindBin::again();
96    
97  #    These modules reside under webwml/Perl  # These modules reside under webwml/Perl
98  use lib "$FindBin::Bin/Perl";  use lib "$FindBin::Bin/Perl";
99  use Local::VCS ':all';  use Local::VCS ':all';
100  use Local::Util qw/ uniq read_file /;  use Local::Util qw/ uniq read_file /;
# Line 99  use strict; Line 106  use strict;
106  use warnings;  use warnings;
107    
108    
   
 # misc hardcoded things  
 my $MY_EMAIL = q{Debian WWW translation watch <debian-www@lists.debian.org>};  
 my $DEFAULT_PATTERN = '(?:\.wml|\.src)$';  
   
109  # global variable to record verbosity  # global variable to record verbosity
110  my $VERBOSE  = 0;  my $VERBOSE  = 0;
111    
112    # default files to process
113    my $DEFAULT_PATTERN = '(?:\.wml|\.src)$';
114    
115  # status codes  # status codes
116  use constant {  use constant {
117          ST_MISSING     => 1,          ST_MISSING     => 1,
# Line 130  my %COLOURS = ( Line 135  my %COLOURS = (
135          'warn'               => 'bold red',          'warn'               => 'bold red',
136  );  );
137    
138  # these is called in "main" so needs to be declared here  # default values for sending mails
139    my $MY_EMAIL = q{Debian WWW translation watch <debian-www@lists.debian.org>};
140    my $DEFAULT_SUBJECT = q{Debian web page translations needing updates};
141    (my $DEFAULT_BODY = <<"EOF") =~ s/^\t//gm;
142            Hi!
143    
144            This is an automatic message providing an overview of Debian webpages
145            of which the translation is outdated.
146    
147            Kind regards,
148            Your automatic daemon.
149    EOF
150    
151    # these is called in "main" so need to be declared here
152  sub switch_var(\$\$);  sub switch_var(\$\$);
153  sub verbose;  sub verbose;
154    
# Line 138  sub verbose; Line 156  sub verbose;
156  #== "main"  #== "main"
157  #==  #==
158  {  {
159            # install a signal handler to catch Ctrl-C
160            $SIG{'INT'} = \&handle_INT;
161    
162            # parse the command line
163          my ($language,$file_pattern,%OPT) = parse_cmdargs();          my ($language,$file_pattern,%OPT) = parse_cmdargs();
164          my %translators = read_translators( $language, $OPT{m} );  
165            # read the tranlator db if we need it (-n was specified)
166            my %translators = $OPT{n} ? read_translators( $language ) : ();
167    
168            # this hash will be used to store the emails we want to send out
169          my %emails_to_send;          my %emails_to_send;
170    
171          # -s allows the user to restrict processing to a subtree          # the subdirs where the english and translated files are located
172          my $english_path  = 'english';          my $english_path  = 'english';
173          my $language_path = $language;          my $language_path = $language;
174    
175            # -s allows the user to restrict processing to a subtree
176          my $subdir = $OPT{'s'} || undef;          my $subdir = $OPT{'s'} || undef;
177    
178          # Global .transignore          # Global .transignore
# Line 156  sub verbose; Line 183  sub verbose;
183                  'recursive' => 1,                  'recursive' => 1,
184                  'match_pat' => $file_pattern,                  'match_pat' => $file_pattern,
185          );          );
186          # ... and the translation          # ... and in the translation
187          my %translation_revs = vcs_path_info( $language_path,          my %translation_revs = vcs_path_info( $language_path,
188                  'recursive' => 1,                  'recursive' => 1,
189                  'match_pat' => $file_pattern,                  'match_pat' => $file_pattern,
# Line 279  sub verbose; Line 306  sub verbose;
306                          }                          }
307                  }                  }
308    
309                    # print log if requested and an update is needed
310                    if ( $OPT{'l'}  and  $status == ST_NEEDSUPDATE )
311                    {
312                            my $log = get_log(
313                                    $file_orig,
314                                    $rev_transl,
315                                    $revinfo_orig->{'cmt_rev'},
316                            );
317                            print $log;
318                    }
319    
320                  # print diff if requested and an update is needed                  # print diff if requested and an update is needed
321                  if ( $OPT{'d'}  and  $status == ST_NEEDSUPDATE )                  if ( $OPT{'d'}  and  $status == ST_NEEDSUPDATE )
322                  {                  {
# Line 306  sub verbose; Line 344  sub verbose;
344                  # prepare a mail to be sent                  # prepare a mail to be sent
345                  if ( $OPT{'m'}  and  $status != ST_UPTODATE )                  if ( $OPT{'m'}  and  $status != ST_UPTODATE )
346                  {                  {
347                          # handle special case maintainer fields                          # -M was specified, so all mails to there
348                          $maintainer = 'unmaintained'                          if ( $OPT{'M'} )
349                                  unless $maintainer and exists $translators{$maintainer};                          {
350                          $maintainer = 'untranslated'                                  $maintainer = 'default';
351                                  if $status == ST_MISSING;  
352                                    # don't send mail about untranslated files if -q was specified
353                                    $maintainer = 'none'
354                                            if $status == ST_MISSING and $OPT{'q'}
355                            }
356                            else # addresses from the database is used
357                            {
358                                    # handle special case maintainer fields
359                                    $maintainer = 'unmaintained'
360                                            unless $maintainer and exists $translators{$maintainer};
361                                    $maintainer = 'untranslated'
362                                            if $status == ST_MISSING;
363                            }
364    
365                            verbose  "Found maintainer $maintainer for this file";
366    
367                          # mail to send to the maintainer                          # mail to send to the maintainer
368                          push @{ $emails_to_send{$maintainer} }, {                          push @{ $emails_to_send{$maintainer} }, {
# Line 318  sub verbose; Line 370  sub verbose;
370                                  'status'         => $status,                                  'status'         => $status,
371                                  'info'           => $str,                                  'info'           => $str,
372                                  'last_trans_rev' => $rev_transl,                                  'last_trans_rev' => $rev_transl,
373                          }                          };
                         if ( exists $translators{$maintainer} );  
374    
375                          # mail for maxdelta                          # additionally, if -n was specified, also see if we need to
376                          if ( $status != ST_MISSING )                          # send a mail to maxdelta
377                            if ( $OPT{'n'}  and  $status != ST_MISSING  and  -e $file_orig )
378                          {                          {
379                                  $maxdelta ||= $translators{maxdelta}{maxdelta} || 5;                                  $maxdelta ||= $translators{maxdelta}{maxdelta} || 5;
380    
381                                  my $delta = undef;                                  my $delta;
382                                  if ( -e $file_orig )                                  $delta = vcs_count_changes( $file_orig, $rev_transl, 'HEAD' );
                                 {  
                                         $delta = vcs_count_changes( $file_orig, $rev_transl, 'HEAD' );  
383    
384                                    if ( $delta >= $maxdelta )
385                                    {
386                                          push @{ $emails_to_send{'maxdelta'} }, {                                          push @{ $emails_to_send{'maxdelta'} }, {
387                                                  'file'           => $file,                                                  'file'           => $file,
388                                                  'status'         => $status,                                                  'status'         => $status,
# Line 338  sub verbose; Line 390  sub verbose;
390                                                  'delta'          => $delta,                                                  'delta'          => $delta,
391                                                  'last_trans_rev' => $rev_transl,                                                  'last_trans_rev' => $rev_transl,
392                                          }                                          }
                                         if ( $delta >= $maxdelta );  
393                                  }                                  }
394                          }                          }
395    
# Line 346  sub verbose; Line 397  sub verbose;
397    
398          }          }
399    
400          send_email( \%emails_to_send, \%translators, $language, $OPT{'n'}, !$OPT{'g'} );          send_email( \%emails_to_send, \%translators, $language,
401                    $OPT{'n'}, $OPT{'M'}, $OPT{'g'} );
402    
403          exit 0;          exit 0;
404  }  }
# Line 376  sub verbose Line 428  sub verbose
428          print @_, "\n";          print @_, "\n";
429  }  }
430    
431    #=================================================
432    #== handles INT signal
433    #==
434    sub handle_INT
435    {
436            # reset terminal color
437            print color('reset');
438            die( "Interrupted by user" );
439    }
440    
441  #=================================================  #=================================================
442  #== send out the emails  #== send out the emails
# Line 386  sub send_email Line 446  sub send_email
446          my $emails      = shift  or  die("No emails specified");          my $emails      = shift  or  die("No emails specified");
447          my $translators = shift  or  die("No translators specified");          my $translators = shift  or  die("No translators specified");
448          my $lang        = shift  or  die("No language specified");          my $lang        = shift  or  die("No language specified");
449          my $priority    = shift  or  die("No priority specified");          my $priority    = shift;
450          my $really_send = shift || 0;          my $default_rec = shift;
451            my $debug       = shift;
452    
453          foreach my $name (sort keys %$emails)          foreach my $name (sort keys %$emails)
454          {          {
455                    # special case
456                    next if $name eq 'none';
457    
458                  verbose("Preparing email for $name");                  verbose("Preparing email for $name");
459    
460                  # skip unconfigured users                  my $recipient;
461                  if ( not exists $translators->{$name}                  my $subject;
462                       or  not $translators->{$name}{'email'} )                  my $mailbody;
463                  {  
464                          verbose( "Woops!  Can't find info for user `$name'\n" );                  # First handle the case in whcih all mail goes to the -M address
465                          next;                  if ( $default_rec )
466                  }                  {
467                            # address was already validated while parsing the command line
468                            $recipient = $default_rec;
469                            $subject   = $DEFAULT_SUBJECT;
470                            $mailbody  = $DEFAULT_BODY;
471                    }
472                    else # handle the case in whcih addresses are fetch from the db
473                    {
474                            # skip unconfigured users
475                            if ( not exists $translators->{$name}
476                                            or  not $translators->{$name}{'email'} )
477                            {
478                                    verbose( "Woops!  Can't find info for user `$name'\n" );
479                                    next;
480                            }
481    
482                  # check the user's email addres                          # check the user's email addres
483                  if ( not Email::Address->parse( $translators->{$name}{'email'} ) )                          if ( not Email::Address->parse( $translators->{$name}{'email'} ) )
484                  {                          {
485                          printf STDERR "Can't parse email address `%s' for %s!\n",                                  printf STDERR "Can't parse email address `%s' for %s!\n",
486                                  $translators->{$name}{'email'}, $name;                                          $translators->{$name}{'email'}, $name;
487                          next;                                  next;
488                  }                          }
489    
490                  # skip if the user doesn't want a summary at all                          # skip if the user doesn't want a summary at all
491                  if ( $translators->{$name}{'summary'} < $priority )                          if ( $translators->{$name}{'summary'} < $priority )
492                  {                          {
493                          verbose( "Not sending message to $name (prio "                                  verbose( "Not sending message to $name (prio "
494                                  . $translators->{$name}{'summary'} . " < $priority)" );                                          . $translators->{$name}{'summary'} . " < $priority)" );
495                          next;                                  next;
496                  }                          }
497    
498                  my %transl = %{ $translators->{$name} };                          $recipient = $translators->{$name}{'email'};
499                            $subject   = $translators->{'default'}{'mailsubject'};
500    
501                  #print Dumper($emails->{$name});                          # read body and interpret perl that's embedded there
502                            $mailbody = read_file_enc( $translators->{'default'}{'mailbody'} )
503                                    or die("Can't read $translators->{'default'}{'mailbody'}");
504                            {
505                                    # a bit hackish, but I want to keep the curent format of
506                                    # the mail body files intact, for now
507                                    # so we need to use the same old variable names as the original
508                                    # script used
509                                    my %translators = %{$translators};
510                                    $mailbody =~ s{#(.*?)#}{eval $1}mge;
511                            }
512    
513                    }
514    
515                  my $msg = MIME::Lite->new(                  my $msg = MIME::Lite->new(
516                          'From'    => $MY_EMAIL,                          'From'    => $MY_EMAIL,
517                          'To'      => $translators->{$name}{'email'},                          'To'      => $recipient,
518                          'Subject' => $translators->{$name}{'mailsubject'},                          'Subject' => $subject,
519                          'Type'    => 'multipart/mixed',                          'Type'    => 'multipart/mixed',
520                  );                  );
521    
                 # read body and interpret perl that's embedded there  
                 my $body = read_file_enc( $transl{'mailbody'} )  
                         or die("Can't read $transl{'mailbody'}");  
                 {  
                         # a bit hackish, but I want to keep the curent format of  
                         # the mail body files intact, for now  
                         # so we need to use the same old variable names as the original  
                         # script used  
                         my %translators = %{$translators};  
                         $body =~ s{#(.*?)#}{eval $1}mge;  
                 }  
   
522                  # and attach the body to the mail                  # and attach the body to the mail
523                  my $part = MIME::Lite->new(                  my $part = MIME::Lite->new(
524                          'Type' => 'text/plain',                          'Type' => 'text/plain',
525                          'Data' => $body,                          'Data' => encode('utf-8',$mailbody),
526                  );                  );
527                  $part->attr( 'content-type.charset' => 'utf-8' );                  $part->attr( 'content-type.charset' => 'utf-8' );
528                  $msg->attach( $part );                  $msg->attach( $part );
# Line 472  sub send_email Line 550  sub send_email
550                  if $text;                  if $text;
551    
552                  # attach part about Missing files                  # attach part about Missing files
553                  $text = '';                  if ( not $default_rec )
                 foreach my $file ( @{ $emails->{$name} } )  
554                  {                  {
555                          next unless $file->{'status'} == ST_MISSING;                          $text = '';
556                          $text .= sprintf( "%s\n", $file->{'info'} );                          foreach my $file ( @{ $emails->{$name} } )
557                            {
558                                    next unless $file->{'status'} == ST_MISSING;
559                                    $text .= sprintf( "%s\n", $file->{'info'} );
560                            }
561                            $msg->attach(
562                                    'Type'     => 'TEXT',
563                                    'Filename' => 'Missing summary',
564                                    'Data'     => $text,
565                                    'Encoding' => 'quoted-printable',
566                            )
567                            if $text;
568                  }                  }
                 $msg->attach(  
                         'Type'     => 'TEXT',  
                         'Filename' => 'Missing summary',  
                         'Data'     => $text,  
                         'Encoding' => 'quoted-printable',  
                 )  
                 if $text;  
569    
570                  # add diffs, if requested                  # add diffs, if requested
571                  if ( $priority <= $translators->{$name}{'diff'} )                  if ( $default_rec  or  $priority <= $translators->{$name}{'diff'} )
572                  {                  {
573                          foreach my $file ( @{ $emails->{$name} } )                          foreach my $file ( @{ $emails->{$name} } )
574                          {                          {
# Line 513  sub send_email Line 594  sub send_email
594                  }                  }
595    
596                  # add tdiffs, if requested                  # add tdiffs, if requested
597                  if ( $priority <= $translators->{$name}{'tdiff'} )                  if ( not $default_rec  and  $priority <= $translators->{$name}{'tdiff'} )
598                  {                  {
599                          foreach my $file ( @{ $emails->{$name} } )                          foreach my $file ( @{ $emails->{$name} } )
600                          {                          {
# Line 537  sub send_email Line 618  sub send_email
618                  else                  else
619                  {                  {
620                          verbose( "Not attaching tdiffs (prio "                          verbose( "Not attaching tdiffs (prio "
621                                  . $translators->{$name}{'tdiff'} . " < $priority)" );                                  . $translators->{$name}{'tdiff'} . " < $priority)" )
622                            unless $default_rec;
623                  }                  }
624    
625                  # add logs, if requested                  # add logs, if requested
626                  if ( $priority <= $translators->{$name}{'logs'} )                  if ( $default_rec  or  $priority <= $translators->{$name}{'logs'} )
627                  {                  {
628                          foreach my $file ( @{ $emails->{$name} } )                          foreach my $file ( @{ $emails->{$name} } )
629                          {                          {
# Line 569  sub send_email Line 651  sub send_email
651                  }                  }
652    
653                  # add file, if requested                  # add file, if requested
654                  if ( $priority <= $translators->{$name}{'file'} )                  if ( not $default_rec  and  $priority <= $translators->{$name}{'file'} )
655                  {                  {
656                          foreach my $file ( @{ $emails->{$name} } )                          foreach my $file ( @{ $emails->{$name} } )
657                          {                          {
# Line 588  sub send_email Line 670  sub send_email
670                  else                  else
671                  {                  {
672                          verbose( "Not attaching files  (prio "                          verbose( "Not attaching files  (prio "
673                                  . $translators->{$name}{'file'} . " < $priority)" );                                  . $translators->{$name}{'file'} . " < $priority)" )
674                                    unless $default_rec;
675                  }                  }
676    
677    
678    
679                  # check if we really want to send the mail                  # check if we really want to send the mail
680                  if ( $really_send )                  if ( $debug )
681                  {                  {
682                          verbose 'Sending email to ' . $translators->{$name}{'email'};                          print color('bold yellow');
683                          $msg->send  or  warn("Couldn't send message to $name");                          print '*'x72, "\n";
684                            printf "Would send email to %s (but -g was specified):\n",
685                                    $recipient;
686                            print '-'x72, "\n";
687                            print color('reset');
688    
689                            print $msg->as_string;
690    
691                            print color('bold yellow');
692                            print '*'x72, "\n";
693                            print color('reset');
694                  }                  }
695                  else                  else
696                  {                  {
697                          print $msg->as_string;                          verbose "Sending email to $recipient";
698                            $msg->send  or  warn("Couldn't send message to $name");
699                  }                  }
700          }          }
701  }  }
# Line 726  sub show_help Line 820  sub show_help
820          # read the help from the comments above and display it          # read the help from the comments above and display it
821          open( my $me, '<', $0 ) or die "Unable to display help: $!\n";          open( my $me, '<', $0 ) or die "Unable to display help: $!\n";
822    
823          while (<$me>)          while ( my $line = <$me> )
824          {          {
825                  last  if     m{^use};                  last        if     $line =~ m{^use};
826                  next  unless m{^# };                  print "\n"  if     $line =~ m{^#$};
827                    next        unless $line =~ m{^# };
828    
829                  s{^#  ?}{};                  $line =~ s{^#  ?}{};
830    
831                  print;                  print $line;
832          }          }
833    
834          close( $me );          close( $me );
# Line 746  sub show_help Line 841  sub show_help
841  sub parse_cmdargs  sub parse_cmdargs
842  {  {
843          my %OPT;          my %OPT;
         $OPT{n} = 5; # an invalid default  
844          $OPT{s} = '';          $OPT{s} = '';
845    
846          # parse options          # parse options
847          if ( not getopts( 'adghm:n:p:Qqs:TvV', \%OPT )  )          if ( not getopts( 'acdghlmM:n:p:Qqs:TvV', \%OPT )  )
848          {          {
849                  show_help();                  show_help();
850                  exit -1;                  exit -1;
# Line 776  sub parse_cmdargs Line 870  sub parse_cmdargs
870          {          {
871                  # redirect stdout to /dev/null                  # redirect stdout to /dev/null
872                  close( STDOUT );                  close( STDOUT );
873                  open( STDOUT, '>', '/dev/null' )                  open( STDOUT, '>', '/dev/null' )
874                          or die( "Can't redirect STDOUT to /dev/null: $!" );                          or die( "Can't redirect STDOUT to /dev/null: $!" );
875          }          }
876    
877          # handle -s (subtree check) setting          # handle -c (disable color) setting
878          if ( $OPT{s})          if ( $OPT{'c'} )
879          {          {
880                  verbose "Checking subtree $OPT{s} only\n";                  # nice feature of Term::ANSIColor
881                    $ENV{'ANSI_COLORS_DISABLED'} = '1';
882            }
883            else
884            {
885                    # we need flushed STDOUT putput, because otherwise the colours wills
886                    # blend into STDERR
887                    $| = 1;
888          }          }
889    
890          if ( $OPT{'m'}  and  $OPT{'n'} !~ m{^[123]$} )          # handle -s (subtree check) setting
891            if ( $OPT{s})
892          {          {
893                  die "Invalid priority `$OPT{n}'. Please set -n value to 1, 2 or 3.\n"                  verbose "Checking subtree $OPT{s} only\n";
                    ."(assuming you know what you're doing)\n";  
894          }          }
895    
896          # load additional module we need for mail          # check validity of mail options
897            # if -m is specified, either -n or -M must also be given
898            # furthermore, the argument to -n must be 1, 2, or 3, and
899            # the argument to -M must be a valid email address
900          if ( $OPT{'m'} )          if ( $OPT{'m'} )
901          {          {
902                    # load additional module we need for mail
903                  eval {                  eval {
904                          require MIME::Lite;                          require MIME::Lite;
905                          import MIME::Lite;                          import MIME::Lite;
# Line 808  sub parse_cmdargs Line 913  sub parse_cmdargs
913                  };                  };
914                  die "The module Email::Address could not be loaded.\n"                  die "The module Email::Address could not be loaded.\n"
915                     ."Please install libemail-address-perl\n"   if $@;                     ."Please install libemail-address-perl\n"   if $@;
916    
917                    # now check the options
918                    if ( $OPT{'n'} and $OPT{'M'} )
919                    {
920                            die "You can't specify both -n and -M\n";
921                    }
922                    elsif ( $OPT{'n'} )
923                    {
924                            die "Invalid priority `$OPT{n}'. "
925                               ."Please set -n value to 1, 2 or 3.\n"
926                                    unless $OPT{'n'} =~ m{^[123]$}
927                    }
928                    elsif ( $OPT{'M'} )
929                    {
930                            die "Invalid email address `$OPT{M}'\n"
931                                    unless Email::Address->parse( $OPT{M} );
932                    }
933                    else
934                    {
935                            die "You specified -m (send mails), but you didn't specify "
936                               ."either -n or -M, so I don't knwo where to send my mails\n";
937                    }
938    
939          }          }
940    
941          if ( $OPT{'g'} and not $OPT{'m'} )          if ( $OPT{'g'} and not $OPT{'m'} )
# Line 861  sub parse_cmdargs Line 989  sub parse_cmdargs
989  sub read_translators  sub read_translators
990  {  {
991          my $lang = shift or die("Internal error: no language specified");          my $lang = shift or die("Internal error: no language specified");
         my $need_translators = shift;  
992    
993          my %translators;          my %translators;
994    
# Line 890  sub read_translators Line 1017  sub read_translators
1017                                  }                                  }
1018                          }                          }
1019                  }                  }
1020          }          }
1021            else
         if ( $need_translators and not %translators )  
1022          {          {
1023                  die "I need my DBs to send mails !\n"                  die "File `$db_file' doesn't exist!\n"
1024                       ."I need my DBs to send mails.\n"
1025                     ."Please read the comments in the script and try again\n";                     ."Please read the comments in the script and try again\n";
1026          }          }
1027    
# Line 971  sub check_file Line 1098  sub check_file
1098                  else                  else
1099                  {                  {
1100                          # check the revisions to see if they're up to date                          # check the revisions to see if they're up to date
1101                          my $cmp = vcs_cmp_rev( $translation_last_change,                          my $cmp = vcs_cmp_rev( $translation_last_change,
1102                                  $orig_last_change );                                  $orig_last_change );
1103    
1104                          if ( $cmp == 0 ) # revisions equal                          if ( $cmp == 0 ) # revisions equal
# Line 1014  sub check_file Line 1141  sub check_file
1141                          $status = ST_NOTATRANSL;                          $status = ST_NOTATRANSL;
1142                          $str = "NotATranslation $file_translation";                          $str = "NotATranslation $file_translation";
1143                  }                  }
1144                  # otherwise, it has a translation header,                  # otherwise, it has a translation header,
1145                  # so the english file was removed                  # so the english file was removed
1146                  else                  else
1147                  {                  {
# Line 1075  sub get_file_charset Line 1202  sub get_file_charset
1202          return $charset;          return $charset;
1203  }  }
1204    
 # Slurp a file from a particular language in the right encoding  
1205  sub read_file_enc  sub read_file_enc
1206  {  {
1207      my $file = shift or croak("No file specified");      my $file = shift or croak("No file specified");
1208    
1209          my $charset = get_file_charset( $file );          my $charset = get_file_charset( $file );
1210    
1211          # now read the file          return read_file( $file, $charset );
         open( my $fd, '<:bytes', $file ) or return undef;  
         my $text;  
         {  
                 local $/ = undef;  
                 $text = <$fd>;  
         }  
         close( $fd );  
   
         # decode the text  
         $text = decode( $charset, $text );  
   
         return $text;  
1212  }  }
1213    
1214  __END__  __END__
Legend:
Removed from v.1.74  
changed lines
  Added in v.1.86
  ViewVC Help
Powered by ViewVC 1.1.5