Return to usage.pl CVS log

Up to [LON-CAPA] / doc / help

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

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.4     ! raeburn    43:     my @order=('author','course','developer','domain');
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');
1.4     ! raeburn    96:     my @domain_usage=&get_usage('domain');
1.3       albertel   97:     if     ($usage) {
                     98: 	&print_unused(\@all_files,[\@author_usage,\@course_usage,
1.4     ! raeburn    99: 				   \@developer_usage,\@domain_usage]);
1.3       albertel  100:     } elsif($build_unused) {
                    101: 	&texxml_unused(\@all_files,[\@author_usage,\@course_usage,
1.4     ! raeburn   102: 				    \@developer_usage,\@domain_usage]);
1.3       albertel  103:     } else {
                    104: 	print("Please specify either --usage or --build-unused\n");
                    105:     }
1.1       albertel  106: }
                    107: 
                    108: &main;