[LON-CAPA-cvs] cvs: loncom / lonsql /lonnet/perl lonnet.pm
raeburn
lon-capa-cvs-allow@mail.lon-capa.org
Wed, 12 Sep 2007 03:40:36 -0000
This is a MIME encoded message
--raeburn1189568436
Content-Type: text/plain
raeburn Tue Sep 11 23:40:36 2007 EDT
Modified files:
/loncom lonsql
/loncom/lonnet/perl lonnet.pm
Log:
lonnet.pm
- usersearch() made more similar to other routines which use lonsql
(records split on \n not &).
- srchby, srchtype, and srchterm passed as separate arguments
- backwards compatibility maintained with older lonsql
lonsql
- usersearch() query processing moved to subroutine.
- searchdomain implicitly from lonsql, isntead of arg in query
- backwards compatibility maintained with older lonnet:usersearch()
- escaping of result more consistent with other lonsql queries (replacement of & with \n in lond::reply_query_handler() now possible).
--raeburn1189568436
Content-Type: text/plain
Content-Disposition: attachment; filename="raeburn-20070911234036.txt"
Index: loncom/lonsql
diff -u loncom/lonsql:1.87 loncom/lonsql:1.88
--- loncom/lonsql:1.87 Fri Aug 31 08:33:25 2007
+++ loncom/lonsql Tue Sep 11 23:40:29 2007
@@ -3,7 +3,7 @@
# The LearningOnline Network
# lonsql - LON TCP-MySQL-Server Daemon for handling database requests.
#
-# $Id: lonsql,v 1.87 2007/08/31 12:33:25 raeburn Exp $
+# $Id: lonsql,v 1.88 2007/09/12 03:40:29 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -442,62 +442,18 @@
$result .= &escape(join(':',map{$_.'='.$replies{$_}} keys %replies));
}
} elsif ($query eq 'usersearch') {
- my $srchdomain = &unescape($arg1);
- my @items = split(/%%/,$arg2);
- my ($srchby,$srchtype) = map {&unescape($_)} @items;
- my $srchterm = &unescape($arg3);
- my $quoted_dom = $dbh->quote( $srchdomain );
- 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.'%');
- }
+ my ($srchby,$srchtype,$srchterm);
+ if ((&unescape($arg1) eq $searchdomain) &&
+ ($arg2 =~ /\%\%/)) {
+ ($srchby,$srchtype) =
+ map {&unescape($_);} (split(/\%\%/,$arg2));
+ my $srchterm = &unescape($arg3);
} else {
- my %srchfield = (
- uname => 'username',
- lastname => 'lastname',
- );
- 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.'%');
- }
+ ($srchby,$srchtype,$srchterm) =
+ map {&unescape($_);} ($arg1,$arg2,$arg3);
}
- $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]));
- }
- push(@results,join(":", @items));
- }
- $sth->finish;
- $result = &escape(join("&",@results));
- } else {
- &logthis('<font color="blue">'.
- 'WARNING: Could not retrieve from database:'.
- $sth->errstr().'</font>');
- }
+ $result = &do_user_search($searchdomain,$srchby,
+ $srchtype,$srchterm);
} elsif ($query eq 'instdirsearch') {
$result = &do_inst_dir_search($searchdomain,$arg1,$arg2,$arg3);
} elsif ($query eq 'prepare activity log') {
@@ -551,6 +507,67 @@
}
}
+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',
+ );
+ 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.'%');
+ }
+ }
+ $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);
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.910 loncom/lonnet/perl/lonnet.pm:1.911
--- loncom/lonnet/perl/lonnet.pm:1.910 Wed Sep 5 13:37:51 2007
+++ loncom/lonnet/perl/lonnet.pm Tue Sep 11 23:40:35 2007
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.910 2007/09/05 17:37:51 albertel Exp $
+# $Id: lonnet.pm,v 1.911 2007/09/12 03:40:35 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -906,8 +906,8 @@
if (&host_domain($tryserver) eq $dom) {
my $host=&hostname($tryserver);
my $queryid=
- &reply("querysend:".&escape($query).':'.&escape($dom).':'.
- &escape($srch->{'srchby'}).'%%'.
+ &reply("querysend:".&escape($query).':'.
+ &escape($srch->{'srchby'}).':'.
&escape($srch->{'srchtype'}).':'.
&escape($srch->{'srchterm'}),$tryserver);
if ($queryid !~/^\Q$host\E\_/) {
@@ -924,20 +924,23 @@
if ( ($reply =~/^timeout/) || ($reply =~/^error/) ) {
&logthis('usersrch error: '.$reply.' for '.$dom.' - searching for : '.$srch->{'srchterm'}.' by '.$srch->{'srchby'}.' ('.$srch->{'srchtype'}.') - maxtries: '.$maxtries.' tries: '.$tries);
} else {
- my @matches = split(/&/,$reply);
+ my @matches;
+ if ($reply =~ /\n/) {
+ @matches = split(/\n/,$reply);
+ } else {
+ @matches = split(/\&/,$reply);
+ }
foreach my $match (@matches) {
- my @items = split(/:/,$match);
my ($uname,$udom,%userhash);
- foreach my $entry (@items) {
- my ($key,$value) = split(/=/,$entry);
- $key = &unescape($key);
- $value = &unescape($value);
+ foreach my $entry (split(/:/,$match)) {
+ my ($key,$value) =
+ map {&unescape($_);} split(/=/,$entry);
$userhash{$key} = $value;
if ($key eq 'username') {
$uname = $value;
} elsif ($key eq 'domain') {
$udom = $value;
- }
+ }
}
$results{$uname.':'.$udom} = \%userhash;
}
--raeburn1189568436--