version 1.1, 2001/09/25 17:30:00
|
version 1.7, 2008/11/28 20:50:25
|
Line 1
|
Line 1
|
#!/usr/bin/perl |
#!/usr/bin/perl |
|
# Gets keywords from metadata database. |
|
# $Id$ |
# |
# |
# The LearningOnline Network with CAPA |
# Copyright Michigan State University Board of Trustees |
# |
# |
# Gets keywords from metadata database. |
# This file is part of the LearningOnline Network with CAPA (LON-CAPA). |
|
# |
|
# LON-CAPA is free software; you can redistribute it and/or modify |
|
# it under the terms of the GNU General Public License as published by |
|
# the Free Software Foundation; either version 2 of the License, or |
|
# (at your option) any later version. |
|
# |
|
# LON-CAPA is distributed in the hope that it will be useful, |
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|
# GNU General Public License for more details. |
|
# |
|
# You should have received a copy of the GNU General Public License |
|
# along with LON-CAPA; if not, write to the Free Software |
|
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA |
|
# |
|
# /home/httpd/html/adm/gpl.txt |
# |
# |
# YEAR=2001 |
# http://www.lon-capa.org/ |
# 9/25 Scott Harrison |
|
# |
# |
|
|
|
|
############################################################################### |
############################################################################### |
## ## |
## ## |
## ORGANIZATION OF THIS PERL CGI SCRIPT ## |
## ORGANIZATION OF THIS PERL CGI SCRIPT ## |
Line 26
|
Line 44
|
# 1=horrible 2=poor 3=fair 4=good 5=excellent |
# 1=horrible 2=poor 3=fair 4=good 5=excellent |
# Organization 5 |
# Organization 5 |
# Functionality 4 |
# Functionality 4 |
# Has it been tested? 3 |
# Has it been tested? 4 |
# |
# |
|
|
# ------------------------------------------ Purpose and description of program |
# ------------------------------------------ Purpose and description of program |
Line 42
|
Line 60
|
# should reflect this information) instead. This is a speedier approach. |
# should reflect this information) instead. This is a speedier approach. |
|
|
# ------------------------------------------------- Modules used by this script |
# ------------------------------------------------- Modules used by this script |
|
|
|
|
|
$|=1; |
use strict; |
use strict; |
use DBI; |
use DBI; |
|
use lib '/home/httpd/lib/perl/'; |
|
use Apache::lonlocal; |
|
use LONCAPA::Configuration; |
|
use LONCAPA::loncgi; |
|
|
# ---------------------------- Print MIME Content-type and other initialization |
# ---------------------------- Print MIME Content-type and other initialization |
$|=1; |
|
print 'Content-type: text/plain'."\n\n"; |
print 'Content-type: text/plain'."\n\n"; |
|
|
|
&main(); |
|
|
|
sub main { |
|
if (!&LONCAPA::loncgi::check_ipbased_access('metadatakeywords')) { |
|
if (!&LONCAPA::loncgi::check_cookie_and_load_env()) { |
|
&Apache::lonlocal::get_language_handle(); |
|
print(&LONCAPA::loncgi::missing_cookie_msg()); |
|
return; |
|
} |
|
|
|
if (!&LONCAPA::loncgi::can_view('metadata_keywords')) { |
|
&Apache::lonlocal::get_language_handle(); |
|
print(&LONCAPA::loncgi::unauthorized_msg('metadata_keywords')); |
|
return; |
|
} |
|
} |
|
|
|
&Apache::lonlocal::get_language_handle(); |
|
|
# --- Make sure that database can be accessed and that this is a library server |
# --- Make sure that database can be accessed and that this is a library server |
# library server test |
# library server test |
my %perlvar; |
|
open (CONFIG,"/etc/httpd/conf/access.conf") || |
# By default, loncapa_apache.conf is also read by the read_conf subroutine. |
(print "Can't read access.conf\n" && exit); |
my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf'); |
while (my $configline=<CONFIG>) { |
my %perlvar=%{$perlvarref}; |
if ($configline =~ /PerlSetVar/) { |
undef($perlvarref); |
my ($dummy,$varname,$varvalue)=split(/\s+/,$configline); |
|
chomp($varvalue); |
unless ($perlvar{'lonRole'} eq 'library') { |
$perlvar{$varname}=$varvalue; |
print(&Apache::lonlocal::mt('This can only be run on a library server!)."\n"); |
|
return; |
} |
} |
} |
|
close(CONFIG); |
|
unless ($perlvar{'lonRole'} eq 'library') { |
|
print "This can only be run on a library server!\n"; |
|
exit; |
|
} |
|
# database test |
# database test |
my $dbh; |
my $dbh; |
{ |
{ |
unless ( |
unless ( |
$dbh = DBI->connect("DBI:mysql:loncapa","www", |
$dbh = DBI->connect("DBI:mysql:loncapa","www", |
$perlvar{'lonSqlAccess'}, |
$perlvar{'lonSqlAccess'}, |
{ RaiseError =>0,PrintError=>0}) |
{ RaiseError =>0,PrintError=>0}) |
) { |
) { |
print "Cannot connect to database!\n"; |
print "Cannot connect to database!\n"; |
exit; |
return; |
|
} |
} |
} |
} |
%perlvar=(); # undefine it |
%perlvar=(); # undefine it |
|
|
|
print "testmsg\n"; |
|
# ------------------------ Loop through database records and print out keywords |
# ------------------------ Loop through database records and print out keywords |
my $sth=$dbh->prepare("select * from metadata"); |
my $sth=$dbh->prepare("select * from metadata"); |
$sth->execute(); |
$sth->execute(); |
my @row; |
my @row; |
while (@row=$sth->fetchrow_array) { |
while (@row=$sth->fetchrow_array) { |
print 'ROW:'.$row[4]."\n"; |
print $row[4]."\n"; |
} |
} |
|
|
# --------------------------------------------------- Close database connection |
# --------------------------------------------------- Close database connection |
$dbh->disconnect(); |
$dbh->disconnect(); |
|
return; |
|
} |