1: #!/usr/bin/perl
2: # Inserts metadata from .meta files into the mysql database
3: # $Id: metadata_harvest.pl,v 1.4 2008/11/28 20:50:25 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:
72: # ---------------------------- Print MIME Content-type and other initialization
73: print 'Content-type: text/plain'."\n\n";
74:
75: &main();
76:
77: sub main {
78: if (!&LONCAPA::loncgi::check_ipbased_access('metadata_harvest')) {
79: if (!&LONCAPA::loncgi::check_cookie_and_load_env()) {
80: &Apache::lonlocal::get_language_handle();
81: print(&LONCAPA::loncgi::missing_cookie_msg());
82: return;
83: }
84:
85: if (!&LONCAPA::loncgi::can_view('metadata_harvest')) {
86: &Apache::lonlocal::get_language_handle();
87: print(&LONCAPA::loncgi::unauthorized_msg('metadata_harvest'));
88: return;
89: }
90: }
91:
92: &Apache::lonlocal::get_language_handle();
93:
94: # --- Make sure that database can be accessed and that this is a library server
95: # library server test
96:
97: # By default, loncapa_apache.conf is also read by the read_conf subroutine.
98: my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');
99: my %perlvar=%{$perlvarref};
100: undef($perlvarref);
101:
102: unless ($perlvar{'lonRole'} eq 'library') {
103: print(&Apache::lonlocal::mt('This can only be run on a library server!')."\n");
104: return;
105: }
106: # database test
107: my $dbh;
108: {
109: unless (
110: $dbh = DBI->connect("DBI:mysql:loncapa","www",
111: $perlvar{'lonSqlAccess'},
112: { RaiseError =>0,PrintError=>0})
113: ) {
114: print "Cannot connect to database!\n";
115: return;
116: }
117: }
118: %perlvar=(); # undefine it
119:
120: # ------------------------ Loop through database records and print out keywords
121: my $sth=$dbh->prepare("select * from metadata");
122: $sth->execute();
123: my @row;
124: while (@row=$sth->fetchrow_array) {
125: for (my $i=0;$i<=$#row;$i++) {
126: $row[$i]=~s/\n/ /g;
127: $row[$i]=~s/\|/ /g;
128: }
129: print join('|',@row)."\n";
130: }
131:
132: # --------------------------------------------------- Close database connection
133: $dbh->disconnect();
134: return;
135: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>