Return to rebuildLabelHash.pl CVS log

Up to [LON-CAPA] / doc / help

Previous version didn't work correctly. This should.

    1: #!/usr/bin/perl
    2: 
    3: # The LearningOnline Network with CAPA
    4: # Perl script to rebuild the topic->tex file hash
    5: #
    6: # Copyright Michigan State University Board of Trustees
    7: #
    8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    9: #
   10: # LON-CAPA is free software; you can redistribute it and/or modify
   11: # it under the terms of the GNU General Public License as published by
   12: # the Free Software Foundation; either version 2 of the License, or
   13: # (at your option) any later version.
   14: #
   15: # LON-CAPA is distributed in the hope that it will be useful,
   16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   18: # GNU General Public License for more details.
   19: #
   20: # You should have received a copy of the GNU General Public License
   21: # along with LON-CAPA; if not, write to the Free Software
   22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   23: #
   24: # /home/httpd/html/adm/gpl.txt
   25: #
   26: # http://www.lon-capa.org/
   27: #
   28: # 7-16-2002 Jeremy Bowers
   29: 
   30: use strict;
   31: use GDBM_File;
   32: use File::Spec;
   33: 
   34: # I had to chdir, because neither glob nor bsd_glob accept globs
   35: # with ".." in them... sucky.
   36: chdir "../../loncom/html/adm/help/";
   37: 
   38: # if the topic hash exists, kill it
   39: unlink 'fragmentLabels.gdbm' if ( -e 'fragmentLabels.gdbm' );
   40: print "Wiped old fragmentLabels.gdbm.\n";
   41: 
   42: tie (my %fragmentLabels, 'GDBM_File', 'fragmentLabels.gdbm', 1, 0);
   43: my $error = 0;
   44: 
   45: chdir "tex";
   46: 
   47: foreach my $file ( glob("*.tex") ) 
   48: {
   49:     open F, $file;
   50:     if ( index($file, "/") != "/" )
   51:     {
   52: 	$file = substr($file, index($file, "/") + 1);
   53:     } 
   54:     my $contents = join("\n", <F>);
   55:     my $label;
   56:     
   57:     # Search for labels, of the form '\label{labelname}'
   58:     foreach $label ( $contents =~ /\\label\{([^}]*)\}/g )
   59:     {
   60: 	if (exists $fragmentLabels{$label} )
   61: 	{
   62: 	    print "***ERROR: '$label' in both $fragmentLabels{$label} " .
   63: 	          "and $file. \n";
   64: 	    $error = 1;
   65: 	}
   66: 	$fragmentLabels{$label} = $file;
   67:     }
   68: }
   69: 
   70: if ($error == 0)
   71: {
   72:     print "There were no duplicate labels. Database rebuilt.\n";
   73: }
   74: else
   75: {
   76:     print "There were errors. You must correct the duplicate labels.\n";
   77: }
   78: 
   79: untie %fragmentLabels;