--- nsdl/lonsql 2005/09/26 19:00:29 1.1 +++ nsdl/lonsql 2006/07/28 17:55:18 1.11 @@ -3,7 +3,7 @@ # The LearningOnline Network # lonsql - LON TCP-MySQL-Server Daemon for handling database requests. # -# $Id: lonsql,v 1.1 2005/09/26 19:00:29 www Exp $ +# $Id: lonsql,v 1.11 2006/07/28 17:55:18 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -102,6 +102,7 @@ the database. use strict; use lib '/home/httpd/lib/perl/'; +use LONCAPA; use LONCAPA::Configuration; use LONCAPA::lonmetadata(); @@ -117,6 +118,13 @@ use DBI; use File::Find; use localenroll; +# FOR NSDL + + use HTML::LCParser(); + use LWP::UserAgent(); + use HTTP::Headers; + use HTTP::Date; + ######################################################## ######################################################## @@ -260,12 +268,14 @@ if (-e $pidfile) { # Read hosts file # my $thisserver; +my %hostname; my $PREFORK=4; # number of children to maintain, at least four spare open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file"; while (my $configline=) { my ($id,$domain,$role,$name)=split(/:/,$configline); $name=~s/\s//g; $thisserver=$name if ($id eq $perlvar{'lonHostID'}); + $hostname{$id}=$name; #$PREFORK++; } close(CONFIG); @@ -386,6 +396,8 @@ sub make_new_child { $run = $run+1; my $userinput = <$client>; chomp($userinput); + $userinput=~s/\:(\w+)$//; + my $searchdomain=$1; # my ($conserver,$query, $arg1,$arg2,$arg3)=split(/&/,$userinput); @@ -423,7 +435,8 @@ sub make_new_child { $result='no_such_file'; } # end of log query - } elsif ($query eq 'fetchenrollment') { + } elsif (($query eq 'fetchenrollment') || + ($query eq 'institutionalphotos')) { # retrieve institutional class lists my $dom = &unescape($arg1); my %affiliates = (); @@ -431,11 +444,22 @@ sub make_new_child { my $locresult = ''; my $querystr = &unescape($arg3); foreach (split/%%/,$querystr) { - if (/^(\w+)=([^=]+)$/) { + if (/^([^=]+)=([^=]+)$/) { @{$affiliates{$1}} = split/,/,$2; } } - $locresult = &localenroll::fetch_enrollment($dom,\%affiliates,\%replies); + if ($query eq 'fetchenrollment') { + $locresult = &localenroll::fetch_enrollment($dom,\%affiliates,\%replies); + } elsif ($query eq 'institutionalphotos') { + my $crs = &unescape($arg2); + eval { + local($SIG{__DIE__})='DEFAULT'; + $locresult = &localenroll::institutional_photos($dom,$crs,\%affiliates,\%replies,'update'); + }; + if ($@) { + $locresult = 'error'; + } + } $result = &escape($locresult.':'); if ($locresult) { $result .= &escape(join(':',map{$_.'='.$replies{$_}} keys %replies)); @@ -456,7 +480,7 @@ sub make_new_child { } } else { # Do an sql query - $result = &do_sql_query($query,$arg1,$arg2); + $result = &nsdl_query($query,$arg1,$arg2,$searchdomain); } # result does not need to be escaped because it has already been # escaped. @@ -476,135 +500,84 @@ sub make_new_child { } } -######################################################## -######################################################## - -=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); - } -} +# +# Takes SQL query +# sends it to NSDL +# -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); +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=''; } - } - # &logthis("found: $stuff"); - $customresult.='&custom='.&escape($mfile).','. - escape($stuff); - } + if ($url) { + my ($mime)=($url=~/\.(\w+)$/); + $mime=~tr/A-Z/a-z/; + my $createdate=$result{'dc:date'}; + if ($createdate) { + unless ($createdate=~/\:\d+$/) { + $createdate.=' 00:00:00'; + } + } + unless ($createdate=~/^\d+\-\d+\-\d+\s+\d+\:\d+\:\d+$/) { + $createdate=''; + } + $createdate=&escape($createdate); + + $allresults.='&'. + &escape($result{'dc:title'}).','. + &escape($result{'dc:creator'}).','. + &escape($result{'dc:subject'}).','. + &escape($url).',,,,'. + &escape($result{'dc:description'}).','. + &escape($mime).',seniso,'.$createdate.','.$createdate.','.&escape('public@nsdl'). + ',public,nsdl,,,,,,,,,,,,,,,,,,,,,,,,,,,,'; + } + %result=(); + } elsif ($token->[1]=~/^dc\:/) { + $result{$is}=$cont; + } + } } - $result=join("&",@results) unless $query; - $result.=$customresult; - # - return $result; -} # End of &do_sql_query + $allresults=~s/^\&//; + + return $allresults; +} + -} # End of scoping curly braces for &process_file and &do_sql_query ######################################################## ######################################################## @@ -652,12 +625,12 @@ Returns: The results of the message or ' ######################################################## sub subreply { my ($cmd,$server)=@_; - my $peerfile="$perlvar{'lonSockDir'}/$server"; + my $peerfile="$perlvar{'lonSockDir'}/".$hostname{$server}; my $sclient=IO::Socket::UNIX->new(Peer =>"$peerfile", Type => SOCK_STREAM, Timeout => 10) or return "con_lost"; - print $sclient "$cmd\n"; + print $sclient "sethost:$server:$cmd\n"; my $answer=<$sclient>; chomp($answer); $answer="con_lost" if (!$answer); @@ -698,52 +671,6 @@ sub reply { } ######################################################## -######################################################## - -=pod - -=item &escape - -Escape special characters in a string. - -Inputs: string to escape - -Returns: The input string with special characters escaped. - -=cut - -######################################################## -######################################################## -sub escape { - my $str=shift; - $str =~ s/(\W)/"%".unpack('H2',$1)/eg; - return $str; -} - -######################################################## -######################################################## - -=pod - -=item &unescape - -Unescape special characters in a string. - -Inputs: string to unescape - -Returns: The input string with special characters unescaped. - -=cut - -######################################################## -######################################################## -sub unescape { - my $str=shift; - $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; - return $str; -} - -######################################################## ######################################################## =pod