--- loncom/lonnet/perl/lonnet.pm 2001/12/04 17:00:38 1.181 +++ loncom/lonnet/perl/lonnet.pm 2001/12/07 20:17:44 1.188 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.181 2001/12/04 17:00:38 matthew Exp $ +# $Id: lonnet.pm,v 1.188 2001/12/07 20:17:44 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -60,8 +60,11 @@ # 10/2 Gerd Kortemeyer # 10/5,10/10,11/13,11/15 Scott Harrison # 11/17,11/20,11/22,11/29 Gerd Kortemeyer +# 12/5 Matthew Hall +# 12/5 Guy Albertelli +# 12/6,12/7 Gerd Kortemeyer # -# $Id: lonnet.pm,v 1.181 2001/12/04 17:00:38 matthew Exp $ +# $Id: lonnet.pm,v 1.188 2001/12/07 20:17:44 www Exp $ # ### @@ -169,7 +172,10 @@ use Apache::File; use LWP::UserAgent(); use HTTP::Headers; use vars -qw(%perlvar %hostname %homecache %hostip %spareid %hostdom %libserv %pr %prp %fe %fd $readit %metacache %packagetab %courselogs); +qw(%perlvar %hostname %homecache %hostip %spareid %hostdom + %libserv %pr %prp %fe %fd %metacache %packagetab + %courselogs %accesshash $processmarker $dumpcount + %coursedombuf %coursehombuf); use IO::Socket; use GDBM_File; use Apache::Constants qw(:common :http); @@ -752,10 +758,9 @@ sub flushcourselogs { &logthis('Flushing course log buffers'); map { my $crsid=$_; - if (&reply('log:'.$ENV{'course.'.$crsid.'.domain'}.':'. - $ENV{'course.'.$crsid.'.num'}.':'. - &escape($courselogs{$crsid}), - $ENV{'course.'.$crsid.'.home'}) eq 'ok') { + if (&reply('log:'.$coursedombuf{$crsid}.':'. + &escape($courselogs{$crsid}), + $coursehombuf{$crsid}) eq 'ok') { delete $courselogs{$crsid}; } else { &logthis('Failed to flush log buffer for '.$crsid); @@ -766,12 +771,27 @@ sub flushcourselogs { } } } keys %courselogs; + &logthis('Flushing access logs'); + map { + my $entry=$_; + $entry=~/\_\_\_(\w+)\/(\w+)\/(.*)\_\_\_(\w+)$/; + my %temphash=($entry => $accesshash{$entry}); + if (&Apache::lonnet::put('resevaldata',\%temphash,$1,$2) eq 'ok') { + delete $accesshash{$entry}; + } + } keys %accesshash; + $dumpcount++; } sub courselog { my $what=shift; $what=time.':'.$what; unless ($ENV{'request.course.id'}) { return ''; } + $coursedombuf{$ENV{'request.course.id'}}= + $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'. + $ENV{'course.'.$ENV{'request.course.id'}.'.num'}; + $coursehombuf{$ENV{'request.course.id'}}= + $ENV{'course.'.$ENV{'request.course.id'}.'.home'}; if (defined $courselogs{$ENV{'request.course.id'}}) { $courselogs{$ENV{'request.course.id'}}.='&'.$what; } else { @@ -787,6 +807,7 @@ sub courseacclog { unless ($ENV{'request.course.id'}) { return ''; } my $what=$fnsymb.':'.$ENV{'user.name'}.':'.$ENV{'user.domain'}; if ($what=~/(problem|exam|quiz|assess|survey|form)$/) { + $what.=':POST'; map { if ($_=~/^form\.(.*)/) { $what.=':'.$1.'='.$ENV{$_}; @@ -796,6 +817,18 @@ sub courseacclog { &courselog($what); } +sub countacc { + my $url=&declutter(shift); + unless ($ENV{'request.course.id'}) { return ''; } + $accesshash{$ENV{'request.course.id'}.'___'.$url.'___course'}=1; + my $key=$processmarker.'_'.$dumpcount.'___'.$url.'___count'; + if (defined($accesshash{$key})) { + $accesshash{$key}++; + } else { + $accesshash{$key}=1; + } +} + # ----------------------------------------------------------- Check out an item sub checkout { @@ -1077,7 +1110,11 @@ sub store { &devalidate($symb); $symb=escape($symb); - if (!$namespace) { unless ($namespace=$ENV{'request.course.id'}) { return ''; } } + if (!$namespace) { + unless ($namespace=$ENV{'request.course.id'}) { + return ''; + } + } if (!$domain) { $domain=$ENV{'user.domain'}; } if (!$stuname) { $stuname=$ENV{'user.name'}; } if (!$home) { $home=$ENV{'user.home'}; } @@ -1086,6 +1123,7 @@ sub store { $namevalue.=escape($_).'='.escape($$storehash{$_}).'&'; } keys %$storehash; $namevalue=~s/\&$//; + &courselog($symb.':'.$stuname.':'.$domain.':STORE:'.$namevalue); return reply("store:$domain:$stuname:$namespace:$symb:$namevalue","$home"); } @@ -1102,7 +1140,11 @@ sub cstore { &devalidate($symb); $symb=escape($symb); - if (!$namespace) { unless ($namespace=$ENV{'request.course.id'}) { return ''; } } + if (!$namespace) { + unless ($namespace=$ENV{'request.course.id'}) { + return ''; + } + } if (!$domain) { $domain=$ENV{'user.domain'}; } if (!$stuname) { $stuname=$ENV{'user.name'}; } if (!$home) { $home=$ENV{'user.home'}; } @@ -1112,7 +1154,9 @@ sub cstore { $namevalue.=escape($_).'='.escape($$storehash{$_}).'&'; } keys %$storehash; $namevalue=~s/\&$//; - return critical("store:$domain:$stuname:$namespace:$symb:$namevalue","$home"); + &courselog($symb.':'.$stuname.':'.$domain.':CSTORE:'.$namevalue); + return critical + ("store:$domain:$stuname:$namespace:$symb:$namevalue","$home"); } # --------------------------------------------------------------------- Restore @@ -1128,7 +1172,11 @@ sub restore { } else { $symb=&escape($symb); } - if (!$namespace) { unless ($namespace=$ENV{'request.course.id'}) { return ''; } } + if (!$namespace) { + unless ($namespace=$ENV{'request.course.id'}) { + return ''; + } + } if (!$domain) { $domain=$ENV{'user.domain'}; } if (!$stuname) { $stuname=$ENV{'user.name'}; } if (!$home) { $home=$ENV{'user.home'}; } @@ -2606,6 +2654,11 @@ sub unescape { # ================================================================ Main Program +sub goodbye { + &flushcourselogs(); + &logthis("Shutting down"); +} + BEGIN { # ------------------------------------------------------------ Read access.conf { @@ -2691,6 +2744,7 @@ BEGIN { my $config=Apache::File->new("$perlvar{'lonTabDir'}/filetypes.tab"); while (my $configline=<$config>) { + next if ($configline =~ /^\#/); chomp($configline); my ($ending,$emb,@descr)=split(/\s+/,$configline); if ($descr[0] ne '') { @@ -2702,7 +2756,9 @@ BEGIN { %metacache=(); -$readit='done'; +$processmarker=$$.'_'.time.'_'.$perlvar{'lonHostID'}; +$dumpcount=0; + &logtouch(); &logthis('INFO: Read configuration'); }