--- nsdl/lonsql 2005/09/26 19:00:29 1.1
+++ nsdl/lonsql 2005/11/25 21:18:35 1.8
@@ -1,9 +1,9 @@
#!/usr/bin/perl
# The LearningOnline Network
-# lonsql - LON TCP-MySQL-Server Daemon for handling database requests.
+# lonsql - LON TCP-NSDL Query Handler.
#
-# $Id: lonsql,v 1.1 2005/09/26 19:00:29 www Exp $
+# $Id: lonsql,v 1.8 2005/11/25 21:18:35 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -113,32 +113,16 @@ use IO::File;
use Socket;
use Fcntl;
use Tie::RefHash;
-use DBI;
+use HTML::LCParser();
+use LWP::UserAgent();
+use HTTP::Headers;
+use HTTP::Date;
use File::Find;
use localenroll;
########################################################
########################################################
-=pod
-
-=item Global Variables
-
-=over 4
-
-=item dbh
-
-=back
-
-=cut
-
-########################################################
-########################################################
-my $dbh;
-
-########################################################
-########################################################
-
=pod
=item Variables required for forking
@@ -223,29 +207,6 @@ ENDMYCNF
#
-# Make sure that database can be accessed
-#
-my $dbh;
-unless ($dbh = DBI->connect("DBI:mysql:loncapa","www",
- $perlvar{'lonSqlAccess'},
- { RaiseError =>0,PrintError=>0})) {
- print "Cannot connect to database!\n";
- my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
- my $subj="LON: $perlvar{'lonHostID'} Cannot connect to database!";
- system("echo 'Cannot connect to MySQL database!' |".
- " mailto $emailto -s '$subj' > /dev/null");
-
- open(SMP,'>/home/httpd/html/lon-status/mysql.txt');
- print SMP 'time='.time.'&mysql=defunct'."\n";
- close(SMP);
-
- exit 1;
-} else {
- unlink('/home/httpd/html/lon-status/mysql.txt');
- $dbh->disconnect;
-}
-
-#
# Check if other instance running
#
my $pidfile="$perlvar{'lonDaemons'}/logs/lonsql.pid";
@@ -364,20 +325,7 @@ sub make_new_child {
# unblock signals
sigprocmask(SIG_UNBLOCK, $sigset)
or die "Can't unblock SIGINT for fork: $!\n";
- #open database handle
- # making dbh global to avoid garbage collector
- unless ($dbh = DBI->connect("DBI:mysql:loncapa","www",
- $perlvar{'lonSqlAccess'},
- { RaiseError =>0,PrintError=>0})) {
- sleep(10+int(rand(20)));
- &logthis("WARNING: Couldn't connect to database".
- ": $@");
- # "($st secs): $@");
- print "database handle error\n";
- exit;
- }
- # make sure that a database disconnection occurs with
- # ending kill signals
+
$SIG{TERM}=$SIG{INT}=$SIG{QUIT}=$SIG{__DIE__}=\&DISCONNECT;
# handle connections until we've reached $MAX_CLIENTS_PER_CHILD
for (my $i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) {
@@ -431,7 +379,7 @@ sub make_new_child {
my $locresult = '';
my $querystr = &unescape($arg3);
foreach (split/%%/,$querystr) {
- if (/^(\w+)=([^=]+)$/) {
+ if (/^([^=]+)=([^=]+)$/) {
@{$affiliates{$1}} = split/,/,$2;
}
}
@@ -456,7 +404,7 @@ sub make_new_child {
}
} else {
# Do an sql query
- $result = &do_sql_query($query,$arg1,$arg2);
+ $result = &nsdl_query($query,$arg1,$arg2);
}
# result does not need to be escaped because it has already been
# escaped.
@@ -465,147 +413,13 @@ sub make_new_child {
}
# tidy up gracefully and finish
#
- # close the database handle
- $dbh->disconnect
- or &logthis("WARNING: Couldn't disconnect".
- " from database $DBI::errstr : $@");
+
# this exit is VERY important, otherwise the child will become
# a producer of more and more children, forking yourself into
# process death.
exit;
}
}
-
-########################################################
-########################################################
-
-=pod
-
-=item &do_sql_query
-
-Runs an sql metadata table query.
-
-Inputs: $query, $custom, $customshow
-
-Returns: A string containing escaped results.
-
-=cut
-
-########################################################
-########################################################
-{
- my @metalist;
-
-sub process_file {
- if ( -e $_ && # file exists
- -f $_ && # and is a normal file
- /\.meta$/ && # ends in meta
- ! /^.+\.\d+\.[^\.]+\.meta$/ # is not a previous version
- ) {
- push(@metalist,$File::Find::name);
- }
-}
-
-sub do_sql_query {
- my ($query,$custom,$customshow) = @_;
- &logthis('doing query '.$query);
- $custom = &unescape($custom);
- $customshow = &unescape($customshow);
- #
- @metalist = ();
- #
- my $result = '';
- my @results = ();
- my @files;
- my $subsetflag=0;
- #
- if ($query) {
- #prepare and execute the query
- my $sth = $dbh->prepare($query);
- unless ($sth->execute()) {
- &logthis(''.
- 'WARNING: Could not retrieve from database:'.
- $sth->errstr().'');
- } else {
- my $aref=$sth->fetchall_arrayref;
- foreach my $row (@$aref) {
- push @files,@{$row}[3] if ($custom or $customshow);
- my @b=map { &escape($_); } @$row;
- push @results,join(",", @b);
- # Build up the @files array with the LON-CAPA urls
- # of the resources.
- }
- }
- }
- # do custom metadata searching here and build into result
- return join("&",@results) if (! ($custom or $customshow));
- # Only get here if there is a custom query or custom show request
- &logthis("Doing custom query for $custom");
- if ($query) {
- @metalist=map {
- $perlvar{'lonDocRoot'}.$_.'.meta';
- } @files;
- } else {
- my $dir = "$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}";
- @metalist=();
- opendir(RESOURCES,$dir);
- my @homeusers=grep {
- &ishome($dir.'/'.$_);
- } grep {!/^\.\.?$/} readdir(RESOURCES);
- closedir RESOURCES;
- # Define the
- foreach my $user (@homeusers) {
- find (\&process_file,$dir.'/'.$user);
- }
- }
- # if file is indicated in sql database and
- # not part of sql-relevant query, do not pattern match.
- #
- # if file is not in sql database, output error.
- #
- # if file is indicated in sql database and is
- # part of query result list, then do the pattern match.
- my $customresult='';
- my @results;
- foreach my $metafile (@metalist) {
- my $fh=IO::File->new($metafile);
- my @lines=<$fh>;
- my $stuff=join('',@lines);
- if ($stuff=~/$custom/s) {
- foreach my $f ('abstract','author','copyright',
- 'creationdate','keywords','language',
- 'lastrevisiondate','mime','notes',
- 'owner','subject','title') {
- $stuff=~s/\n?\<$f[^\>]*\>.*?<\/$f[^\>]*\>\n?//s;
- }
- my $mfile=$metafile;
- my $docroot=$perlvar{'lonDocRoot'};
- $mfile=~s/^$docroot//;
- $mfile=~s/\.meta$//;
- unless ($query) {
- my $q2="SELECT * FROM metadata WHERE url ".
- " LIKE BINARY '?'";
- my $sth = $dbh->prepare($q2);
- $sth->execute($mfile);
- my $aref=$sth->fetchall_arrayref;
- foreach my $a (@$aref) {
- my @b=map { &escape($_)} @$a;
- push @results,join(",", @b);
- }
- }
- # &logthis("found: $stuff");
- $customresult.='&custom='.&escape($mfile).','.
- escape($stuff);
- }
- }
- $result=join("&",@results) unless $query;
- $result.=$customresult;
- #
- return $result;
-} # End of &do_sql_query
-
-} # End of scoping curly braces for &process_file and &do_sql_query
-########################################################
########################################################
=pod
@@ -976,13 +790,66 @@ sub HUPSMAN { # sig
exec("$execdir/lonsql"); # here we go again
}
-sub DISCONNECT {
- $dbh->disconnect or
- &logthis("WARNING: Couldn't disconnect from database ".
- " $DBI::errstr : $@");
- exit;
-}
+#
+# Takes SQL query
+# sends it to NSDL
+#
+sub nsdl_query {
+ my $query=shift;
+ my ($keyword)=($query=~/\"\%([^\%]+)\%\"/);
+ $keyword=&escape($keyword);
+ my $url='http://search.nsdl.org?verb=Search&s=0&n=500&q=-link.primaryCollection:oai\:nsdl.org\:nsdl.nsdl\:00254%20'.$keyword;
+ my $ua=new LWP::UserAgent;
+ my $response=$ua->get($url);
+ my $parser=HTML::LCParser->new(\$response->content);
+ my $is='';
+ my $cont='';
+ my $token;
+ my %result=();
+ my $allresults='';
+ while ($token=$parser->get_token) {
+ if ($token->[0] eq 'T') {
+ $cont.=$token->[1];
+ } elsif ($token->[0] eq 'S') {
+ if ($token->[1] eq 'record') {
+ %result=();
+ } elsif ($token->[1]=~/^dc\:/) {
+ $is=$token->[1];
+ $cont='';
+ }
+ } elsif ($token->[0] eq 'E') {
+ if ($token->[1] eq 'record') {
+#
+# Now store it away
+#
+ my $url=$result{'dc:identifier'};
+ if ($url=~/^http\:/) {
+ $url=~s/^http:\//\/ext/;
+ } else {
+ $url='';
+ }
+ if ($url) {
+ my ($mime)=($url=~/\.(\w+)$/);
+ $mime=~tr/A-Z/a-z/;
+ $allresults.='&'.
+ &escape($result{'dc:title'}).','.
+ &escape($result{'dc:creator'}).','.
+ &escape($result{'dc:subject'}).','.
+ &escape($url).',,,,'.
+ &escape($result{'dc:description'}).','.
+ &escape($mime).',seniso,,,,public,nsdl,,,,,,,,,,,,,,,,,,,,,,,,,,,,';
+ }
+ %result=();
+ } elsif ($token->[1]=~/^dc\:/) {
+ $result{$is}=$cont;
+ }
+ }
+ }
+ $allresults=~s/^\&//;
+&logthis($allresults);
+ return $allresults;
+}
=pod