File:  [LON-CAPA] / loncom / cgi / metadata_harvest.pl
Revision 1.5: download - view: text, annotated - select for diffs
Thu Dec 25 01:56:03 2008 UTC (15 years, 4 months ago) by raeburn
Branches: MAIN
CVS tags: version_2_9_X, version_2_9_99_0, version_2_9_1, version_2_9_0, version_2_8_X, version_2_8_99_1, version_2_8_99_0, version_2_8_2, version_2_8_1, version_2_8_0, version_2_7_99_1, version_2_7_99_0, version_2_12_X, version_2_11_X, version_2_11_4_uiuc, version_2_11_4_msu, version_2_11_4, version_2_11_3_uiuc, version_2_11_3_msu, version_2_11_3, version_2_11_2_uiuc, version_2_11_2_msu, version_2_11_2_educog, version_2_11_2, version_2_11_1, version_2_11_0_RC3, version_2_11_0_RC2, version_2_11_0_RC1, version_2_11_0, version_2_10_X, version_2_10_1, version_2_10_0_RC2, version_2_10_0_RC1, version_2_10_0, loncapaMITrelate_1, language_hyphenation_merge, language_hyphenation, bz6209-base, bz6209, bz5969, bz2851, PRINT_INCOMPLETE_base, PRINT_INCOMPLETE, HEAD, GCI_3, GCI_2, GCI_1, BZ5971-printing-apage, BZ5434-fox, BZ4492-merge, BZ4492-feature_horizontal_radioresponse, BZ4492-feature_Support_horizontal_radioresponse, BZ4492-Support_horizontal_radioresponse
- Changes resulting from movement of subroutines from loncgi.pm
  to lonauthcgi.pm.

    1: #!/usr/bin/perl
    2: # Inserts metadata from .meta files into the mysql database
    3: # $Id: metadata_harvest.pl,v 1.5 2008/12/25 01:56:03 raeburn Exp $
    4: #
    5: # Copyright Michigan State University Board of Trustees
    6: #
    7: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    8: #
    9: # LON-CAPA is free software; you can redistribute it and/or modify
   10: # it under the terms of the GNU General Public License as published by
   11: # the Free Software Foundation; either version 2 of the License, or
   12: # (at your option) any later version.
   13: #
   14: # LON-CAPA is distributed in the hope that it will be useful,
   15: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   16: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   17: # GNU General Public License for more details.
   18: #
   19: # You should have received a copy of the GNU General Public License
   20: # along with LON-CAPA; if not, write to the Free Software
   21: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   22: #
   23: # /home/httpd/html/adm/gpl.txt
   24: #
   25: # http://www.lon-capa.org/
   26: #
   27: 
   28: 
   29: ###############################################################################
   30: ##                                                                           ##
   31: ## ORGANIZATION OF THIS PERL CGI SCRIPT                                      ##
   32: ##                                                                           ##
   33: ## 1. Status of this code                                                    ##
   34: ## 2. Purpose and description of program                                     ##
   35: ## 3. Modules used by this script                                            ##
   36: ## 4. Print MIME Content-type and other initialization                       ##
   37: ## 5. Make sure database can be accessed and that this is a library server   ##
   38: ## 6. Loop through database records and print out keywords                   ##
   39: ##                                                                           ##
   40: ###############################################################################
   41: 
   42: # --------------------------------------------------------- Status of this code
   43: #
   44: # 1=horrible 2=poor 3=fair 4=good 5=excellent
   45: # Organization 5
   46: # Functionality 4
   47: # Has it been tested? 4
   48: #
   49: 
   50: # ------------------------------------------ Purpose and description of program
   51: #
   52: # This program outputs one line per database entry.
   53: # The line is to be a list of keywords separated by commas.
   54: # The file is to be output as a text file on a browser (text/plain).
   55: # This provides initial data by which to study common and uncommon
   56: # keywords being used.
   57: # Note that the authoritative copy of metadata "keywords" is in the
   58: # .meta files that are native to the library server.  We rely
   59: # on the assumption that it is okay to use the MySQL server (which
   60: # should reflect this information) instead.  This is a speedier approach.
   61: 
   62: # ------------------------------------------------- Modules used by this script
   63: 
   64: $|=1;
   65: use strict;
   66: use DBI;
   67: use lib '/home/httpd/lib/perl/';
   68: use Apache::lonlocal;
   69: use LONCAPA::Configuration;
   70: use LONCAPA::loncgi;
   71: use LONCAPA::lonauthcgi;
   72: 
   73: # ---------------------------- Print MIME Content-type and other initialization
   74: print 'Content-type: text/plain'."\n\n";
   75: 
   76: &main();
   77: 
   78: sub main {
   79:     if (!&LONCAPA::lonauthcgi::check_ipbased_access('metadata_harvest')) {
   80:         if (!&LONCAPA::loncgi::check_cookie_and_load_env()) {
   81:             &Apache::lonlocal::get_language_handle();
   82:             print(&LONCAPA::loncgi::missing_cookie_msg());
   83:             return;
   84:         }
   85: 
   86:         if (!&LONCAPA::lonauthcgi::can_view('metadata_harvest')) {
   87:             &Apache::lonlocal::get_language_handle();
   88:             print(&LONCAPA::lonauthcgi::unauthorized_msg('metadata_harvest'));
   89:             return;
   90:         }
   91:     }
   92: 
   93:     &Apache::lonlocal::get_language_handle();
   94: 
   95: # --- Make sure that database can be accessed and that this is a library server
   96: # library server test
   97: 
   98: # By default, loncapa_apache.conf is also read by the read_conf subroutine.
   99:     my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');
  100:     my %perlvar=%{$perlvarref};
  101:     undef($perlvarref);
  102: 
  103:     unless ($perlvar{'lonRole'} eq 'library') {
  104:         print(&Apache::lonlocal::mt('This can only be run on a library server!')."\n");
  105:         return;
  106:     }
  107: # database test
  108:     my $dbh;
  109:     {
  110:         unless (
  111: 	        $dbh = DBI->connect("DBI:mysql:loncapa","www",
  112: 				    $perlvar{'lonSqlAccess'},
  113: 				    { RaiseError =>0,PrintError=>0})
  114: 	        ) { 
  115: 	    print "Cannot connect to database!\n";
  116: 	    return;
  117:         }
  118:     }
  119:     %perlvar=(); # undefine it
  120: 
  121: # ------------------------ Loop through database records and print out keywords
  122:     my $sth=$dbh->prepare("select * from metadata");
  123:     $sth->execute();
  124:     my @row;
  125:     while (@row=$sth->fetchrow_array) {
  126:         for (my $i=0;$i<=$#row;$i++) {
  127:             $row[$i]=~s/\n/ /g;
  128:             $row[$i]=~s/\|/ /g;
  129:         }
  130:         print join('|',@row)."\n";
  131:     }
  132: 
  133: # --------------------------------------------------- Close database connection
  134:     $dbh->disconnect();
  135:     return;
  136: }

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