Annotation of loncom/cgi/metadata_keywords.pl, revision 1.2
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: # ------------------------ 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) {
1.2 ! harris41 88: print $row[4]."\n";
1.1 harris41 89: }
90:
91: # --------------------------------------------------- Close database connection
92: $dbh->disconnect();
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>