Return to usage.pl CVS log

Up to [LON-CAPA] / doc / help

Annotation of doc/help/usage.pl, revision 1.3

1.1       albertel    1: #!/usr/bin/perl
                      2: use strict;
                      3: 
                      4: use HTML::TokeParser;
                      5: use Getopt::Long;
                      6: 
1.3     ! albertel    7: my ($usage,$build_unused) = (0,0);
        !             8: &GetOptions( "usage"        => \$usage,
        !             9: 	     "build-unused" => \$build_unused);
1.1       albertel   10: 
                     11: sub get_all_files {
                     12:     my $dir="../../loncom/html/adm/help/tex/";
                     13:     opendir(DIR,$dir);
                     14:     my @files=sort {uc($a) cmp uc($b)} (readdir(DIR));
1.3     ! albertel   15:     my @realfiles;
        !            16:     foreach my $file (@files) {
        !            17: 	if ($file eq '.' || $file eq '..' || $file eq 'CVS' ||
        !            18: 	    $file eq 'Latex_Footer.tex' || $file eq 'Latex_Header.tex') {next;}
        !            19: 	push(@realfiles,$file);
        !            20:     }
        !            21:     return @realfiles;
1.1       albertel   22: }
                     23: 
                     24: sub get_usage {
                     25:     my ($which)=@_;
                     26:     my @files;
                     27:     my $p = HTML::TokeParser->new("$which.manual.texxml");
                     28:     while (my $token = $p->get_token()) {
                     29: 	if ($token->[0] eq 'S' && $token->[1] eq 'file') {
                     30: 	    push(@files,$token->[2]{'name'});
                     31: 	}
                     32:     }
                     33:     return @files;
                     34: }
                     35: 
                     36: sub print_unused {
                     37:     my ($all,$usage)=@_;
                     38:     my %all;
                     39:     my %no_exist;
1.3     ! albertel   40:     foreach my $file (@{ $all }) {
        !            41: 	$all{$file}=[];
        !            42:     }
1.2       albertel   43:     my @order=('author','course','developer');
1.1       albertel   44:     foreach my $list (@{ $usage }) {
                     45: 	foreach my $file (@{ $list }) {
1.2       albertel   46: 	    if (exists($all{$file})) { 
                     47: 		push(@{$all{$file}},$order[0]);
                     48: 	    } else {
                     49: 		push(@{$no_exist{$file}},$order[0]);
                     50: 	    }
1.1       albertel   51: 	}
1.2       albertel   52: 	shift(@order);
1.1       albertel   53:     }
                     54:     print("Usage count for existing Files:\n");
                     55:     foreach my $file (sort {uc($a) cmp uc($b)} (keys(%all))) {
1.2       albertel   56: 	if (scalar(@{ $all{$file} }) ne 0) {
                     57: 	    printf("%-50s: %s in %s\n",$file,scalar(@{$all{$file}}),
                     58: 		   join(',',@{$all{$file}}));
                     59: 	} else {
                     60: 	    printf("%-50s: %s\n",$file,scalar(@{$all{$file}}));
                     61: 	}
1.1       albertel   62:     }
                     63:     print("Usage count for nonexistint Files:\n");
                     64:     foreach my $file (sort {uc($a) cmp uc($b)} (keys(%no_exist))) {
1.2       albertel   65: 	printf("%-50s: %s in %s\n",$file,scalar(@{$no_exist{$file}}),
                     66: 	       join(',',@{$no_exist{$file}}));
1.1       albertel   67:     }
                     68: }
                     69: 
1.3     ! albertel   70: sub texxml_unused {
        !            71:     my ($all,$usage)=@_;
        !            72:     my %all;
        !            73:      foreach my $file (@{ $all }) {$all{$file}='1';}
        !            74:     foreach my $list (@{ $usage }) {
        !            75: 	foreach my $file (@{ $list }) {
        !            76: 	    if (exists($all{$file})) { 
        !            77: 		delete($all{$file});
        !            78: 	    }
        !            79: 	}
        !            80:     }
        !            81:     print("<texxml>\n");
        !            82:     print("<title name=\"Unused files\" />\n");
        !            83:     foreach my $file (sort {uc($a) cmp uc($b)} (keys(%all))) {
        !            84: 	print("<section name=\"$file\">\n");
        !            85: 	print("<file name=\"$file\">\n");
        !            86: 	print("</section>\n");
        !            87:     }
        !            88:     print("</texxml>\n");
        !            89: }
        !            90: 
1.1       albertel   91: sub main {
                     92:     my @all_files=&get_all_files();
                     93:     my @author_usage=&get_usage('author');
                     94:     my @course_usage=&get_usage('course');
                     95:     my @developer_usage=&get_usage('developer');
                     96: 
1.3     ! albertel   97:     if     ($usage) {
        !            98: 	&print_unused(\@all_files,[\@author_usage,\@course_usage,
        !            99: 				   \@developer_usage]);
        !           100:     } elsif($build_unused) {
        !           101: 	&texxml_unused(\@all_files,[\@author_usage,\@course_usage,
        !           102: 				    \@developer_usage]);
        !           103:     } else {
        !           104: 	print("Please specify either --usage or --build-unused\n");
        !           105:     }
1.1       albertel  106: }
                    107: 
                    108: &main;