Annotation of loncom/localize/localize/mtarguments, revision 1.2

1.1       riegler     1: #!/usr/bin/perl
                      2: 
                      3: use strict;
                      4: use warnings;
                      5: 
1.2     ! bisitz      6: my $man = "
        !             7: mtarguments - searches a single file or all files in a directory and its subdirectory for occurence of calls to the subroutine &mt. Arguments of &mt are appended to the file newphrases.txt. In addition, arguments and locations where such calls appear are written to the file newphraseslocations.txt.
1.1       riegler     8: 
                      9: mtarguments is particularly useful for detecting new arguments to mt which consequently need to be translated for non-English users of loncapa. Detection of such arguments is most easily done by comparing newphrases.txt with an earlier version of this file via unix's diff. Detected new phrases can then be incorporated into localization files using sync.pl.
                     10: 
                     11: 
                     12: SYNOPSIS:\tmtarguments -h 
                     13: \t\tmtarguments --path DIR
                     14: \t\tmtarguments FILE
                     15: 
                     16: OPTIONS:
                     17: -h\t\tDisplay this help and exit.
                     18: 
                     19: --path\t\tSearches in all files contained in DIR and its subdirectories.
                     20: ";
                     21: 
                     22: my $path = 0;
                     23: my @files; 
                     24: die "Use option -h for help.\n" unless exists $ARGV[0];
                     25: #analyze options
                     26: if ( $ARGV[0] =~ m/^\s*-h/ ) {
                     27: 	print $man;
                     28: 	exit();
                     29: }elsif( $ARGV[0] =~ m/^\s*--path/ ) {
                     30: 	shift(@ARGV) if exists $ARGV[1] or exit;
                     31: 	$path = $ARGV[0];
                     32: 	die "$path is not a directory.\n" unless -d $path;
                     33: 	@files = recursivefilelist($path);
                     34: }else{
                     35: 	@files = ($ARGV[0]);
                     36: 	die "$files[0] is not a file.\n" unless -f $ARGV[0];
                     37: }
                     38: 
1.2     ! bisitz     39: 
        !            40: # Start Analysis
        !            41: print "mtarguments is searching...\n";
        !            42: 
1.1       riegler    43: # expression for nested parantheses
                     44: my $rep;
                     45: $rep = qr{ \( ((?: (?> [^()]+ )  | (??{ $rep })  )*) \) }x;
                     46: 
                     47: my %mtArgInFile=(); 
                     48: #keys are arguments of &mt, values are filenames (seperated by ,) where 
                     49: #said arguments appear
                     50: 
                     51: foreach my $file(@files){ 
                     52: 	find_mt_arguments($file);
                     53: }
                     54: 
                     55: sub find_mt_arguments{
                     56: 	my $filename = shift;
                     57: 	open(FH,$filename);
                     58: 	while(my $line=<FH>){
                     59: 		next if $line=~/^\s*#/;
                     60: 		if($line=~/[^\w]&?mt$rep/ and $1 ne ''){
                     61: 			my $mtarg = $1;
                     62: 			#if of form '...[_1]...',$var
                     63: 			#get only '...[_1]...' 
                     64: 			$mtarg=~s/('|")\s*,\s*\$.*/$1/;
                     65: 			if($mtArgInFile{$mtarg}){
                     66: 				$mtArgInFile{$mtarg}.=", $filename" 
                     67: 				unless $mtArgInFile{$mtarg}=~$filename;
                     68: 			}else{
                     69: 				$mtArgInFile{$mtarg}.=$filename;
                     70: 			}
                     71: 		}
                     72: 	}
                     73: 	close(FH);
                     74: }
                     75: 
                     76: #write outputfiles
1.2     ! bisitz     77: open(NP,'>>','newphrases.txt'); # Keep existing entries and append new phrases. synch.pl will care about entries which occur more than one time.
1.1       riegler    78: open(NPL,'>','newphraseslocations.txt');
1.2     ! bisitz     79: my $counter=0;
1.1       riegler    80: my $warnings=0;
1.2     ! bisitz     81: my $exprNP="";
1.1       riegler    82: foreach my $expr (sort keys %mtArgInFile){
1.2     ! bisitz     83: 	$exprNP=$expr;
        !            84:         $exprNP=~s/^["'](.*)["']$/$1/; # Remove " and ' at beginning and end for newphrases.txt
        !            85: 	print NP "$exprNP\n";
1.1       riegler    86: 	print NPL "$expr\n\tFOUND IN: $mtArgInFile{$expr}\n";
1.2     ! bisitz     87: 	$counter++;
1.1       riegler    88: 	$warnings++ if($expr=~/\$|@|&/);
                     89: }
1.2     ! bisitz     90: close(NP);
        !            91: print "Wrote newphrases.txt.\n";
1.1       riegler    92: close(NPL);
1.2     ! bisitz     93: print "Wrote newphraseslocations.txt.\n";
        !            94: 
        !            95: print "WARNING: Found $warnings case(s) where argument of &mt contains a perl variable.\n" if $warnings;
        !            96: print "Found $counter new phrases.\n";
1.1       riegler    97: 
                     98: sub recursivefilelist {
                     99: 	my ($currentpath) = @_;
                    100: 	opendir( DIR, $currentpath );
                    101: 	my @filesindir = readdir(DIR);
                    102: 	close(DIR);
                    103: 	my @files;
                    104: 	foreach my $file (@filesindir) {
                    105: 		my $fullfilename = "$currentpath/$file";
                    106: 		if ( $file =~ m/^\.{1,2}$/ ) {
                    107: 			#we are not interested in these (. or ..)
                    108: 		}elsif( -d $fullfilename ) {
                    109: 			push @files, recursivefilelist($fullfilename);
                    110: 		}else{
                    111: 			push @files, $fullfilename;
                    112: 		}
                    113: 	}
                    114: 	return sort(@files);
                    115: }

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