[BACK]Return to lonsql CVS log [TXT] [DIR] Up to [LON-CAPA] / nsdl

Diff for /nsdl/lonsql between versions 1.1 and 1.11

version 1.1, 2005/09/26 19:00:29 version 1.11, 2006/07/28 17:55:18
Line 102  the database. Line 102  the database.
 use strict;  use strict;
   
 use lib '/home/httpd/lib/perl/';  use lib '/home/httpd/lib/perl/';
   use LONCAPA;
 use LONCAPA::Configuration;  use LONCAPA::Configuration;
 use LONCAPA::lonmetadata();  use LONCAPA::lonmetadata();
   
Line 117  use DBI; Line 118  use DBI;
 use File::Find;  use File::Find;
 use localenroll;  use localenroll;
   
   # FOR NSDL
   
    use HTML::LCParser();
    use LWP::UserAgent();
    use HTTP::Headers;
    use HTTP::Date;
   
 ########################################################  ########################################################
 ########################################################  ########################################################
   
Line 260  if (-e $pidfile) { Line 268  if (-e $pidfile) {
 # Read hosts file  # Read hosts file
 #  #
 my $thisserver;  my $thisserver;
   my %hostname;
 my $PREFORK=4; # number of children to maintain, at least four spare  my $PREFORK=4; # number of children to maintain, at least four spare
 open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file";  open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file";
 while (my $configline=<CONFIG>) {  while (my $configline=<CONFIG>) {
     my ($id,$domain,$role,$name)=split(/:/,$configline);      my ($id,$domain,$role,$name)=split(/:/,$configline);
     $name=~s/\s//g;      $name=~s/\s//g;
     $thisserver=$name if ($id eq $perlvar{'lonHostID'});      $thisserver=$name if ($id eq $perlvar{'lonHostID'});
       $hostname{$id}=$name;
     #$PREFORK++;      #$PREFORK++;
 }  }
 close(CONFIG);  close(CONFIG);
Line 386  sub make_new_child { Line 396  sub make_new_child {
     $run = $run+1;      $run = $run+1;
     my $userinput = <$client>;      my $userinput = <$client>;
     chomp($userinput);      chomp($userinput);
               $userinput=~s/\:(\w+)$//;
               my $searchdomain=$1;
             #              #
     my ($conserver,$query,      my ($conserver,$query,
  $arg1,$arg2,$arg3)=split(/&/,$userinput);   $arg1,$arg2,$arg3)=split(/&/,$userinput);
Line 423  sub make_new_child { Line 435  sub make_new_child {
                     $result='no_such_file';                      $result='no_such_file';
                 }                  }
                 # end of log query                  # end of log query
             } elsif ($query eq 'fetchenrollment') {              } elsif (($query eq 'fetchenrollment') || 
        ($query eq 'institutionalphotos')) {
                 # retrieve institutional class lists                  # retrieve institutional class lists
                 my $dom = &unescape($arg1);                  my $dom = &unescape($arg1);
                 my %affiliates = ();                  my %affiliates = ();
Line 431  sub make_new_child { Line 444  sub make_new_child {
                 my $locresult = '';                  my $locresult = '';
                 my $querystr = &unescape($arg3);                  my $querystr = &unescape($arg3);
                 foreach (split/%%/,$querystr) {                  foreach (split/%%/,$querystr) {
                     if (/^(\w+)=([^=]+)$/) {                      if (/^([^=]+)=([^=]+)$/) {
                         @{$affiliates{$1}} = split/,/,$2;                          @{$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.':');                  $result = &escape($locresult.':');
                 if ($locresult) {                  if ($locresult) {
                     $result .= &escape(join(':',map{$_.'='.$replies{$_}} keys %replies));                      $result .= &escape(join(':',map{$_.'='.$replies{$_}} keys %replies));
Line 456  sub make_new_child { Line 480  sub make_new_child {
                 }                  }
             } else {              } else {
                 # Do an sql query                  # 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              # result does not need to be escaped because it has already been
             # escaped.              # escaped.
Line 476  sub make_new_child { Line 500  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  # Takes SQL query
          -f $_ &&  # and is a normal file  # sends it to NSDL
          /\.meta$/ &&  # ends in meta  #
          ! /^.+\.\d+\.[^\.]+\.meta$/  # is not a previous version  
          ) {  
         push(@metalist,$File::Find::name);  
     }  
 }  
   
 sub do_sql_query {  sub nsdl_query {
     my ($query,$custom,$customshow) = @_;      my $query=shift;
     &logthis('doing query '.$query);      my ($keyword)=($query=~/\"\%([^\%]+)\%\"/);
     $custom     = &unescape($custom);      $keyword=&escape($keyword);
     $customshow = &unescape($customshow);      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;
     @metalist = ();      my $response=$ua->get($url);
     #      my $parser=HTML::LCParser->new(\$response->content);
     my $result = '';      my $is='';
     my @results = ();      my $cont='';
     my @files;      my $token;
     my $subsetflag=0;      my %result=();
     #      my $allresults='';
     if ($query) {      while ($token=$parser->get_token) {
         #prepare and execute the query   if ($token->[0] eq 'T') {
         my $sth = $dbh->prepare($query);      $cont.=$token->[1];
         unless ($sth->execute()) {   } elsif ($token->[0] eq 'S') {
             &logthis('<font color="blue">'.      if ($token->[1] eq 'record') {
                      'WARNING: Could not retrieve from database:'.   %result=();
                      $sth->errstr().'</font>');      } elsif ($token->[1]=~/^dc\:/) {
         } else {   $is=$token->[1];
             my $aref=$sth->fetchall_arrayref;   $cont='';
             foreach my $row (@$aref) {      }
                 push @files,@{$row}[3] if ($custom or $customshow);   } elsif ($token->[0] eq 'E') {
                 my @b=map { &escape($_); } @$row;      if ($token->[1] eq 'record') {
                 push @results,join(",", @b);  #
                 # Build up the @files array with the LON-CAPA urls   # Now store it away
                 # of the resources.  #
             }                  my $url=$result{'dc:identifier'};
         }                  if ($url=~/^http\:/) {
     }                     $url=~s/^http:\//\/ext/;
     # do custom metadata searching here and build into result                  } else {
     return join("&",@results) if (! ($custom or $customshow));                     $url='';
     # 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);  
                 }                  }
             }                  if ($url) {
             # &logthis("found: $stuff");                     my ($mime)=($url=~/\.(\w+)$/);
             $customresult.='&custom='.&escape($mfile).','.                     $mime=~tr/A-Z/a-z/;
                 escape($stuff);     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;      $allresults=~s/^\&//;
     $result.=$customresult;  
     #      return $allresults;
     return $result;  }
 } # End of &do_sql_query  
   
 } # End of scoping curly braces for &process_file and &do_sql_query  
 ########################################################  ########################################################
 ########################################################  ########################################################
   
Line 652  Returns: The results of the message or ' Line 625  Returns: The results of the message or '
 ########################################################  ########################################################
 sub subreply {  sub subreply {
     my ($cmd,$server)=@_;      my ($cmd,$server)=@_;
     my $peerfile="$perlvar{'lonSockDir'}/$server";      my $peerfile="$perlvar{'lonSockDir'}/".$hostname{$server};
     my $sclient=IO::Socket::UNIX->new(Peer    =>"$peerfile",      my $sclient=IO::Socket::UNIX->new(Peer    =>"$peerfile",
                                       Type    => SOCK_STREAM,                                        Type    => SOCK_STREAM,
                                       Timeout => 10)                                        Timeout => 10)
        or return "con_lost";         or return "con_lost";
     print $sclient "$cmd\n";      print $sclient "sethost:$server:$cmd\n";
     my $answer=<$sclient>;      my $answer=<$sclient>;
     chomp($answer);      chomp($answer);
     $answer="con_lost" if (!$answer);      $answer="con_lost" if (!$answer);
Line 698  sub reply { Line 671  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  =pod
Removed from v.1.1  
changed lines
  Added in v.1.11

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>