File:  [LON-CAPA] / doc / help / usage.pl
Revision 1.4: download - view: text, annotated - select for diffs
Tue Jul 29 21:18:16 2008 UTC (15 years, 9 months ago) by raeburn
Branches: MAIN
CVS tags: version_2_9_X, version_2_9_99_0, version_2_9_1, version_2_9_0, version_2_8_X, version_2_8_99_1, version_2_8_99_0, version_2_8_2, version_2_8_1, version_2_8_0, version_2_7_X, version_2_7_99_1, version_2_7_99_0, version_2_7_1, version_2_7_0, version_2_6_99_1, version_2_12_X, version_2_11_X, version_2_11_4_uiuc, version_2_11_4_msu, version_2_11_4, version_2_11_3_uiuc, version_2_11_3_msu, version_2_11_3, version_2_11_2_uiuc, version_2_11_2_msu, version_2_11_2_educog, version_2_11_2, version_2_11_1, version_2_11_0_RC3, version_2_11_0_RC2, version_2_11_0_RC1, version_2_11_0, version_2_10_X, version_2_10_1, version_2_10_0_RC2, version_2_10_0_RC1, version_2_10_0, loncapaMITrelate_1, language_hyphenation_merge, language_hyphenation, bz6209-base, bz6209, HEAD, GCI_3, GCI_2, GCI_1, BZ4492-merge, BZ4492-feature_horizontal_radioresponse, BZ4492-feature_Support_horizontal_radioresponse, BZ4492-Support_horizontal_radioresponse
- Add domain manual.

    1: #!/usr/bin/perl
    2: use strict;
    3: 
    4: use HTML::TokeParser;
    5: use Getopt::Long;
    6: 
    7: my ($usage,$build_unused) = (0,0);
    8: &GetOptions( "usage"        => \$usage,
    9: 	     "build-unused" => \$build_unused);
   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));
   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;
   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;
   40:     foreach my $file (@{ $all }) {
   41: 	$all{$file}=[];
   42:     }
   43:     my @order=('author','course','developer','domain');
   44:     foreach my $list (@{ $usage }) {
   45: 	foreach my $file (@{ $list }) {
   46: 	    if (exists($all{$file})) { 
   47: 		push(@{$all{$file}},$order[0]);
   48: 	    } else {
   49: 		push(@{$no_exist{$file}},$order[0]);
   50: 	    }
   51: 	}
   52: 	shift(@order);
   53:     }
   54:     print("Usage count for existing Files:\n");
   55:     foreach my $file (sort {uc($a) cmp uc($b)} (keys(%all))) {
   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: 	}
   62:     }
   63:     print("Usage count for nonexistint Files:\n");
   64:     foreach my $file (sort {uc($a) cmp uc($b)} (keys(%no_exist))) {
   65: 	printf("%-50s: %s in %s\n",$file,scalar(@{$no_exist{$file}}),
   66: 	       join(',',@{$no_exist{$file}}));
   67:     }
   68: }
   69: 
   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: 
   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:     my @domain_usage=&get_usage('domain');
   97:     if     ($usage) {
   98: 	&print_unused(\@all_files,[\@author_usage,\@course_usage,
   99: 				   \@developer_usage,\@domain_usage]);
  100:     } elsif($build_unused) {
  101: 	&texxml_unused(\@all_files,[\@author_usage,\@course_usage,
  102: 				    \@developer_usage,\@domain_usage]);
  103:     } else {
  104: 	print("Please specify either --usage or --build-unused\n");
  105:     }
  106: }
  107: 
  108: &main;

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