Diff for /loncom/lonsql between versions 1.82 and 1.96

version 1.82, 2007/07/25 22:40:00 version 1.96, 2017/10/13 20:37:46
Line 95  the database. Line 95  the database.
   
 =head1 Internals  =head1 Internals
   
 =over 4  
   
 =cut  =cut
   
 use strict;  use strict;
Line 121  use GDBM_File; Line 119  use GDBM_File;
   
 =pod  =pod
   
   =over 4
   
 =item Global Variables  =item Global Variables
   
 =over 4  =over 4
Line 233  unless ($dbh = DBI->connect("DBI:mysql:l Line 233  unless ($dbh = DBI->connect("DBI:mysql:l
     system("echo 'Cannot connect to MySQL database!' |".      system("echo 'Cannot connect to MySQL database!' |".
            " mailto $emailto -s '$subj' > /dev/null");             " mailto $emailto -s '$subj' > /dev/null");
   
     open(SMP,'>/home/httpd/html/lon-status/mysql.txt');      open(SMP,">$perlvar{'lonDocRoot'}/lon-status/mysql.txt");
     print SMP 'time='.time.'&mysql=defunct'."\n";      print SMP 'time='.time.'&mysql=defunct'."\n";
     close(SMP);      close(SMP);
   
     exit 1;      exit 1;
 } else {  } else {
     unlink('/home/httpd/html/lon-status/mysql.txt');      unlink("$perlvar{'lonDocRoot'}/lon-status/mysql.txt");
     $dbh->disconnect;      $dbh->disconnect;
 }  }
   
