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;

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.