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

1.1     ! wenzelju    1: #!/usr/bin/perl
        !             2: # The LearningOnline Network with CAPA
        !             3: # $Id: checksimilar_1file.pl,v 1.1 2010/03/09 16:15:00 wenzelju Exp $
        !             4: 
        !             5: use strict;
        !             6: use warnings;
        !             7: 
        !             8: ####
        !             9: #### Checks, if there are similar keys in the inputfile (for example de.pm)
        !            10: ####
        !            11: 
        !            12: 
        !            13: 
        !            14: ####--------Subroutines--------####
        !            15: 
        !            16: 
        !            17: 
        !            18: sub read {
        !            19:     # Read file into memory
        !            20:     my $fn = shift;
        !            21:     open(IN,$fn) or die;
        !            22:     my %filecontent = ();
        !            23:     my $contents = join('',<IN>);
        !            24:     close(IN);
        !            25:     # Build hash with hash from file
        !            26:     my %Lexicon=();
        !            27:     eval($contents.'; %filecontent=%Lexicon;');
        !            28: 
        !            29:     return %filecontent;
        !            30: }
        !            31: 
        !            32: sub similarities{
        !            33:    my $text = shift;
        !            34:    $text =~ s/[.,\_\-?!:]//g;
        !            35: 
        !            36:    return $text;
        !            37: }
        !            38: 
        !            39: 
        !            40: 
        !            41: 
        !            42: ####--------Main programm--------####
        !            43: 
        !            44: 
        !            45: my $file = $ARGV[0];
        !            46: my %lang=&read($file);
        !            47: my $count = 0;
        !            48: #Copy hash for comparision
        !            49: my %lang2=%lang;
        !            50: my %sim;
        !            51: 
        !            52: #For each key in the hash compare it with each other key in the hash except itself
        !            53: while( my ($kOUT, $vOUT) = each %lang ) {
        !            54: 
        !            55:    #Delete the current key, so that it does not find itself
        !            56:    #(revert this action later, see below) 
        !            57:    delete $lang2{$kOUT};
        !            58:    my $temp = $kOUT;
        !            59:    $temp = &similarities($temp);
        !            60:    
        !            61:    while( my ($kIN, $vIN) = each %lang2 ) {
        !            62:       my $temp2 = $kIN;
        !            63:       $temp2 = &similarities($temp2);
        !            64:          #Print key, if it has similarity to another key and if it has not been checked already
        !            65:          if(lc($temp) eq lc($temp2) && !($sim{$kOUT})){
        !            66:             print ('###'.$kOUT."###".$kIN."###\n");
        !            67:             #Remeber key as already checked
        !            68:             $sim{$kIN} = $kOUT; 
        !            69:             $count++;
        !            70:          }
        !            71:    }
        !            72: 
        !            73:    $lang2{$kOUT}=$vOUT;
        !            74: }
        !            75: print("Finished. ".$count." similar keys found.\n");
        !            76: 

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