--- loncom/lonnet/perl/lonnet.pm 2002/06/15 20:06:21 1.239 +++ loncom/lonnet/perl/lonnet.pm 2002/06/18 15:04:05 1.240 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.239 2002/06/15 20:06:21 www Exp $ +# $Id: lonnet.pm,v 1.240 2002/06/18 15:04:05 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -1829,6 +1829,47 @@ sub metadata_query { return \%rhash; } +# ----------------------------------------- Send log queries and wait for reply + +sub log_query { + my ($uname,$udom,$query,%filters)=@_; + my $uhome=&homeserver($uname,$udom); + if ($uhome eq 'no_host') { return 'error: no_host'; } + my $uhost=$hostname{$uhome}; + my $command=&escape(join('&',map{$_.'='.$filters{$_}} keys %filters)); + my $queryid=&reply("querysend:".$query.':'.$udom.':'.$uname.':'.$command, + $uhome); + unless ($queryid=~/^$uhost\_/) { return 'error: '.$queryid; } + my $replyfile=$perlvar{'lonDaemons'}.'/tmp/'.$queryid; + my $reply=''; + for (1..100) { + sleep 2; + &logthis('wait'); + if (-e $replyfile.'.end') { + if (my $fh=Apache::File->new($replyfile)) { + $reply.=<$fh>; + $fh->close; + } else { return 'error: reply_file_error'; } + } + return &unescape($reply); + } + return 'error: timeout'; +} + +sub courselog_query { + my (%filters)=@_; + unless ($ENV{'request.course.id'}) { return 'no_course'; } + my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'}; + my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; + return &log_query($cname,$cdom,'courselog',%filters); + +} + +sub userlog_query { + my ($uname,$udom,%filters)=@_; + return &log_query($uname,$udom,'userlog',%filters); +} + # ------------------------------------------------------------------ Plain Text sub plaintext {