Annotation of loncom/localize/localize/checkduplicates.pl, revision 1.1

1.1     ! bisitz      1: #!/usr/bin/perl
        !             2: # The LearningOnline Network with CAPA
        !             3: # $Id: checkduplicates.pl,v 1.0 2009/04/07 10:49:00 bisitz Exp $
        !             4: 
        !             5: # 07.04.2009 Stefan Bisitz
        !             6: 
        !             7: use strict;
        !             8: use warnings;
        !             9: 
        !            10: my $man = "
        !            11: checkduplicates - Checks if hash keys in translation files occur more than one time. If so, a warning is displayed.
        !            12: 
        !            13: The found keys and corresponding values need to be changed. Otherwise, there is no gurantee which value is taken. This is dangerous, if same keys but different values are used or if one value is changed but the screen still shows the old value which actually comes from the other occurence.
        !            14: 
        !            15: 
        !            16: SYNOPSIS:\tcheckduplicates -h 
        !            17: \t\tcheckduplicates FILE
        !            18: 
        !            19: OPTIONS:
        !            20: -h\t\tDisplay this help and exit.
        !            21: 
        !            22: ";
        !            23: 
        !            24: my $filename; 
        !            25: die "Use option -h for help.\n" unless exists $ARGV[0];
        !            26: #analyze options
        !            27: if ( $ARGV[0] =~ m/^\s*-h/ ) {
        !            28: 	print $man;
        !            29: 	exit();
        !            30: }else{
        !            31: 	$filename = ($ARGV[0]);
        !            32: 	die "$filename is not a file.\n" unless -f $ARGV[0];
        !            33: }
        !            34: 
        !            35: 
        !            36: # ----------------------------------------------------------------
        !            37: # Start Analysis
        !            38: print "checkduplicates is searching for duplicates in $filename...\n";
        !            39: 
        !            40: 
        !            41: # Manually read all stored keys from translation file (inlcuding probable duplicates)
        !            42: my @all_keys;
        !            43: my $line;
        !            44: open( FH, "<", $filename ) or die "$filename cannot be opened\n";
        !            45: while ( !eof(FH) ) {
        !            46:     $line = readline(FH);
        !            47:     next if $line=~/^\s*#/;
        !            48:     #$exprNP=~s/^["'](.*)["']$/$1/; # Remove " and ' at beginning and end
        !            49:     if ($line =~ m/   "(.*)"/) { # Find and save "..." key
        !            50:         push(@all_keys, $1);
        !            51:     } elsif ($line =~ m/   '(.*)'/) { # Find and save '...' key
        !            52:         push(@all_keys, $1);
        !            53:     }
        !            54: }
        !            55: close(FH);
        !            56: 
        !            57: 
        !            58: # Read lexicon hash from translation file into hash
        !            59: my %lexicon = &readlexicon($filename);
        !            60: 
        !            61: 
        !            62: # Synch lexicon hash and Array of keys to find all doublettes
        !            63: # Check for each key in the lexicon hash if this key occures more than one time in the hash file
        !            64: # If found, print warning and count
        !            65: 
        !            66: my $dupl = 0; # total counter to count when a key occurred more than one time
        !            67: my %found; # Hash to save keys which have already been found
        !            68: 
        !            69: foreach my $lex_key (keys %lexicon) {
        !            70:     my $counter = 0;
        !            71:     foreach my $all_key (@all_keys) {
        !            72:         if ($all_key eq $lex_key) {
        !            73:             $counter++;
        !            74:             if ( ($counter > 1) && (!$found{$all_key}) ) {
        !            75:                 $dupl++ if ($counter == 2);
        !            76:                 $found{$all_key} = 1;
        !            77:                 print 'Found duplicate key: '.$lex_key."\n";
        !            78:             }
        !            79:         }
        !            80:     }
        !            81: }
        !            82: if ($dupl == 0) {
        !            83:     print "Be happy - No duplicates found.\n";
        !            84: } else {
        !            85:     print "--- Found $dupl duplicate(s) in $filename which need to be corrected!\n";
        !            86: }
        !            87: 
        !            88: # ----------------------------------------------------------------
        !            89: # Code taken from sync.pl
        !            90: # in : $filename
        !            91: # out: %lexicon
        !            92: 
        !            93: sub readlexicon {
        !            94:     # Read translation file into memory
        !            95:     my $fn=shift;
        !            96:     open(IN,$fn) or die;
        !            97:     my %lexicon=();
        !            98:     my $contents=join('',<IN>);
        !            99:     close(IN);
        !           100:     # Tidy up: remove header data
        !           101:     $contents=~s/package Apache\:[^\;]+//;
        !           102:     $contents=~s/use base[^\;]+//;
        !           103:     # Build hash with hash from file
        !           104:     my %Lexicon=();
        !           105:     eval($contents.'; %lexicon=%Lexicon;');
        !           106:     if ($@ ne "") {
        !           107:         print "\nAn error occurred during the attempt to retrieve the translation hash for the file '$fn'.\n"
        !           108:              ."Error: ".$@."\n";
        !           109:         die;
        !           110:     }
        !           111:     # Remove entries which are not needed for synch
        !           112:     delete $lexicon{'_AUTO'};
        !           113:     delete $lexicon{'char_encoding'};
        !           114:     delete $lexicon{'language_code'};
        !           115:     # Hash is expected not to be empty
        !           116:     if (!scalar(keys(%lexicon))) {
        !           117:         print "\nWarning: No translation phrases found in '$fn'.\n";
        !           118:     }
        !           119:     return %lexicon;
        !           120: }
        !           121: 
        !           122: # ----------------------------------------------------------------
        !           123: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>