From 2f1e9d1051ca02638786019e218e45abc3eb6795 Mon Sep 17 00:00:00 2001 From: Bas Zoetekouw Date: Fri, 19 Dec 2008 23:06:25 +0000 Subject: Rool back last change: I have lots more local changes that shouldn't have been committed CVS version numbers check_trans.pl: 1.90 -> 1.91 --- check_trans.pl | 83 +++++++++++----------------------------------------------- 1 file changed, 15 insertions(+), 68 deletions(-) (limited to 'check_trans.pl') diff --git a/check_trans.pl b/check_trans.pl index 3957e203c4d..f0f74bf868e 100755 --- a/check_trans.pl +++ b/check_trans.pl @@ -47,7 +47,6 @@ # -T output translated diffs # -p include only files matching , # default is *.src|*.wml -# -r dump raw output to the specified file # -s check only that subtree # -a output age of translation (if older than 2 months) # -c disable use of color in the output @@ -91,7 +90,7 @@ use File::Basename; use File::Spec::Functions; use Term::ANSIColor; use Encode; -use Data::Dumper; +#use Data::Dumper; use FindBin; FindBin::again(); @@ -114,7 +113,6 @@ my $VERBOSE = 0; my $DEFAULT_PATTERN = '(?:\.wml|\.src)$'; # status codes -# careful: these numbers are also used in stat_trans.pl! use constant { ST_MISSING => 1, ST_NEEDSUPDATE => 3, @@ -177,9 +175,6 @@ sub verbose; # -s allows the user to restrict processing to a subtree my $subdir = $OPT{'s'} || undef; - # -r dumps raw output to the specified file - my $rawfile = $OPT{'r'} || undef; - # Global .transignore my $transignore = Webwml::TransIgnore->new( vcs_get_topdir ); @@ -187,20 +182,19 @@ sub verbose; my %english_revs = vcs_path_info( $english_path, 'recursive' => 1, 'match_pat' => $file_pattern, - 'skip_pat' => '^template/', + 'skip_pat' => '^template/' ); # ... and in the translation my %translation_revs = vcs_path_info( $language_path, 'recursive' => 1, 'match_pat' => $file_pattern, - 'skip_pat' => '^template/', + 'skip_pat' => '^template/' ); # construct a list with all files that either occur in english or # in the translation my @files = uniq ( keys %english_revs, keys %translation_revs ); - my %result; # now check each of the files foreach my $file (sort @files) @@ -276,10 +270,8 @@ sub verbose; switch_var( $revinfo_orig, $revinfo_transl ); } } - } - # skip original files (i.e., most of the english originals) - next if ( $file_transl eq $file_orig ); + } # determine the status of the file my ($status,$str,$rev_transl,$maintainer,$maxdelta) = check_file( @@ -288,47 +280,6 @@ sub verbose; $revinfo_orig, $revinfo_transl, ); - $result{$file} = { - status => $status, - str => $str, - rev_transl => $rev_transl, - date_transl => $revinfo_transl->{'cmt_date'}, - maintainer => $maintainer, - maxdelta => $maxdelta, - file_orig => $file_orig, - file_transl => $file_transl, - rev_orig => $revinfo_orig->{'cmt_rev'}, - }; - - } - - - if ( $rawfile ) - { - require Storable; - - verbose( "Dumping output to `$rawfile'\n" ); - - open( my $fd, '>', $rawfile ) or die("Couldn't open `$rawfile': $!\n"); - Storable::store_fd( \%result, $fd ) or die("Couldn't dump results to file\n"); - close( $fd ); - - # don't output anything else - exit 0; - } - - # now output the results - foreach my $file ( sort keys %result ) - { - my $status = $result{$file}->{status}; - my $str = $result{$file}->{str}; - my $rev_transl = $result{$file}->{rev_transl}; - my $date_transl = $result{$file}->{date_transl}; - my $maintainer = $result{$file}->{maintainer}; - my $maxdelta = $result{$file}->{maxdelta}; - my $file_orig = $result{$file}->{file_orig}; - my $file_transl = $result{$file}->{file_transl}; - my $rev_orig = $result{$file}->{rev_orig}; ###################################################################### ## Everything below is just output logic @@ -347,7 +298,7 @@ sub verbose; # check age of the translation if ( $OPT{a} and $status == ST_NEEDSUPDATE ) { - my $age = int get_revision_age( $date_transl ); + my $age = int get_revision_age( $revinfo_transl ); # only warn if the translation is older than 2 weeks if ( $age > 14 ) @@ -363,7 +314,7 @@ sub verbose; my $log = get_log( $file_orig, $rev_transl, - $rev_orig + $revinfo_orig->{'cmt_rev'}, ); print $log; } @@ -374,7 +325,7 @@ sub verbose; my $diff = get_diff( $file_orig, $rev_transl, - $rev_orig + $revinfo_orig->{'cmt_rev'}, ); print $diff; } @@ -385,7 +336,7 @@ sub verbose; my $diff = get_diff_txt( $file_orig, $rev_transl, - $rev_orig, + $revinfo_orig->{'cmt_rev'}, $file_transl ); print $diff; @@ -570,13 +521,10 @@ sub send_email 'Type' => 'multipart/mixed', ); - die("Couldn't create mail message (MIME::Lite missing?)\n") unless $msg; - # and attach the body to the mail my $part = MIME::Lite->new( 'Type' => 'text/plain', 'Data' => encode('utf-8',$mailbody), - #'Data' => $mailbody, ); $part->attr( 'content-type.charset' => 'utf-8' ); $msg->attach( $part ); @@ -740,9 +688,9 @@ sub send_email print '-'x72, "\n"; print color('reset'); - my $txt = $msg->as_string; + # make sure perl doesn't do any annoying charset conversions binmode( \*STDOUT, ':bytes' ); - print $txt; + print $msg->as_string; print color('bold yellow'); print '*'x72, "\n"; @@ -762,10 +710,11 @@ sub send_email #== sub get_revision_age { - my $rev_timestamp = shift; + my $rev_info = shift; - die("No revision date specified") unless $rev_timestamp; + die("No revision info specified") unless ref $rev_info eq 'HASH'; + my $rev_timestamp = $rev_info->{'cmt_date'}; my $age = time - $rev_timestamp; warn( "Timestamp is in the future!" ) if $age < 0; @@ -899,7 +848,7 @@ sub parse_cmdargs $OPT{s} = ''; # parse options - if ( not getopts( 'acdghlmM:n:p:Qqr:s:TvV', \%OPT ) ) + if ( not getopts( 'acdghlmM:n:p:Qqs:TvV', \%OPT ) ) { show_help(); exit -1; @@ -1243,14 +1192,12 @@ sub get_file_charset { while ( my $line = <$fd> ) { - next if $line =~ m{^#}; + next if $line =~ m{^[#%]}; next unless $line =~ m{CHARSET=(.*?)\s*$}; $charset = $1; last; } close($fd); - - verbose "using charset `$charset' for file `$file'"; } else { -- cgit v1.2.3