Return to metadata_harvest.pl CVS log

Up to [LON-CAPA] / loncom / cgi

Script for most basic metadata harvesting purposes

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