--- loncom/lonnet/perl/lonnet.pm 2007/08/21 23:34:38 1.907 +++ loncom/lonnet/perl/lonnet.pm 2007/09/12 03:40:35 1.911 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.907 2007/08/21 23:34:38 albertel Exp $ +# $Id: lonnet.pm,v 1.911 2007/09/12 03:40:35 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -861,6 +861,7 @@ sub inst_directory_query { my $udom = $srch->{'srchdomain'}; my %results; my $homeserver = &domain($udom,'primary'); + my $outcome; if ($homeserver ne '') { my $queryid=&reply("querysend:instdirsearch:". &escape($srch->{'srchby'}).':'. @@ -880,14 +881,19 @@ sub inst_directory_query { } if (!&error($response) && $response ne 'refused') { - my @matches = split(/\n/,$response); - foreach my $match (@matches) { - my ($key,$value) = split(/=/,$match); - $results{&unescape($key).':'.$udom} = &thaw_unescape($value); + if ($response eq 'unavailable') { + $outcome = $response; + } else { + $outcome = 'ok'; + my @matches = split(/\n/,$response); + foreach my $match (@matches) { + my ($key,$value) = split(/=/,$match); + $results{&unescape($key).':'.$udom} = &thaw_unescape($value); + } } } } - return %results; + return ($outcome,%results); } sub usersearch { @@ -900,8 +906,8 @@ sub usersearch { 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\_/) { @@ -918,20 +924,23 @@ sub usersearch { 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; } @@ -1217,8 +1226,10 @@ sub do_cache_new { $time=600; } if ($debug) { &Apache::lonnet::logthis("Setting $id to $value"); } - if (!($memcache->set($id,$setvalue,$time))) { + my $result = $memcache->set($id,$setvalue,$time); + if (! $result) { &logthis("caching of id -> $id failed"); + $memcache->disconnect_all(); } # need to make a copy of $value #&make_room($id,$value,$debug); @@ -6696,10 +6707,11 @@ sub metadata { # only ws inside the tag, and not in default, so use default # as value $metaentry{':'.$unikey}=$default; - } else { - # either something interesting inside the tag or default - # uninteresting + } elsif ( $internaltext =~ /\S/ ) { + # something interesting inside the tag $metaentry{':'.$unikey}=$internaltext; + } else { + # no interesting values, don't set a default } # end of not-a-package not-a-library import }