Line 372  sub make_new_child { Line 372  sub make_new_child {
     $run = $run+1;      $run = $run+1;
     my $userinput = <$client>;      my $userinput = <$client>;
     chomp($userinput);      chomp($userinput);
             $userinput=~s/\:(\w+)$//;              $userinput=~s/\:($LONCAPA::domain_re)$//;
             my $searchdomain=$1;              my $searchdomain=$1;
             #              #
     my ($conserver,$query,      my ($conserver,$query,
Line 387  sub make_new_child { Line 387  sub make_new_child {
     print $client "$queryid\n";      print $client "$queryid\n";
     #      #
     # &logthis("QUERY: $query - $arg1 - $arg2 - $arg3 - $queryid");      # &logthis("QUERY: $query - $arg1 - $arg2 - $arg3 - $queryid");
     sleep 1;      # sleep 1;
             #              #
             my $result='';              my $result='';
             #              #
Line 442  sub make_new_child { Line 442  sub make_new_child {
                     $result .= &escape(join(':',map{$_.'='.$replies{$_}} keys %replies));                      $result .= &escape(join(':',map{$_.'='.$replies{$_}} keys %replies));
                 }                  }
             } elsif ($query eq 'usersearch') {              } elsif ($query eq 'usersearch') {
                 my $srchdomain = &unescape($arg1);                  my ($srchby,$srchtype,$srchterm);
                 my @items  = split(/%%/,$arg2);                  if ((&unescape($arg1) eq $searchdomain) &&
                 my ($srchby,$srchtype) = map {&unescape($_)} @items;                       ($arg2 =~ /\%\%/)) {
                 my $srchterm = &unescape($arg3);                      ($srchby,$srchtype) =
                 my $quoted_dom = $dbh->quote( $srchdomain );                          map {&unescape($_);} (split(/\%\%/,$arg2));
                 my ($query,$quoted_srchterm,@fields);                      $srchterm = &unescape($arg3);
                 my ($table_columns,$table_indices) =  
                    &LONCAPA::lonmetadata::describe_metadata_storage('allusers');  
                 foreach my $coldata (@{$table_columns}) {  
                     push(@fields,$coldata->{'name'});  
                 }  
                 my $fieldlist = join(',',@fields);  
                 $query = "SELECT $fieldlist FROM allusers WHERE (domain = $quoted_dom AND ";  
                 if ($srchby eq 'lastfirst') {  
                     my ($fraglast,$fragfirst) = split(/,/,$srchterm);  
                     if ($srchtype eq 'exact') {  
                         $query .= 'lastname = '.$dbh->quote($fraglast).  
                                   ' AND firstname = '.$dbh->quote($fragfirst);  
                     } else {  
                         $query .= 'lastname LIKE '.$dbh->quote('%'.$fraglast.'%').' AND firstname LIKE '.$dbh->quote('%'.$fragfirst.'%');  
                     }  
                 } else {                  } else {
                     my %srchfield = (                      ($srchby,$srchtype,$srchterm) =
                                       uname    => 'username',                          map {&unescape($_);} ($arg1,$arg2,$arg3);
                                       lastname => 'lastname',  
                                     );  
                     if ($srchtype eq 'exact') {  
                         $query .= $srchfield{$srchby}.' = '.$dbh->quote($srchterm);  
                     } else {  
                         $query .= $srchfield{$srchby}.' LIKE '.$dbh->quote('%'.$srchterm.'%');  
                     }  
                 }                  }
                 $query .= ") ORDER BY username ";                  $result = &do_user_search($searchdomain,$srchby,
                 my $sth = $dbh->prepare($query);                                            $srchtype,$srchterm);
                 if ($sth->execute()) {      } elsif ($query eq 'instdirsearch') {
                     my @results;   $result = &do_inst_dir_search($searchdomain,$arg1,$arg2,$arg3);
                     while (my @row = $sth->fetchrow_array) {              } elsif ($query eq 'getinstuser') {
                         my @items;                  $result = &get_inst_user($searchdomain,$arg1,$arg2);
                         for (my $i=0; $i<@row; $i++) {              } elsif ($query eq 'getmultinstusers') {
                             push(@items,&escape($fields[$i]).'='.&escape($row[$i]));                  $result = &get_multiple_instusers($searchdomain,$arg3);
                         }  
                         push(@results,join(":", @items));  
                     }  
                     $sth->finish;  
                     $result = &escape(join("&",@results));  
                 } else {  
                     &logthis('<font color="blue">'.  
                              'WARNING: Could not retrieve from database:'.  
                              $sth->errstr().'</font>');  
                }  
             } elsif ($query eq 'prepare activity log') {              } elsif ($query eq 'prepare activity log') {
                 my ($cid,$domain) = map {&unescape($_);} ($arg1,$arg2);                  my ($cid,$domain) = map {&unescape($_);} ($arg1,$arg2);
                 &logthis('preparing activity log tables for '.$cid);                  &logthis('preparing activity log tables for '.$cid);
Line 522  sub make_new_child { Line 490  sub make_new_child {
                 $userdata{'domain'} = $udom;                  $userdata{'domain'} = $udom;
                 $result = &allusers_table_update($query,$uname,$udom,\%userdata);                  $result = &allusers_table_update($query,$uname,$udom,\%userdata);
             } else {              } else {
                   # Sanity checking of $query needed.
                 # Do an sql query                  # Do an sql query
                 $result = &do_sql_query($query,$arg1,$arg2,$searchdomain);                  $result = &do_sql_query($query,$arg1,$arg2,$arg3,$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 543  sub make_new_child { Line 512  sub make_new_child {
     }      }
 }  }
   
   sub do_user_search {
       my ($domain,$srchby,$srchtype,$srchterm) = @_;
       my $result;
       my $quoted_dom = $dbh->quote( $domain );
       my ($query,$quoted_srchterm,@fields);
       my ($table_columns,$table_indices) =
           &LONCAPA::lonmetadata::describe_metadata_storage('allusers');
       foreach my $coldata (@{$table_columns}) {
           push(@fields,$coldata->{'name'});
       }
       my $fieldlist = join(',',@fields);
       $query = "SELECT $fieldlist FROM allusers WHERE (domain = $quoted_dom AND ";
       if ($srchby eq 'lastfirst') {
           my ($fraglast,$fragfirst) = split(/,/,$srchterm);
           $fragfirst =~ s/^\s+//;
           $fraglast =~ s/\s+$//;
           if ($srchtype eq 'exact') {
               $query .= 'lastname = '.$dbh->quote($fraglast).
                         ' AND firstname = '.$dbh->quote($fragfirst);
           } elsif ($srchtype eq 'begins') {
               $query .= 'lastname LIKE '.$dbh->quote($fraglast.'%').
                         ' AND firstname LIKE '.$dbh->quote($fragfirst.'%');
           } else {
               $query .= 'lastname LIKE '.$dbh->quote('%'.$fraglast.'%').
                         ' AND firstname LIKE '.$dbh->quote('%'.$fragfirst.'%');
           }
       } else {
           my %srchfield = (
                             uname    => 'username',
                             lastname => 'lastname',
                             email    => 'permanentemail',
                           );
           if (exists($srchfield{$srchby})) {
               if ($srchtype eq 'exact') {
                   $query .= $srchfield{$srchby}.' = '.$dbh->quote($srchterm);
               } elsif ($srchtype eq 'begins') {
                   $query .= $srchfield{$srchby}.' LIKE '.$dbh->quote($srchterm.'%');
               } else {
                   $query .= $srchfield{$srchby}.' LIKE '.$dbh->quote('%'.$srchterm.'%');
               }
           } else {
               &logthis('<font color="blue">'.
                        'WARNING: Invalid srchby: '.$srchby.'</font>');  
               return $result;
           }
       }
       $query .= ") ORDER BY username ";
       my $sth = $dbh->prepare($query);
       if ($sth->execute()) {
           my @results;
           while (my @row = $sth->fetchrow_array) {
               my @items;
               for (my $i=0; $i<@row; $i++) {
                   push(@items,&escape($fields[$i]).'='.&escape($row[$i]));
               }
               my $userstr = join(':', @items);
               push(@results,&escape($userstr));
           }
           $sth->finish;
           $result = join('&',@results);
       } else {
           &logthis('<font color="blue">'.
                   'WARNING: Could not retrieve from database:'.
           $sth->errstr().'</font>');
       }
       return $result;
   }
   
   sub do_inst_dir_search {
       my ($domain,$srchby,$srchterm,$srchtype) = @_;
       $srchby   = &unescape($srchby);
       $srchterm = &unescape($srchterm);
       $srchtype = &unescape($srchtype);
       my (%instusers,%instids,$result,$response);
       eval {
           local($SIG{__DIE__})='DEFAULT';
           $result=&localenroll::get_userinfo($domain,undef,undef,\%instusers,
      \%instids,undef,$srchby,$srchterm,
      $srchtype);
       };
       if ($result eq 'ok') {
           if (%instusers) {
               foreach my $key (keys(%instusers)) {
                   my $usrstr = &Apache::lonnet::freeze_escape($instusers{$key});
                   $response .=&escape(&escape($key).'='.$usrstr).'&';
               }
           }
           $response=~s/\&$//;
       } else {
           $response = 'unavailable';
       }
       return $response;
   }
   
   sub get_inst_user {
       my ($domain,$uname,$id) = @_;
       $uname = &unescape($uname);
       $id = &unescape($id);
       my (%instusers,%instids,$result,$response);
       eval {
           local($SIG{__DIE__})='DEFAULT';
           $result=&localenroll::get_userinfo($domain,$uname,$id,\%instusers,
                                              \%instids);
       };
       if ($result eq 'ok') {
           if (keys(%instusers) > 0) {
               foreach my $key (keys(%instusers)) {
                   my $usrstr = &Apache::lonnet::freeze_escape($instusers{$key});
                   $response .= &escape(&escape($key).'='.$usrstr).'&';
               }
           }
           $response=~s/\&$//;
       } else {
           $response = 'unavailable';
       }
       return $response;
   }
   
   sub get_multiple_instusers {
       my ($domain,$data) = @_;
       my ($type,$users) = split(/=/,$data,2);
       my $requested = &Apache::lonnet::thaw_unescape($users);
       my $response;
       if (ref($requested) eq 'HASH') {
           my (%instusers,%instids,$result);
           eval {
               local($SIG{__DIE__})='DEFAULT';
               $result=&localenroll::get_multusersinfo($domain,$type,$requested,\%instusers,
                                                       \%instids);
           };
           if ($@) {
               $response = 'error';
           } elsif ($result eq 'ok') {
               $response = $result;
               if (keys(%instusers)) {
                   $response .= '='.&Apache::lonnet::freeze_escape(\%instusers);
               }
           } elsif ($result eq 'unavailable') {
               $response = $result;
           }
       } else {
           $response = 'invalid';
       }
       return $response;
   }
   
 ########################################################  ########################################################
 ########################################################  ########################################################
   
Line 574  sub process_file { Line 689  sub process_file {
 }  }
   
 sub do_sql_query {  sub do_sql_query {
     my ($query,$custom,$customshow,$searchdomain) = @_;      my ($query,$custom,$customshow,$domainstr,$searchdomain) = @_;
   
 #  #
 # limit to searchdomain if given and table is metadata  # limit to searchdomain if given and table is metadata
 #  #
     if (($searchdomain) && ($query=~/FROM metadata/)) {      if ($domainstr && ($query=~/FROM metadata/)) {
           my $havingstr;
           $domainstr = &unescape($domainstr); 
           if ($domainstr =~ /,/) {
               foreach my $dom (split(/,/,$domainstr)) {
                   if ($dom =~ /^$LONCAPA::domain_re$/) {
                       $havingstr .= 'domain="'.$dom.'" OR ';
                   }
               }
               $havingstr =~ s/ OR $//;
           } else {
               if ($domainstr =~ /^$LONCAPA::domain_re$/) {
                   $havingstr = 'domain="'.$domainstr.'"';
               }
           }
           if ($havingstr) {
               $query.=' HAVING ('.$havingstr.')';
           }
       } elsif (($searchdomain) && ($query=~/FROM metadata/)) {
  $query.=' HAVING (domain="'.$searchdomain.'")';   $query.=' HAVING (domain="'.$searchdomain.'")';
     }      }
 #    &logthis('doing query ('.$searchdomain.')'.$query);  #    &logthis('doing query ('.$searchdomain.')'.$query);

Removed from v.1.82  
changed lines
  Added in v.1.96


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