--- loncom/lonnet/perl/lonnet.pm 2007/07/28 21:14:09 1.902 +++ loncom/lonnet/perl/lonnet.pm 2007/08/31 12:33:29 1.909 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.902 2007/07/28 21:14:09 raeburn Exp $ +# $Id: lonnet.pm,v 1.909 2007/08/31 12:33:29 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -861,21 +861,39 @@ sub inst_directory_query { my $udom = $srch->{'srchdomain'}; my %results; my $homeserver = &domain($udom,'primary'); + my $outcome; if ($homeserver ne '') { - my $response=&reply("instdirsrch:$udom".':'. - &escape($srch->{'srchby'}).':'. - &escape($srch->{'srchterm'}).':'. - $srch->{'srchtype'},$homeserver); - if ($response ne 'refused') { - my @matches = split(/&/,$response); - foreach my $match (@matches) { - my ($key,$value) = split(/=/,$match); - my %userhash = &str2hash(&unescape($value)); - $results{&unescape($key).':'.$udom} = \%userhash; + my $queryid=&reply("querysend:instdirsearch:". + &escape($srch->{'srchby'}).':'. + &escape($srch->{'srchterm'}).':'. + &escape($srch->{'srchtype'}),$homeserver); + my $host=&hostname($homeserver); + if ($queryid !~/^\Q$host\E\_/) { + &logthis('instituional directory search invalid queryid: '.$queryid.' for host: '.$homeserver.'in domain '.$udom); + return; + } + my $response = &get_query_reply($queryid); + my $maxtries = 5; + my $tries = 1; + while (($response=~/^timeout/) && ($tries < $maxtries)) { + $response = &get_query_reply($queryid); + $tries ++; + } + + if (!&error($response) && $response ne 'refused') { + 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 { @@ -2203,7 +2221,6 @@ sub userrolelog { {$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec} = $tend.':'.$tstart; } - &flushcourselogs(); } sub get_course_adv_roles { @@ -4542,8 +4559,8 @@ sub get_query_reply { sleep 2; if (-e $replyfile.'.end') { if (open(my $fh,$replyfile)) { - $reply.=<$fh>; - close($fh); + $reply = join('',<$fh>); + close($fh); } else { return 'error: reply_file_error'; } return &unescape($reply); } @@ -6306,6 +6323,12 @@ sub EXT { my ($map) = &decode_symb($symbparm); return &symbread($map); } + if ($space eq 'filename') { + if ($symbparm) { + return &clutter((&decode_symb($symbparm))[2]); + } + return &hreflocation('',$env{'request.filename'}); + } my ($section, $group, @groups); my ($courselevelm,$courselevel); @@ -6679,10 +6702,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 } @@ -6822,12 +6846,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) { @@ -8551,7 +8578,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