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>