--- loncom/cgi/metadata_harvest.pl 2003/09/01 03:37:27 1.3
+++ loncom/cgi/metadata_harvest.pl 2008/12/25 01:56:03 1.5
@@ -1,6 +1,6 @@
#!/usr/bin/perl
# Inserts metadata from .meta files into the mysql database
-# $Id: metadata_harvest.pl,v 1.3 2003/09/01 03:37:27 albertel Exp $
+# $Id: metadata_harvest.pl,v 1.5 2008/12/25 01:56:03 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -61,53 +61,76 @@
# ------------------------------------------------- Modules used by this script
-use lib '/home/httpd/lib/perl/';
-use LONCAPA::Configuration;
-
+$|=1;
use strict;
use DBI;
+use lib '/home/httpd/lib/perl/';
+use Apache::lonlocal;
+use LONCAPA::Configuration;
+use LONCAPA::loncgi;
+use LONCAPA::lonauthcgi;
# ---------------------------- Print MIME Content-type and other initialization
-$|=1;
print 'Content-type: text/plain'."\n\n";
+&main();
+
+sub main {
+ if (!&LONCAPA::lonauthcgi::check_ipbased_access('metadata_harvest')) {
+ if (!&LONCAPA::loncgi::check_cookie_and_load_env()) {
+ &Apache::lonlocal::get_language_handle();
+ print(&LONCAPA::loncgi::missing_cookie_msg());
+ return;
+ }
+
+ if (!&LONCAPA::lonauthcgi::can_view('metadata_harvest')) {
+ &Apache::lonlocal::get_language_handle();
+ print(&LONCAPA::lonauthcgi::unauthorized_msg('metadata_harvest'));
+ return;
+ }
+ }
+
+ &Apache::lonlocal::get_language_handle();
+
# --- Make sure that database can be accessed and that this is a library server
# library server test
# By default, loncapa_apache.conf is also read by the read_conf subroutine.
-my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');
-my %perlvar=%{$perlvarref};
-undef($perlvarref);
-
-unless ($perlvar{'lonRole'} eq 'library') {
- print "This can only be run on a library server!\n";
- exit;
-}
+ my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');
+ my %perlvar=%{$perlvarref};
+ undef($perlvarref);
+
+ unless ($perlvar{'lonRole'} eq 'library') {
+ print(&Apache::lonlocal::mt('This can only be run on a library server!')."\n");
+ return;
+ }
# database test
-my $dbh;
-{
- unless (
- $dbh = DBI->connect("DBI:mysql:loncapa","www",
- $perlvar{'lonSqlAccess'},
- { RaiseError =>0,PrintError=>0})
- ) {
- print "Cannot connect to database!\n";
- exit;
+ my $dbh;
+ {
+ unless (
+ $dbh = DBI->connect("DBI:mysql:loncapa","www",
+ $perlvar{'lonSqlAccess'},
+ { RaiseError =>0,PrintError=>0})
+ ) {
+ print "Cannot connect to database!\n";
+ return;
+ }
}
-}
-%perlvar=(); # undefine it
+ %perlvar=(); # undefine it
# ------------------------ Loop through database records and print out keywords
-my $sth=$dbh->prepare("select * from metadata");
-$sth->execute();
-my @row;
-while (@row=$sth->fetchrow_array) {
- for (my $i=0;$i<=$#row;$i++) {
- $row[$i]=~s/\n/ /g;
- $row[$i]=~s/\|/ /g;
+ my $sth=$dbh->prepare("select * from metadata");
+ $sth->execute();
+ my @row;
+ while (@row=$sth->fetchrow_array) {
+ for (my $i=0;$i<=$#row;$i++) {
+ $row[$i]=~s/\n/ /g;
+ $row[$i]=~s/\|/ /g;
+ }
+ print join('|',@row)."\n";
}
- print join('|',@row)."\n";
-}
# --------------------------------------------------- Close database connection
-$dbh->disconnect();
+ $dbh->disconnect();
+ return;
+}
500 Internal Server Error
Internal Server Error
The server encountered an internal error or
misconfiguration and was unable to complete
your request.
Please contact the server administrator at
root@localhost to inform them of the time this error occurred,
and the actions you performed just before this error.
More information about this error may be available
in the server error log.