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

Diff for /loncom/lonsql between versions 1.85 and 1.98

version 1.85, 2007/08/25 13:45:56 version 1.98, 2019/04/24 01:44:38
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 231  unless ($dbh = DBI->connect("DBI:mysql:l Line 231  unless ($dbh = DBI->connect("DBI:mysql:l
     my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";      my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
     my $subj="LON: $perlvar{'lonHostID'} Cannot connect to database!";      my $subj="LON: $perlvar{'lonHostID'} Cannot connect to database!";
     system("echo 'Cannot connect to MySQL database!' |".      system("echo 'Cannot connect to MySQL database!' |".
            " mailto $emailto -s '$subj' > /dev/null");             " mail -s '$subj' $emailto > /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 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);  
                     $fragfirst =~ s/^\s+//;  
                     $fraglast =~ s/\s+$//;  
                     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()) {  
                     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]));  
                         }  
                         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 'instdirsearch') {      } elsif ($query eq 'instdirsearch') {
  $result = &do_inst_dir_search($searchdomain,$arg1,$arg2,$arg3);   $result = &do_inst_dir_search($searchdomain,$arg1,$arg2,$arg3);
               } elsif ($query eq 'getinstuser') {
                   $result = &get_inst_user($searchdomain,$arg1,$arg2);
               } elsif ($query eq 'getmultinstusers') {
                   $result = &get_multiple_instusers($searchdomain,$arg3);
             } 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 526  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 547  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_ci => 'username collate latin1_general_ci',
                             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 {  sub do_inst_dir_search {
     my ($domain,$srchby,$srchterm,$srchtype) = @_;      my ($domain,$srchby,$srchterm,$srchtype) = @_;
     $srchby   = &unescape($srchby);      $srchby   = &unescape($srchby);
Line 567  sub do_inst_dir_search { Line 601  sub do_inst_dir_search {
             }              }
         }          }
         $response=~s/\&$//;          $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;      return $response;
 }  }
Line 602  sub process_file { Line 690  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.85  
changed lines
  Added in v.1.98

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.