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); |