--- doc/help/rebuildLabelHash.pl 2002/07/18 19:57:14 1.3 +++ doc/help/rebuildLabelHash.pl 2007/08/24 23:50:28 1.10 @@ -31,49 +31,113 @@ use strict; use GDBM_File; use File::Spec; +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/"; +chdir("../../loncom/html/adm/help/"); # if the topic hash exists, kill it -unlink 'fragmentLabels.gdbm' if ( -e 'fragmentLabels.gdbm' ); -print "Wiped old fragmentLabels.gdbm.\n"; +unlink('fragmentLabels.gdbm') if ( -e 'fragmentLabels.gdbm' ); +print("Wiped old fragmentLabels.gdbm.\n"); -tie (my %fragmentLabels, 'GDBM_File', 'fragmentLabels.gdbm', 1, 0); +tie (my %fragmentLabels, 'GDBM_File', 'fragmentLabels.gdbm', &GDBM_WRCREAT(), 0660); my $error = 0; -chdir "tex"; +chdir("tex"); -foreach my $file ( glob("*.tex") ) -{ - open F, $file; - if ( index($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') { + $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') { + 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);