Return to metadata_keywords.pl CVS log

Up to [LON-CAPA] / loncom / cgi

Annotation of loncom/cgi/metadata_keywords.pl, revision 1.8

1.1       harris41    1: #!/usr/bin/perl
1.6       albertel    2: # Gets keywords from metadata database.
1.8     ! raeburn     3: # $Id: metadata_keywords.pl,v 1.7 2008/11/28 20:50:25 raeburn Exp $
1.6       albertel    4: #
                      5: # Copyright Michigan State University Board of Trustees
                      6: #
                      7: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
1.1       harris41    8: #
1.6       albertel    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.
1.1       harris41   13: #
1.6       albertel   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
1.1       harris41   22: #
1.6       albertel   23: # /home/httpd/html/adm/gpl.txt
1.1       harris41   24: #
1.6       albertel   25: # http://www.lon-capa.org/
1.3       harris41   26: #
1.6       albertel   27: 
1.1       harris41   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
1.3       harris41   47: # Has it been tested? 4
1.1       harris41   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
1.3       harris41   63: 
                     64: 
1.7       raeburn    65: $|=1;
1.1       harris41   66: use strict;
                     67: use DBI;
1.7       raeburn    68: use lib '/home/httpd/lib/perl/';
                     69: use Apache::lonlocal;
                     70: use LONCAPA::Configuration;
                     71: use LONCAPA::loncgi;
1.8     ! raeburn    72: use LONCAPA::lonauthcgi;
1.1       harris41   73: 
                     74: # ---------------------------- Print MIME Content-type and other initialization
                     75: print 'Content-type: text/plain'."\n\n";
                     76: 
1.7       raeburn    77: &main();
                     78: 
                     79: sub main {
1.8     ! raeburn    80:     if (!&LONCAPA::lonauthcgi::check_ipbased_access('metadatakeywords')) {
1.7       raeburn    81:         if (!&LONCAPA::loncgi::check_cookie_and_load_env()) {
                     82:             &Apache::lonlocal::get_language_handle();
                     83:             print(&LONCAPA::loncgi::missing_cookie_msg());
                     84:             return;
                     85:         }
                     86: 
1.8     ! raeburn    87:         if (!&LONCAPA::lonauthcgi::can_view('metadata_keywords')) {
1.7       raeburn    88:             &Apache::lonlocal::get_language_handle();
1.8     ! raeburn    89:             print(&LONCAPA::lonauthcgi::unauthorized_msg('metadata_keywords'));
1.7       raeburn    90:             return;
                     91:         }
                     92:     }
                     93: 
                     94:     &Apache::lonlocal::get_language_handle();
                     95: 
1.1       harris41   96: # --- Make sure that database can be accessed and that this is a library server
                     97: # library server test
1.4       harris41   98: 
                     99: # By default, loncapa_apache.conf is also read by the read_conf subroutine.
1.7       raeburn   100:     my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');
                    101:     my %perlvar=%{$perlvarref};
                    102:     undef($perlvarref);
                    103: 
                    104:     unless ($perlvar{'lonRole'} eq 'library') {
                    105:          print(&Apache::lonlocal::mt('This can only be run on a library server!)."\n");
                    106:          return;
                    107:     }
                    108: 
1.1       harris41  109: # database test
1.7       raeburn   110:     my $dbh;
                    111:     {
                    112:         unless (
                    113:     	        $dbh = DBI->connect("DBI:mysql:loncapa","www",
                    114: 				    $perlvar{'lonSqlAccess'},
                    115: 				    { RaiseError =>0,PrintError=>0})
                    116: 	       ) { 
                    117: 	    print "Cannot connect to database!\n";
                    118: 	    return;
                    119:         }
1.1       harris41  120:     }
1.7       raeburn   121:     %perlvar=(); # undefine it
1.1       harris41  122: 
                    123: # ------------------------ Loop through database records and print out keywords
1.7       raeburn   124:     my $sth=$dbh->prepare("select * from metadata");
                    125:     $sth->execute();
                    126:     my @row;
                    127:     while (@row=$sth->fetchrow_array) {
                    128:         print $row[4]."\n";
                    129:     }
1.1       harris41  130: 
                    131: # --------------------------------------------------- Close database connection
1.7       raeburn   132:     $dbh->disconnect();
                    133:     return;
                    134: }