#!/usr/bin/perl # The LearningOnline Network with CAPA # Perl script to rebuild the topic->tex file hash # # Copyright Michigan State University Board of Trustees # # This file is part of the LearningOnline Network with CAPA (LON-CAPA). # # LON-CAPA is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # LON-CAPA is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with LON-CAPA; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # # /home/httpd/html/adm/gpl.txt # # http://www.lon-capa.org/ # # 7-16-2002 Jeremy Bowers 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/"); # if the topic hash exists, kill it unlink('fragmentLabels.gdbm') if ( -e 'fragmentLabels.gdbm' ); print("Wiped old fragmentLabels.gdbm.\n"); tie (my %fragmentLabels, 'GDBM_File', 'fragmentLabels.gdbm', &GDBM_WRCREAT(), 0660); my $error = 0; chdir("tex"); foreach my $file ( glob("*.tex") ) { open(F, $file); if ( index($file, "/") != "/" ) { $file = substr($file, index($file, "/") + 1); } my $contents = join("\n", ); my $found=0; my $found_me=0; # Search for labels, of the form '\label{labelname}' 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++; } } } 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"); } } } } 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);