--- doc/help/rebuildLabelHash.pl 2002/07/17 15:47:15 1.2 +++ doc/help/rebuildLabelHash.pl 2011/01/06 18:11:42 1.12 @@ -29,45 +29,119 @@ use strict; use GDBM_File; +use File::Spec; -my $dirprefix = "../../loncom/html/adm/help/"; +my $path = '../../../../../doc/help'; +# I had to chdir, because neither glob nor bsd_glob accept globs +# with ".." in them... sucky. +chdir("../../loncom/html/adm/help/"); # if the topic hash exists, kill it -unlink 'fragmentLabels.gdbm' if ( -e $dirprefix . 'fragmentTopics.gdbm' ); +unlink('fragmentLabels.gdbm') if ( -e 'fragmentLabels.gdbm' ); +print("Wiped old fragmentLabels.gdbm.\n"); -tie (my %fragmentLabels, 'GDBM_File', $dirprefix . 'fragmentLabels.gdbm', 1, 0); +tie (my %fragmentLabels, 'GDBM_File', 'fragmentLabels.gdbm', &GDBM_WRCREAT(), 0660); my $error = 0; -chdir $dirprefix; +chdir("tex"); -while (<*.tex>) -{ - my $file; - $file = $_; - open F, $file; +foreach my $file ( glob("*.tex") ) { + open(F, $file); + if ( index($file, "/") != "/" ) { + $file = substr($file, index($file, "/") + 1); + } my $contents = join("\n", ); - my $label; - + + my $found=0; + my $found_me=0; # Search for labels, of the form '\label{labelname}' - foreach $label ( $contents =~ /\\label\{([^}]*)\}/g ) - { - if (exists $fragmentLabels{$label} ) - { - print "***ERROR: '$label' in both $fragmentLabels{$label} " . - "and $file. \n"; - $error = 1; + foreach my $label ( $contents =~ /\\label\{([^\}]*)\}/g ) { + $found = 1; + if ($file eq "$label.tex") { + $found_me = 1; + } + if (exists($fragmentLabels{$label}) ) { + print("***ERROR: '$label' in both $fragmentLabels{$label} " . + "and $file. \n"); + $error++; } $fragmentLabels{$label} = $file; } + if (!$found) { + $error++; + print("***ERROR: no labels in '$file'. \n"); + } + if (!$found_me) { + $error++; + my ($needed_label) = ($file =~ m/(.*)\.tex/); + print("***ERROR: no labels for $needed_label in '$file'. \n"); + } +} + +if ($error == 0) { + print("There were no duplicate labels. Database rebuilt.\n"); +} else { + print("There were $error errors. You must correct the labels.\n"); + exit(-1); +} + +my $found_ref=0; +foreach my $file ( glob("*.tex") ) { + open(my $fh , '<', $file); + if ( index($file, "/") != "/" ) { + $file = substr($file, index($file, "/") + 1); + } + my $contents; + foreach my $line (<$fh>) { + next if ($line =~ /^%/); + $contents .= $line; + } + my $label; + + + # Search for references, of the form '\ref{labelname}', and whether + # we have logged the associated \label before + foreach my $ref ( $contents =~ /\\ref\{([^\}]*)\}/g ) { + if (!exists($fragmentLabels{$ref}) + && $ref ne 'course.manual.access.hlp' + && $ref ne 'author.manual.access.hlp' + && $ref ne 'domain.manual.access.hlp' + && $ref ne 'course.manual.pdf' + && $ref ne 'author.manual.pdf' + && $ref ne 'domain.manual.pdf') { + $error++; + print("***ERROR: ref $ref in $file doesn't exist in label hash. \n"); + } else { + $found_ref++; + } + } } -if ($error == 0) -{ - print "There were no duplicate labels. Database rebuilt.\n"; +use HTML::TokeParser; +foreach my $manual ('course.manual.texxml','author.manual.texxml','domain.manual.texxml') { + my $p = HTML::TokeParser->new($path.'/'.$manual); + if (!-e $path.'/'.$manual) { + $error++; + print("***ERROR: can't find manual $manual \n"); + } + while (my $token = $p->get_token()) { + if ($token->[0] eq 'S' && $token->[1] eq 'file') { + my $ref = $token->[2]{'name'}; + $ref =~ s/\.tex//; + if (!exists($fragmentLabels{$ref})) { + $error++; + print("***ERROR: ref $ref in $manual doesn't exist in label hash. \n"); + } + } + } } -else -{ - print "There were errors. You must correct the duplicate labels.\n"; + +if ($error == 0) { + print("There were no dangling references. $found_ref were checked.\n"); +} else { + print("There were $error errors. You must correct the dangling references.\n"); + exit(-1); } -untie %fragmentLabels; + +untie(%fragmentLabels);