Annotation of loncom/cgi/metadata_keywords.pl, revision 1.1
1.1 ! harris41 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: print "testmsg\n";
! 84: # ------------------------ Loop through database records and print out keywords
! 85: my $sth=$dbh->prepare("select * from metadata");
! 86: $sth->execute();
! 87: my @row;
! 88: while (@row=$sth->fetchrow_array) {
! 89: print 'ROW:'.$row[4]."\n";
! 90: }
! 91:
! 92: # --------------------------------------------------- Close database connection
! 93: $dbh->disconnect();
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>