File:  [LON-CAPA] / loncom / cgi / metadata_keywords.pl
Revision 1.2: download - view: text, annotated - select for diffs
Tue Sep 25 17:35:03 2001 UTC (22 years, 9 months ago) by harris41
Branches: MAIN
CVS tags: stable_2002_spring, stable_2002_april, stable_2001_fall, HEAD
removing debug messages

    1: #!/usr/bin/perl
    2: #
    3: # The LearningOnline Network with CAPA
    4: #
    5: # Gets keywords from metadata database.
    6: #
    7: # YEAR=2001
    8: # 9/25 Scott Harrison
    9: #
   10: 
   11: ###############################################################################
   12: ##                                                                           ##
   13: ## ORGANIZATION OF THIS PERL CGI SCRIPT                                      ##
   14: ##                                                                           ##
   15: ## 1. Status of this code                                                    ##
   16: ## 2. Purpose and description of program                                     ##
   17: ## 3. Modules used by this script                                            ##
   18: ## 4. Print MIME Content-type and other initialization                       ##
   19: ## 5. Make sure database can be accessed and that this is a library server   ##
   20: ## 6. Loop through database records and print out keywords                   ##
   21: ##                                                                           ##
   22: ###############################################################################
   23: 
   24: # --------------------------------------------------------- Status of this code
   25: #
   26: # 1=horrible 2=poor 3=fair 4=good 5=excellent
   27: # Organization 5
   28: # Functionality 4
   29: # Has it been tested? 3
   30: #
   31: 
   32: # ------------------------------------------ Purpose and description of program
   33: #
   34: # This program outputs one line per database entry.
   35: # The line is to be a list of keywords separated by commas.
   36: # The file is to be output as a text file on a browser (text/plain).
   37: # This provides initial data by which to study common and uncommon
   38: # keywords being used.
   39: # Note that the authoritative copy of metadata "keywords" is in the
   40: # .meta files that are native to the library server.  We rely
   41: # on the assumption that it is okay to use the MySQL server (which
   42: # should reflect this information) instead.  This is a speedier approach.
   43: 
   44: # ------------------------------------------------- Modules used by this script
   45: use strict;
   46: use DBI;
   47: 
   48: # ---------------------------- Print MIME Content-type and other initialization
   49: $|=1;
   50: print 'Content-type: text/plain'."\n\n";
   51: 
   52: # --- Make sure that database can be accessed and that this is a library server
   53: # library server test
   54: my %perlvar;
   55: open (CONFIG,"/etc/httpd/conf/access.conf") || 
   56:     (print "Can't read access.conf\n" && exit);
   57: while (my $configline=<CONFIG>) {
   58:     if ($configline =~ /PerlSetVar/) {
   59: 	my ($dummy,$varname,$varvalue)=split(/\s+/,$configline);
   60:         chomp($varvalue);
   61:         $perlvar{$varname}=$varvalue;
   62:     }
   63: }
   64: close(CONFIG);
   65: unless ($perlvar{'lonRole'} eq 'library') {
   66:     print "This can only be run on a library server!\n";
   67:     exit;
   68: }
   69: # database test
   70: my $dbh;
   71: {
   72:     unless (
   73: 	    $dbh = DBI->connect("DBI:mysql:loncapa","www",
   74: 				$perlvar{'lonSqlAccess'},
   75: 				{ RaiseError =>0,PrintError=>0})
   76: 	    ) { 
   77: 	print "Cannot connect to database!\n";
   78: 	exit;
   79:     }
   80: }
   81: %perlvar=(); # undefine it
   82: 
   83: # ------------------------ Loop through database records and print out keywords
   84: my $sth=$dbh->prepare("select * from metadata");
   85: $sth->execute();
   86: my @row;
   87: while (@row=$sth->fetchrow_array) {
   88:     print $row[4]."\n";
   89: }
   90: 
   91: # --------------------------------------------------- Close database connection
   92: $dbh->disconnect();

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>