--- loncom/lonnet/perl/lonnet.pm 2007/08/10 22:14:54 1.905 +++ 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.905 2007/08/10 22:14:54 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 } @@ -6839,12 +6851,15 @@ sub gettitle { } my ($map,$resid,$url)=&decode_symb($symb); my $title=''; - my %bighash; - if (tie(%bighash,'GDBM_File',$env{'request.course.fn'}.'.db', - &GDBM_READER(),0640)) { - my $mapid=$bighash{'map_pc_'.&clutter($map)}; - $title=$bighash{'title_'.$mapid.'.'.$resid}; - untie %bighash; + if (!$map && $resid == 0 && $url =~/default\.sequence$/) { + $title = $env{'course.'.$env{'request.course.id'}.'.description'}; + } else { + if (tie(my %bighash,'GDBM_File',$env{'request.course.fn'}.'.db', + &GDBM_READER(),0640)) { + my $mapid=$bighash{'map_pc_'.&clutter($map)}; + $title=$bighash{'title_'.$mapid.'.'.$resid}; + untie(%bighash); + } } $title=~s/\&colon\;/\:/gs; if ($title) { @@ -8568,7 +8583,7 @@ explanation of a user role term get_my_roles($uname,$udom,$context,$types,$roles,$roledoms) : All arguments are optional. Returns a hash of a roles, either for co-author/assistant author roles for a user's Construction Space -(default), or if $context is 'user', roles for the user himself, +(default), or if $context is 'userroles', roles for the user himself, In the hash, keys are set to colon-sparated $uname,$udom,and $role, and value is set to colon-separated start and end times for the role. If no username and domain are specified, will default to current