--- loncom/lonnet/perl/lonnet.pm 2002/06/18 15:04:05 1.240 +++ loncom/lonnet/perl/lonnet.pm 2002/06/24 14:16:58 1.242 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.240 2002/06/18 15:04:05 www Exp $ +# $Id: lonnet.pm,v 1.242 2002/06/24 14:16:58 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -1836,33 +1836,50 @@ sub log_query { 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 $command=&escape(join(':',map{$_.'='.$filters{$_}} keys %filters)); my $queryid=&reply("querysend:".$query.':'.$udom.':'.$uname.':'.$command, $uhome); unless ($queryid=~/^$uhost\_/) { return 'error: '.$queryid; } + return get_query_reply($queryid); +} + +sub get_query_reply { + my $queryid=shift; 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 &unescape($reply); + } } - return 'error: timeout'; + return 'timeout:'.$queryid; } sub courselog_query { +# +# possible filters: +# url: url or symb +# username +# domain +# action: view, submit, grade +# start: timestamp +# end: timestamp +# my (%filters)=@_; unless ($ENV{'request.course.id'}) { return 'no_course'; } + if ($filters{'url'}) { + $filters{'url'}=&symbclean(&declutter($filters{'url'})); + $filters{'url'}=~s/\.(\w+)$/(\\.\\d+)*\\.$1/; + $filters{'url'}=~s/\.(\w+)\_\_\_/(\\.\\d+)*\\.$1/; + } 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 { @@ -2677,10 +2694,15 @@ sub symbclean { sub symbread { my $thisfn=shift; +# no filename provided? try from environment unless ($thisfn) { if ($ENV{'request.symb'}) { return &symbclean($ENV{'request.symb'}); } $thisfn=$ENV{'request.filename'}; } +# is that filename actually a symb? Verify, clean, and return + if ($thisfn=~/\_\_\_\d+\_\_\_(.*)$/) { + if (&symbverify($thisfn,$1)) { return &symbclean($thisfn); } + } $thisfn=declutter($thisfn); my %hash; my %bighash; @@ -2709,6 +2731,10 @@ sub symbread { unless ($ids) { $ids=$bighash{'ids_/'.$thisfn}; } + unless ($ids) { +# alias? + $ids=$bighash{'mapalias_'.$thisfn}; + } if ($ids) { # ------------------------------------------------------------------- Has ID(s) my @possibilities=split(/\,/,$ids);