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 (16 years, 3 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_5_msu,
version_2_11_5,
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.
#!/usr/bin/perl
use strict;
use HTML::TokeParser;
use Getopt::Long;
my ($usage,$build_unused) = (0,0);
&GetOptions( "usage" => \$usage,
"build-unused" => \$build_unused);
sub get_all_files {
my $dir="../../loncom/html/adm/help/tex/";
opendir(DIR,$dir);
my @files=sort {uc($a) cmp uc($b)} (readdir(DIR));
my @realfiles;
foreach my $file (@files) {
if ($file eq '.' || $file eq '..' || $file eq 'CVS' ||
$file eq 'Latex_Footer.tex' || $file eq 'Latex_Header.tex') {next;}
push(@realfiles,$file);
}
return @realfiles;
}
sub get_usage {
my ($which)=@_;
my @files;
my $p = HTML::TokeParser->new("$which.manual.texxml");
while (my $token = $p->get_token()) {
if ($token->[0] eq 'S' && $token->[1] eq 'file') {
push(@files,$token->[2]{'name'});
}
}
return @files;
}
sub print_unused {
my ($all,$usage)=@_;
my %all;
my %no_exist;
foreach my $file (@{ $all }) {
$all{$file}=[];
}
my @order=('author','course','developer','domain');
foreach my $list (@{ $usage }) {
foreach my $file (@{ $list }) {
if (exists($all{$file})) {
push(@{$all{$file}},$order[0]);
} else {
push(@{$no_exist{$file}},$order[0]);
}
}
shift(@order);
}
print("Usage count for existing Files:\n");
foreach my $file (sort {uc($a) cmp uc($b)} (keys(%all))) {
if (scalar(@{ $all{$file} }) ne 0) {
printf("%-50s: %s in %s\n",$file,scalar(@{$all{$file}}),
join(',',@{$all{$file}}));
} else {
printf("%-50s: %s\n",$file,scalar(@{$all{$file}}));
}
}
print("Usage count for nonexistint Files:\n");
foreach my $file (sort {uc($a) cmp uc($b)} (keys(%no_exist))) {
printf("%-50s: %s in %s\n",$file,scalar(@{$no_exist{$file}}),
join(',',@{$no_exist{$file}}));
}
}
sub texxml_unused {
my ($all,$usage)=@_;
my %all;
foreach my $file (@{ $all }) {$all{$file}='1';}
foreach my $list (@{ $usage }) {
foreach my $file (@{ $list }) {
if (exists($all{$file})) {
delete($all{$file});
}
}
}
print("<texxml>\n");
print("<title name=\"Unused files\" />\n");
foreach my $file (sort {uc($a) cmp uc($b)} (keys(%all))) {
print("<section name=\"$file\">\n");
print("<file name=\"$file\">\n");
print("</section>\n");
}
print("</texxml>\n");
}
sub main {
my @all_files=&get_all_files();
my @author_usage=&get_usage('author');
my @course_usage=&get_usage('course');
my @developer_usage=&get_usage('developer');
my @domain_usage=&get_usage('domain');
if ($usage) {
&print_unused(\@all_files,[\@author_usage,\@course_usage,
\@developer_usage,\@domain_usage]);
} elsif($build_unused) {
&texxml_unused(\@all_files,[\@author_usage,\@course_usage,
\@developer_usage,\@domain_usage]);
} else {
print("Please specify either --usage or --build-unused\n");
}
}
&main;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>